{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.RTF
   Copyright   : Copyright (C) 2021-2022 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane (<jgm@berkeley.edu>)
   Stability   : alpha
   Portability : portable

Conversion of RTF documents 'Pandoc' document.
We target version 1.5 of the RTF spec.
-}
module Text.Pandoc.Readers.RTF (readRTF) where

import qualified Data.IntMap as IntMap
import qualified Data.Sequence as Seq
import Control.Monad
import Control.Monad.Except (throwError)
import Data.List (find, foldl')
import Data.Word (Word8, Word16)
import Data.Default
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Read as TR
import Text.Pandoc.Builder (Blocks, Inlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad (..), insertMedia)
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Parsing
import Text.Pandoc.Shared (safeRead, tshow)
import Data.Char (isAlphaNum, chr, isAscii, isLetter, isSpace, ord)
import qualified Data.ByteString.Lazy as BL
import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.Maybe (mapMaybe, fromMaybe)
import Safe (lastMay, initSafe, headDef)
-- import Debug.Trace

-- TODO:
-- [ ] more complex table features
--

-- | Read RTF from an input string and return a Pandoc document.
readRTF  :: (PandocMonad m, ToSources a)
         => ReaderOptions
         -> a
         -> m Pandoc
readRTF :: ReaderOptions -> a -> m Pandoc
readRTF opts :: ReaderOptions
opts s :: a
s = do
  let sources :: Sources
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
s
  Either PandocError Pandoc
parsed <- ParserT Sources RTFState m Pandoc
-> RTFState -> Sources -> m (Either PandocError Pandoc)
forall (m :: * -> *) t st a.
(Monad m, ToSources t) =>
ParserT Sources st m a -> st -> t -> m (Either PandocError a)
readWithM ParserT Sources RTFState m Pandoc
forall (m :: * -> *). PandocMonad m => RTFParser m Pandoc
parseRTF RTFState
forall a. Default a => a
def{ sOptions :: ReaderOptions
sOptions = ReaderOptions
opts } Sources
sources
  case Either PandocError Pandoc
parsed of
       Left e :: PandocError
e  -> PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
       Right d :: Pandoc
d -> Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
d

data CharSet = ANSI | Mac | Pc | Pca
  deriving (Int -> CharSet -> ShowS
[CharSet] -> ShowS
CharSet -> String
(Int -> CharSet -> ShowS)
-> (CharSet -> String) -> ([CharSet] -> ShowS) -> Show CharSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharSet] -> ShowS
$cshowList :: [CharSet] -> ShowS
show :: CharSet -> String
$cshow :: CharSet -> String
showsPrec :: Int -> CharSet -> ShowS
$cshowsPrec :: Int -> CharSet -> ShowS
Show, CharSet -> CharSet -> Bool
(CharSet -> CharSet -> Bool)
-> (CharSet -> CharSet -> Bool) -> Eq CharSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharSet -> CharSet -> Bool
$c/= :: CharSet -> CharSet -> Bool
== :: CharSet -> CharSet -> Bool
$c== :: CharSet -> CharSet -> Bool
Eq)

-- first index is the list (or override) id, second is the list level
type ListTable = IntMap.IntMap ListLevelTable
type ListLevelTable = IntMap.IntMap ListType

data RTFState = RTFState  { RTFState -> ReaderOptions
sOptions     :: ReaderOptions
                          , RTFState -> CharSet
sCharSet     :: CharSet
                          , RTFState -> [Properties]
sGroupStack  :: [Properties]
                          , RTFState -> [List]
sListStack   :: [List]
                          , RTFState -> Blocks
sCurrentCell :: Blocks
                          , RTFState -> [TableRow]
sTableRows   :: [TableRow] -- reverse order
                          , RTFState -> [(Properties, Text)]
sTextContent :: [(Properties, Text)]
                          , RTFState -> [(Text, Inlines)]
sMetadata    :: [(Text, Inlines)]
                          , RTFState -> FontTable
sFontTable   :: FontTable
                          , RTFState -> Stylesheet
sStylesheet  :: Stylesheet
                          , RTFState -> ListTable
sListTable   :: ListTable
                          , RTFState -> ListTable
sListOverrideTable :: ListTable
                          , RTFState -> Int
sEatChars    :: Int
                          } deriving (Int -> RTFState -> ShowS
[RTFState] -> ShowS
RTFState -> String
(Int -> RTFState -> ShowS)
-> (RTFState -> String) -> ([RTFState] -> ShowS) -> Show RTFState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RTFState] -> ShowS
$cshowList :: [RTFState] -> ShowS
show :: RTFState -> String
$cshow :: RTFState -> String
showsPrec :: Int -> RTFState -> ShowS
$cshowsPrec :: Int -> RTFState -> ShowS
Show)

instance Default RTFState where
 def :: RTFState
def = RTFState :: ReaderOptions
-> CharSet
-> [Properties]
-> [List]
-> Blocks
-> [TableRow]
-> [(Properties, Text)]
-> [(Text, Inlines)]
-> FontTable
-> Stylesheet
-> ListTable
-> ListTable
-> Int
-> RTFState
RTFState { sOptions :: ReaderOptions
sOptions = ReaderOptions
forall a. Default a => a
def
                , sCharSet :: CharSet
sCharSet = CharSet
ANSI
                , sGroupStack :: [Properties]
sGroupStack = []
                , sListStack :: [List]
sListStack = []
                , sCurrentCell :: Blocks
sCurrentCell = Blocks
forall a. Monoid a => a
mempty
                , sTableRows :: [TableRow]
sTableRows = []
                , sTextContent :: [(Properties, Text)]
sTextContent = []
                , sMetadata :: [(Text, Inlines)]
sMetadata = []
                , sFontTable :: FontTable
sFontTable = FontTable
forall a. Monoid a => a
mempty
                , sStylesheet :: Stylesheet
sStylesheet = Stylesheet
forall a. Monoid a => a
mempty
                , sListTable :: ListTable
sListTable = ListTable
forall a. Monoid a => a
mempty
                , sListOverrideTable :: ListTable
sListOverrideTable = ListTable
forall a. Monoid a => a
mempty
                , sEatChars :: Int
sEatChars = 0
                }

type FontTable = IntMap.IntMap FontFamily

data FontFamily =
  Roman | Swiss | Modern | Script | Decor | Tech | Bidi
  deriving (Int -> FontFamily -> ShowS
[FontFamily] -> ShowS
FontFamily -> String
(Int -> FontFamily -> ShowS)
-> (FontFamily -> String)
-> ([FontFamily] -> ShowS)
-> Show FontFamily
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontFamily] -> ShowS
$cshowList :: [FontFamily] -> ShowS
show :: FontFamily -> String
$cshow :: FontFamily -> String
showsPrec :: Int -> FontFamily -> ShowS
$cshowsPrec :: Int -> FontFamily -> ShowS
Show, FontFamily -> FontFamily -> Bool
(FontFamily -> FontFamily -> Bool)
-> (FontFamily -> FontFamily -> Bool) -> Eq FontFamily
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontFamily -> FontFamily -> Bool
$c/= :: FontFamily -> FontFamily -> Bool
== :: FontFamily -> FontFamily -> Bool
$c== :: FontFamily -> FontFamily -> Bool
Eq)

data StyleType = ParagraphStyle | SectionStyle | CharStyle | TableStyle
  deriving (Int -> StyleType -> ShowS
[StyleType] -> ShowS
StyleType -> String
(Int -> StyleType -> ShowS)
-> (StyleType -> String)
-> ([StyleType] -> ShowS)
-> Show StyleType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StyleType] -> ShowS
$cshowList :: [StyleType] -> ShowS
show :: StyleType -> String
$cshow :: StyleType -> String
showsPrec :: Int -> StyleType -> ShowS
$cshowsPrec :: Int -> StyleType -> ShowS
Show, StyleType -> StyleType -> Bool
(StyleType -> StyleType -> Bool)
-> (StyleType -> StyleType -> Bool) -> Eq StyleType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StyleType -> StyleType -> Bool
$c/= :: StyleType -> StyleType -> Bool
== :: StyleType -> StyleType -> Bool
$c== :: StyleType -> StyleType -> Bool
Eq)

data Style =
  Style { Style -> Int
styleNum :: Int
        , Style -> StyleType
styleType :: StyleType
        , Style -> Maybe Int
styleBasedOn :: Maybe Int
        , Style -> Text
styleName :: Text
        , Style -> [Tok]
styleFormatting :: [Tok]
        } deriving (Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Style] -> ShowS
$cshowList :: [Style] -> ShowS
show :: Style -> String
$cshow :: Style -> String
showsPrec :: Int -> Style -> ShowS
$cshowsPrec :: Int -> Style -> ShowS
Show, Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq)

type Stylesheet = IntMap.IntMap Style

data PictType =
  Emfblip | Pngblip | Jpegblip
  deriving (Int -> PictType -> ShowS
[PictType] -> ShowS
PictType -> String
(Int -> PictType -> ShowS)
-> (PictType -> String) -> ([PictType] -> ShowS) -> Show PictType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PictType] -> ShowS
$cshowList :: [PictType] -> ShowS
show :: PictType -> String
$cshow :: PictType -> String
showsPrec :: Int -> PictType -> ShowS
$cshowsPrec :: Int -> PictType -> ShowS
Show, PictType -> PictType -> Bool
(PictType -> PictType -> Bool)
-> (PictType -> PictType -> Bool) -> Eq PictType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PictType -> PictType -> Bool
$c/= :: PictType -> PictType -> Bool
== :: PictType -> PictType -> Bool
$c== :: PictType -> PictType -> Bool
Eq)

data Pict =
  Pict { Pict -> Maybe PictType
picType :: Maybe PictType
       , Pict -> Maybe Int
picWidth :: Maybe Int
       , Pict -> Maybe Int
picHeight :: Maybe Int
       , Pict -> Maybe Int
picWidthGoal :: Maybe Int
       , Pict -> Maybe Int
picHeightGoal :: Maybe Int
       , Pict -> Bool
picBinary :: Bool
       , Pict -> Text
picData :: Text
       , Pict -> Text
picName :: Text
       , Pict -> ByteString
picBytes :: BL.ByteString
       } deriving (Int -> Pict -> ShowS
[Pict] -> ShowS
Pict -> String
(Int -> Pict -> ShowS)
-> (Pict -> String) -> ([Pict] -> ShowS) -> Show Pict
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pict] -> ShowS
$cshowList :: [Pict] -> ShowS
show :: Pict -> String
$cshow :: Pict -> String
showsPrec :: Int -> Pict -> ShowS
$cshowsPrec :: Int -> Pict -> ShowS
Show, Pict -> Pict -> Bool
(Pict -> Pict -> Bool) -> (Pict -> Pict -> Bool) -> Eq Pict
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pict -> Pict -> Bool
$c/= :: Pict -> Pict -> Bool
== :: Pict -> Pict -> Bool
$c== :: Pict -> Pict -> Bool
Eq)

instance Default Pict where
 def :: Pict
def = Pict :: Maybe PictType
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bool
-> Text
-> Text
-> ByteString
-> Pict
Pict { picType :: Maybe PictType
picType = Maybe PictType
forall a. Maybe a
Nothing
            , picWidth :: Maybe Int
picWidth = Maybe Int
forall a. Maybe a
Nothing
            , picHeight :: Maybe Int
picHeight = Maybe Int
forall a. Maybe a
Nothing
            , picWidthGoal :: Maybe Int
picWidthGoal = Maybe Int
forall a. Maybe a
Nothing
            , picHeightGoal :: Maybe Int
picHeightGoal = Maybe Int
forall a. Maybe a
Nothing
            , picBinary :: Bool
picBinary = Bool
False
            , picData :: Text
picData = Text
forall a. Monoid a => a
mempty
            , picName :: Text
picName = Text
forall a. Monoid a => a
mempty
            , picBytes :: ByteString
picBytes = ByteString
forall a. Monoid a => a
mempty }

data Properties =
  Properties
  { Properties -> Bool
gBold :: Bool
  , Properties -> Bool
gItalic :: Bool
  , Properties -> Bool
gCaps :: Bool
  , Properties -> Bool
gDeleted :: Bool
  , Properties -> Bool
gSub :: Bool
  , Properties -> Bool
gSuper :: Bool
  , Properties -> Bool
gSmallCaps :: Bool
  , Properties -> Bool
gUnderline :: Bool
  , Properties -> Maybe Text
gHyperlink :: Maybe Text
  , Properties -> Maybe Text
gAnchor :: Maybe Text
  , Properties -> Maybe Pict
gImage :: Maybe Pict
  , Properties -> Maybe FontFamily
gFontFamily :: Maybe FontFamily
  , Properties -> Bool
gHidden :: Bool
  , Properties -> Int
gUC :: Int -- number of ansi chars to skip after unicode char
  , Properties -> Maybe Blocks
gFootnote :: Maybe Blocks
  , Properties -> Maybe Int
gOutlineLevel :: Maybe ListLevel
  , Properties -> Maybe Int
gListOverride :: Maybe Override
  , Properties -> Maybe Int
gListLevel :: Maybe Int
  , Properties -> Bool
gInTable :: Bool
  } deriving (Int -> Properties -> ShowS
[Properties] -> ShowS
Properties -> String
(Int -> Properties -> ShowS)
-> (Properties -> String)
-> ([Properties] -> ShowS)
-> Show Properties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Properties] -> ShowS
$cshowList :: [Properties] -> ShowS
show :: Properties -> String
$cshow :: Properties -> String
showsPrec :: Int -> Properties -> ShowS
$cshowsPrec :: Int -> Properties -> ShowS
Show, Properties -> Properties -> Bool
(Properties -> Properties -> Bool)
-> (Properties -> Properties -> Bool) -> Eq Properties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Properties -> Properties -> Bool
$c/= :: Properties -> Properties -> Bool
== :: Properties -> Properties -> Bool
$c== :: Properties -> Properties -> Bool
Eq)

instance Default Properties where
   def :: Properties
def = Properties :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> Maybe Text
-> Maybe Pict
-> Maybe FontFamily
-> Bool
-> Int
-> Maybe Blocks
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bool
-> Properties
Properties { gBold :: Bool
gBold = Bool
False
                    , gItalic :: Bool
gItalic = Bool
False
                    , gCaps :: Bool
gCaps = Bool
False
                    , gDeleted :: Bool
gDeleted = Bool
False
                    , gSub :: Bool
gSub = Bool
False
                    , gSuper :: Bool
gSuper = Bool
False
                    , gSmallCaps :: Bool
gSmallCaps = Bool
False
                    , gUnderline :: Bool
gUnderline = Bool
False
                    , gHyperlink :: Maybe Text
gHyperlink = Maybe Text
forall a. Maybe a
Nothing
                    , gAnchor :: Maybe Text
gAnchor = Maybe Text
forall a. Maybe a
Nothing
                    , gImage :: Maybe Pict
gImage = Maybe Pict
forall a. Maybe a
Nothing
                    , gFontFamily :: Maybe FontFamily
gFontFamily = Maybe FontFamily
forall a. Maybe a
Nothing
                    , gHidden :: Bool
gHidden = Bool
False
                    , gUC :: Int
gUC = 1
                    , gFootnote :: Maybe Blocks
gFootnote = Maybe Blocks
forall a. Maybe a
Nothing
                    , gOutlineLevel :: Maybe Int
gOutlineLevel = Maybe Int
forall a. Maybe a
Nothing
                    , gListOverride :: Maybe Int
gListOverride = Maybe Int
forall a. Maybe a
Nothing
                    , gListLevel :: Maybe Int
gListLevel = Maybe Int
forall a. Maybe a
Nothing
                    , gInTable :: Bool
gInTable = Bool
False
                    }

type RTFParser m = ParserT Sources RTFState m

data ListType = Bullet | Ordered ListAttributes
  deriving (Int -> ListType -> ShowS
[ListType] -> ShowS
ListType -> String
(Int -> ListType -> ShowS)
-> (ListType -> String) -> ([ListType] -> ShowS) -> Show ListType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListType] -> ShowS
$cshowList :: [ListType] -> ShowS
show :: ListType -> String
$cshow :: ListType -> String
showsPrec :: Int -> ListType -> ShowS
$cshowsPrec :: Int -> ListType -> ShowS
Show, ListType -> ListType -> Bool
(ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool) -> Eq ListType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c== :: ListType -> ListType -> Bool
Eq)

type Override = Int

type ListLevel = Int

data List =
    List Override ListLevel ListType [Blocks]  -- items in reverse order
    deriving (Int -> List -> ShowS
[List] -> ShowS
List -> String
(Int -> List -> ShowS)
-> (List -> String) -> ([List] -> ShowS) -> Show List
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [List] -> ShowS
$cshowList :: [List] -> ShowS
show :: List -> String
$cshow :: List -> String
showsPrec :: Int -> List -> ShowS
$cshowsPrec :: Int -> List -> ShowS
Show, List -> List -> Bool
(List -> List -> Bool) -> (List -> List -> Bool) -> Eq List
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: List -> List -> Bool
$c/= :: List -> List -> Bool
== :: List -> List -> Bool
$c== :: List -> List -> Bool
Eq)

newtype TableRow = TableRow [Blocks] -- cells in reverse order
    deriving (Int -> TableRow -> ShowS
[TableRow] -> ShowS
TableRow -> String
(Int -> TableRow -> ShowS)
-> (TableRow -> String) -> ([TableRow] -> ShowS) -> Show TableRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableRow] -> ShowS
$cshowList :: [TableRow] -> ShowS
show :: TableRow -> String
$cshow :: TableRow -> String
showsPrec :: Int -> TableRow -> ShowS
$cshowsPrec :: Int -> TableRow -> ShowS
Show, TableRow -> TableRow -> Bool
(TableRow -> TableRow -> Bool)
-> (TableRow -> TableRow -> Bool) -> Eq TableRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableRow -> TableRow -> Bool
$c/= :: TableRow -> TableRow -> Bool
== :: TableRow -> TableRow -> Bool
$c== :: TableRow -> TableRow -> Bool
Eq)

parseRTF :: PandocMonad m => RTFParser m Pandoc
parseRTF :: RTFParser m Pandoc
parseRTF = do
  ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl
  [Tok]
toks <- ParsecT Sources RTFState m Tok -> ParsecT Sources RTFState m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources RTFState m Tok
forall (m :: * -> *). PandocMonad m => RTFParser m Tok
tok
  -- return $! traceShowId toks
  Blocks
bs <- (case [Tok]
toks of
          -- if we start with {\rtf1...}, parse that and ignore
          -- what follows (which in certain cases can be non-RTF content)
          rtftok :: Tok
rtftok@(Tok _ (Grouped (Tok _ (ControlWord "rtf" (Just 1)) : _))) : _
            -> (Blocks -> Tok -> ParsecT Sources RTFState m Blocks)
-> Blocks -> [Tok] -> ParsecT Sources RTFState m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> ParsecT Sources RTFState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
forall a. Monoid a => a
mempty [Tok
rtftok]
          _ -> (Blocks -> Tok -> ParsecT Sources RTFState m Blocks)
-> Blocks -> [Tok] -> ParsecT Sources RTFState m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> ParsecT Sources RTFState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
forall a. Monoid a => a
mempty [Tok]
toks)
        ParsecT Sources RTFState m Blocks
-> (Blocks -> ParsecT Sources RTFState m Blocks)
-> ParsecT Sources RTFState m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Blocks -> ParsecT Sources RTFState m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks
  Blocks
unclosed <- ParsecT Sources RTFState m Blocks
forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeContainers
  let doc :: Pandoc
doc = Blocks -> Pandoc
B.doc (Blocks -> Pandoc) -> Blocks -> Pandoc
forall a b. (a -> b) -> a -> b
$ Blocks
bs Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
unclosed
  [(Text, Inlines)]
kvs <- RTFState -> [(Text, Inlines)]
sMetadata (RTFState -> [(Text, Inlines)])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [(Text, Inlines)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Pandoc -> RTFParser m Pandoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pandoc -> RTFParser m Pandoc) -> Pandoc -> RTFParser m Pandoc
forall a b. (a -> b) -> a -> b
$ ((Text, Inlines) -> Pandoc -> Pandoc)
-> Pandoc -> [(Text, Inlines)] -> Pandoc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Text -> Inlines -> Pandoc -> Pandoc)
-> (Text, Inlines) -> Pandoc -> Pandoc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Inlines -> Pandoc -> Pandoc
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta) Pandoc
doc [(Text, Inlines)]
kvs

data Tok = Tok SourcePos TokContents
  deriving (Int -> Tok -> ShowS
[Tok] -> ShowS
Tok -> String
(Int -> Tok -> ShowS)
-> (Tok -> String) -> ([Tok] -> ShowS) -> Show Tok
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tok] -> ShowS
$cshowList :: [Tok] -> ShowS
show :: Tok -> String
$cshow :: Tok -> String
showsPrec :: Int -> Tok -> ShowS
$cshowsPrec :: Int -> Tok -> ShowS
Show, Tok -> Tok -> Bool
(Tok -> Tok -> Bool) -> (Tok -> Tok -> Bool) -> Eq Tok
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tok -> Tok -> Bool
$c/= :: Tok -> Tok -> Bool
== :: Tok -> Tok -> Bool
$c== :: Tok -> Tok -> Bool
Eq)

data TokContents =
    ControlWord Text (Maybe Int)
  | ControlSymbol Char
  | UnformattedText Text
  | BinData BL.ByteString
  | HexVal Word8
  | Grouped [Tok]
  deriving (Int -> TokContents -> ShowS
[TokContents] -> ShowS
TokContents -> String
(Int -> TokContents -> ShowS)
-> (TokContents -> String)
-> ([TokContents] -> ShowS)
-> Show TokContents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokContents] -> ShowS
$cshowList :: [TokContents] -> ShowS
show :: TokContents -> String
$cshow :: TokContents -> String
showsPrec :: Int -> TokContents -> ShowS
$cshowsPrec :: Int -> TokContents -> ShowS
Show, TokContents -> TokContents -> Bool
(TokContents -> TokContents -> Bool)
-> (TokContents -> TokContents -> Bool) -> Eq TokContents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokContents -> TokContents -> Bool
$c/= :: TokContents -> TokContents -> Bool
== :: TokContents -> TokContents -> Bool
$c== :: TokContents -> TokContents -> Bool
Eq)

tok :: PandocMonad m => RTFParser m Tok
tok :: RTFParser m Tok
tok = do
  SourcePos
pos <- ParsecT Sources RTFState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  SourcePos -> TokContents -> Tok
Tok SourcePos
pos (TokContents -> Tok)
-> ParsecT Sources RTFState m TokContents -> RTFParser m Tok
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ParsecT Sources RTFState m TokContents
controlThing ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources RTFState m TokContents
unformattedText ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources RTFState m TokContents
grouped) ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m ()
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl)
 where
  controlThing :: ParsecT Sources RTFState m TokContents
controlThing = do
    Char -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '\\' ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      ( ParsecT Sources RTFState m TokContents
forall u. ParsecT Sources u m TokContents
binData
     ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> Maybe Int -> TokContents
ControlWord (Text -> Maybe Int -> TokContents)
-> ParsecT Sources RTFState m Text
-> ParsecT Sources RTFState m (Maybe Int -> TokContents)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m Text
forall u. ParsecT Sources u m Text
letterSequence ParsecT Sources RTFState m (Maybe Int -> TokContents)
-> ParsecT Sources RTFState m (Maybe Int)
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Sources RTFState m (Maybe Int)
forall u. ParsecT Sources u m (Maybe Int)
parameter ParsecT Sources RTFState m (Maybe Int)
-> ParsecT Sources RTFState m ()
-> ParsecT Sources RTFState m (Maybe Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources RTFState m Char -> ParsecT Sources RTFState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources RTFState m Char
forall (m :: * -> *). PandocMonad m => RTFParser m Char
delimChar))
     ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Word8 -> TokContents
HexVal (Word8 -> TokContents)
-> ParsecT Sources RTFState m Word8
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m Word8
forall u. ParsecT Sources u m Word8
hexVal)
     ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> TokContents
ControlSymbol (Char -> TokContents)
-> ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar) )
  binData :: ParsecT Sources u m TokContents
binData = ParsecT Sources u m TokContents -> ParsecT Sources u m TokContents
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources u m TokContents
 -> ParsecT Sources u m TokContents)
-> ParsecT Sources u m TokContents
-> ParsecT Sources u m TokContents
forall a b. (a -> b) -> a -> b
$ do
    String -> ParsecT Sources u m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string "bin" ParsecT Sources u m String
-> ParsecT Sources u m () -> ParsecT Sources u m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources u m Char -> ParsecT Sources u m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
letter
    Int
n <- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int)
-> ParsecT Sources u m (Maybe Int) -> ParsecT Sources u m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources u m (Maybe Int)
forall u. ParsecT Sources u m (Maybe Int)
parameter
    ParsecT Sources u m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
    -- NOTE: We assume here that if the document contains binary
    -- data, it will not be valid UTF-8 and hence it will have been
    -- read as latin1, so we can recover the data in the following
    -- way.  This is probably not completely reliable, but I don't
    -- know if we can do better without making this reader take
    -- a ByteString input.
    ByteString
dat <- [Word8] -> ByteString
BL.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) (String -> ByteString)
-> ParsecT Sources u m String -> ParsecT Sources u m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Sources u m Char -> ParsecT Sources u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
    TokContents -> ParsecT Sources u m TokContents
forall (m :: * -> *) a. Monad m => a -> m a
return (TokContents -> ParsecT Sources u m TokContents)
-> TokContents -> ParsecT Sources u m TokContents
forall a b. (a -> b) -> a -> b
$ ByteString -> TokContents
BinData ByteString
dat
  parameter :: ParsecT Sources u m (Maybe Int)
parameter = do
    String
hyph <- String -> ParsecT Sources u m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string "-" ParsecT Sources u m String
-> ParsecT Sources u m String -> ParsecT Sources u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Sources u m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure ""
    String
rest <- ParsecT Sources u m Char -> ParsecT Sources u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
digit
    let pstr :: Text
pstr = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
hyph String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
rest
    Maybe Int -> ParsecT Sources u m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> ParsecT Sources u m (Maybe Int))
-> Maybe Int -> ParsecT Sources u m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
pstr
  hexVal :: ParsecT Sources u m Word8
hexVal = do
    Char -> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '\''
    Char
x <- ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
hexDigit
    Char
y <- ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
hexDigit
    Word8 -> ParsecT Sources u m Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ParsecT Sources u m Word8)
-> Word8 -> ParsecT Sources u m Word8
forall a b. (a -> b) -> a -> b
$ Text -> Word8
hexToWord (String -> Text
T.pack [Char
x,Char
y])
  letterSequence :: ParsecT Sources u m Text
letterSequence = String -> Text
T.pack (String -> Text)
-> ParsecT Sources u m String -> ParsecT Sources u m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources u m Char -> ParsecT Sources u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\c :: Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isLetter Char
c))
  unformattedText :: ParsecT Sources RTFState m TokContents
unformattedText =
    Text -> TokContents
UnformattedText (Text -> TokContents)
-> ([String] -> Text) -> [String] -> TokContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> ([String] -> String) -> [String] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> TokContents)
-> ParsecT Sources RTFState m [String]
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ParsecT Sources RTFState m String
-> ParsecT Sources RTFState m [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (   ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpecial))
            ParsecT Sources RTFState m String
-> ParsecT Sources RTFState m String
-> ParsecT Sources RTFState m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ("" String
-> ParsecT Sources RTFState m ()
-> ParsecT Sources RTFState m String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl))
  grouped :: ParsecT Sources RTFState m TokContents
grouped = [Tok] -> TokContents
Grouped ([Tok] -> TokContents)
-> ParsecT Sources RTFState m [Tok]
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '{' ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl ParsecT Sources RTFState m ()
-> ParsecT Sources RTFState m [Tok]
-> ParsecT Sources RTFState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RTFParser m Tok
-> ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill RTFParser m Tok
forall (m :: * -> *). PandocMonad m => RTFParser m Tok
tok (Char -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '}'))

nl :: PandocMonad m => RTFParser m ()
nl :: RTFParser m ()
nl = ParsecT Sources RTFState m Char -> RTFParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '\n' ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '\r')

isSpecial :: Char -> Bool
isSpecial :: Char -> Bool
isSpecial '{' = Bool
True
isSpecial '}' = Bool
True
isSpecial '\\' = Bool
True
isSpecial '\n' = Bool
True
isSpecial _ = Bool
False

delimChar :: PandocMonad m => RTFParser m Char
delimChar :: RTFParser m Char
delimChar = (Char -> Bool) -> RTFParser m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\c :: Char
c -> Bool -> Bool
not (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpecial Char
c))

modifyGroup :: PandocMonad m
            => (Properties -> Properties)
            -> RTFParser m ()
modifyGroup :: (Properties -> Properties) -> RTFParser m ()
modifyGroup f :: Properties -> Properties
f =
  (RTFState -> RTFState) -> RTFParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> RTFParser m ())
-> (RTFState -> RTFState) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \st :: RTFState
st ->
    RTFState
st{ sGroupStack :: [Properties]
sGroupStack =
          case RTFState -> [Properties]
sGroupStack RTFState
st of
            [] -> []
            (x :: Properties
x:xs :: [Properties]
xs) -> Properties -> Properties
f Properties
x Properties -> [Properties] -> [Properties]
forall a. a -> [a] -> [a]
: [Properties]
xs }

addFormatting :: (Properties, Text) -> Inlines
addFormatting :: (Properties, Text) -> Inlines
addFormatting (_, "\n") = Inlines
B.linebreak
addFormatting (props :: Properties
props, _) | Properties -> Bool
gHidden Properties
props = Inlines
forall a. Monoid a => a
mempty
addFormatting (props :: Properties
props, _) | Just bs :: Blocks
bs <- Properties -> Maybe Blocks
gFootnote Properties
props = Blocks -> Inlines
B.note Blocks
bs
addFormatting (props :: Properties
props, txt :: Text
txt) =
  (if Properties -> Bool
gBold Properties
props then Inlines -> Inlines
B.strong else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gItalic Properties
props then Inlines -> Inlines
B.emph else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gDeleted Properties
props then Inlines -> Inlines
B.strikeout else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gSub Properties
props then Inlines -> Inlines
B.subscript else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gSuper Properties
props then Inlines -> Inlines
B.superscript else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gSmallCaps Properties
props then Inlines -> Inlines
B.smallcaps else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gUnderline Properties
props then Inlines -> Inlines
B.underline else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (case Properties -> Maybe Text
gHyperlink Properties
props of
     Nothing -> Inlines -> Inlines
forall a. a -> a
id
     Just linkdest :: Text
linkdest -> Text -> Text -> Inlines -> Inlines
B.link Text
linkdest Text
forall a. Monoid a => a
mempty) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (case Properties -> Maybe Text
gAnchor Properties
props of
     Nothing -> Inlines -> Inlines
forall a. a -> a
id
     Just ident :: Text
ident -> Attr -> Inlines -> Inlines
B.spanWith (Text
ident,[],[])) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (case Properties -> Maybe FontFamily
gFontFamily Properties
props of
     Just Modern -> Text -> Inlines
B.code
     _ -> case Properties -> Maybe Pict
gImage Properties
props of
            Just pict :: Pict
pict ->
              let attr :: (Text, [a], [(Text, Text)])
attr = ("",[],
                         (case Pict -> Maybe Int
picWidthGoal Pict
pict of
                           Nothing -> []
                           Just w :: Int
w  -> [("width", Double -> Text
forall a. Show a => a -> Text
tshow (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 1440
                                                         :: Double)
                                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "in")]) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
                         (case Pict -> Maybe Int
picHeightGoal Pict
pict of
                            Nothing -> []
                            Just h :: Int
h -> [("height", Double -> Text
forall a. Show a => a -> Text
tshow (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 1440
                                                         :: Double)
                                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "in")]))
              in  Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith Attr
forall a. (Text, [a], [(Text, Text)])
attr (Pict -> Text
picName Pict
pict) "" (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
B.text
            Nothing -> Text -> Inlines
B.text) (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gCaps Properties
props then Text -> Text
T.toUpper else Text -> Text
forall a. a -> a
id)
  (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text
txt

addText :: PandocMonad m => Text -> RTFParser m ()
addText :: Text -> RTFParser m ()
addText t :: Text
t = do
  [Properties]
gs <- RTFState -> [Properties]
sGroupStack (RTFState -> [Properties])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [Properties]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let props :: Properties
props = case [Properties]
gs of
                (x :: Properties
x:_) -> Properties
x
                _ -> Properties
forall a. Default a => a
def
  (RTFState -> RTFState) -> RTFParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\s :: RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = (Properties
props, Text
t) (Properties, Text) -> [(Properties, Text)] -> [(Properties, Text)]
forall a. a -> [a] -> [a]
: RTFState -> [(Properties, Text)]
sTextContent RTFState
s })

inGroup :: PandocMonad m => RTFParser m a -> RTFParser m a
inGroup :: RTFParser m a -> RTFParser m a
inGroup p :: RTFParser m a
p = do
  (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \st :: RTFState
st ->
    RTFState
st{ sGroupStack :: [Properties]
sGroupStack =
        case RTFState -> [Properties]
sGroupStack RTFState
st of
          [] -> [Properties
forall a. Default a => a
def]
          (x :: Properties
x:xs :: [Properties]
xs) -> (Properties
xProperties -> [Properties] -> [Properties]
forall a. a -> [a] -> [a]
:Properties
xProperties -> [Properties] -> [Properties]
forall a. a -> [a] -> [a]
:[Properties]
xs) } -- inherit current group's properties
  a
result <- RTFParser m a
p
  (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \st :: RTFState
st ->
    RTFState
st{ sGroupStack :: [Properties]
sGroupStack =
        case RTFState -> [Properties]
sGroupStack RTFState
st of
          [] -> [] -- should not happen
          (_:xs :: [Properties]
xs) -> [Properties]
xs }
  a -> RTFParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

getStyleFormatting :: PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting :: Int -> RTFParser m [Tok]
getStyleFormatting stynum :: Int
stynum = do
  Stylesheet
stylesheet <- RTFState -> Stylesheet
sStylesheet (RTFState -> Stylesheet)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m Stylesheet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case Int -> Stylesheet -> Maybe Style
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
stynum Stylesheet
stylesheet of
    Nothing -> [Tok] -> RTFParser m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just sty :: Style
sty ->
      case Style -> Maybe Int
styleBasedOn Style
sty of
        Just i :: Int
i -> ([Tok] -> [Tok] -> [Tok]
forall a. Semigroup a => a -> a -> a
<> Style -> [Tok]
styleFormatting Style
sty)  ([Tok] -> [Tok]) -> RTFParser m [Tok] -> RTFParser m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> RTFParser m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
i
        Nothing -> [Tok] -> RTFParser m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> RTFParser m [Tok]) -> [Tok] -> RTFParser m [Tok]
forall a b. (a -> b) -> a -> b
$ Style -> [Tok]
styleFormatting Style
sty

isMetadataField :: Text -> Bool
isMetadataField :: Text -> Bool
isMetadataField "title" = Bool
True
isMetadataField "subject" = Bool
True
isMetadataField "author" = Bool
True
isMetadataField "manager" = Bool
True
isMetadataField "company" = Bool
True
isMetadataField "operator" = Bool
True
isMetadataField "category" = Bool
True
isMetadataField "keywords" = Bool
True
isMetadataField "comment" = Bool
True
isMetadataField "doccomm" = Bool
True
isMetadataField "hlinkbase" = Bool
True
isMetadataField "generator" = Bool
True
isMetadataField _ = Bool
False

isHeaderFooter :: Text -> Bool
isHeaderFooter :: Text -> Bool
isHeaderFooter "header" = Bool
True
isHeaderFooter "headerl" = Bool
True
isHeaderFooter "headerr" = Bool
True
isHeaderFooter "headerf" = Bool
True
isHeaderFooter "footer" = Bool
True
isHeaderFooter "footerl" = Bool
True
isHeaderFooter "footerr" = Bool
True
isHeaderFooter "footerf" = Bool
True
isHeaderFooter _ = Bool
False

boolParam :: Maybe Int -> Bool
boolParam :: Maybe Int -> Bool
boolParam (Just 0) = Bool
False
boolParam _ = Bool
True

isUnderline :: Text -> Bool
isUnderline :: Text -> Bool
isUnderline "ul" = Bool
True
isUnderline "uld" = Bool
True
isUnderline "uldash" = Bool
True
isUnderline "uldashd" = Bool
True
isUnderline "uldashdd" = Bool
True
isUnderline "uldb" = Bool
True
isUnderline "ulth" = Bool
True
isUnderline "ulthd" = Bool
True
isUnderline "ulthdash" = Bool
True
isUnderline "ulw" = Bool
True
isUnderline "ulwave" = Bool
True
isUnderline _ = Bool
False

processTok :: PandocMonad m => Blocks -> Tok -> RTFParser m Blocks
processTok :: Blocks -> Tok -> RTFParser m Blocks
processTok bs :: Blocks
bs (Tok pos :: SourcePos
pos tok' :: TokContents
tok') = do
  SourcePos -> ParsecT Sources RTFState m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
  case TokContents
tok' of
    HexVal{} -> () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    UnformattedText{} -> () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    _ -> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = 0 }
  case TokContents
tok' of
    Grouped (Tok _ (ControlSymbol '*') : toks :: [Tok]
toks) ->
      Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (do [(Properties, Text)]
oldTextContent <- RTFState -> [(Properties, Text)]
sTextContent (RTFState -> [(Properties, Text)])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [(Properties, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
forall a. Monoid a => a
mempty (SourcePos -> TokContents -> Tok
Tok SourcePos
pos ([Tok] -> TokContents
Grouped [Tok]
toks))
                (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \st :: RTFState
st -> RTFState
st{ sTextContent :: [(Properties, Text)]
sTextContent = [(Properties, Text)]
oldTextContent })
    Grouped (Tok _ (ControlWord "fonttbl" _) : toks :: [Tok]
toks) -> RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (RTFParser m Blocks -> RTFParser m Blocks)
-> RTFParser m Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
      (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sFontTable :: FontTable
sFontTable = [Tok] -> FontTable
processFontTable [Tok]
toks }
      Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "field" _) : toks :: [Tok]
toks) ->
      RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (RTFParser m Blocks -> RTFParser m Blocks)
-> RTFParser m Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> [Tok] -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> [Tok] -> RTFParser m Blocks
handleField Blocks
bs [Tok]
toks
    Grouped (Tok _ (ControlWord "pict" _) : toks :: [Tok]
toks) ->
      Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ([Tok] -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handlePict [Tok]
toks)
    Grouped (Tok _ (ControlWord "stylesheet" _) : toks :: [Tok]
toks) ->
      Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ([Tok] -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handleStylesheet [Tok]
toks)
    Grouped (Tok _ (ControlWord "listtext" _) : _) -> do
      -- eject any previous list items...sometimes TextEdit
      -- doesn't put in a \par
      Blocks -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks Blocks
bs
    Grouped (Tok _ (ControlWord "pgdsc" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "colortbl" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "listtable" _) : toks :: [Tok]
toks) ->
      Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ([Tok] -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handleListTable [Tok]
toks)
    Grouped (Tok _ (ControlWord "listoverridetable" _) : toks :: [Tok]
toks) ->
      Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ([Tok] -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handleListOverrideTable [Tok]
toks)
    Grouped (Tok _ (ControlWord "wgrffmtfilter" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "themedata" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "colorschememapping" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "datastore" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "latentstyles" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "pntxta" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs -- TODO
    Grouped (Tok _ (ControlWord "pntxtb" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs -- TODO
    Grouped (Tok _ (ControlWord "xmlnstbl" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "filetbl" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "expandedcolortbl" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "listtables" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "revtbl" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "bkmkstart" _)
             : Tok _ (UnformattedText t :: Text
t) : _) -> do
      -- TODO ideally we'd put the span around bkmkstart/end, but this
      -- is good for now:
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gAnchor :: Maybe Text
gAnchor = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t })
      Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "bkmkend" _) : _) -> do
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gAnchor :: Maybe Text
gAnchor = Maybe Text
forall a. Maybe a
Nothing })
      Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord f :: Text
f _) : _) | Text -> Bool
isHeaderFooter Text
f -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok _ (ControlWord "footnote" _) : toks :: [Tok]
toks) -> do
      Blocks
noteBs <- RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (RTFParser m Blocks -> RTFParser m Blocks)
-> RTFParser m Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Tok] -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m Blocks
processDestinationToks [Tok]
toks
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gFootnote :: Maybe Blocks
gFootnote = Blocks -> Maybe Blocks
forall a. a -> Maybe a
Just Blocks
noteBs })
      Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "*"
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gFootnote :: Maybe Blocks
gFootnote = Maybe Blocks
forall a. Maybe a
Nothing })
      Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
bs
    Grouped (Tok _ (ControlWord "info" _) : toks :: [Tok]
toks) ->
      Blocks
bs Blocks -> RTFParser m Blocks -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ([Tok] -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m Blocks
processDestinationToks [Tok]
toks)
    Grouped (Tok _ (ControlWord f :: Text
f _) : toks :: [Tok]
toks) | Text -> Bool
isMetadataField Text
f -> RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (RTFParser m Blocks -> RTFParser m Blocks)
-> RTFParser m Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
      (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> ParsecT Sources RTFState m ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
forall a. Monoid a => a
mempty [Tok]
toks
      [(Properties, Text)]
annotatedToks <- [(Properties, Text)] -> [(Properties, Text)]
forall a. [a] -> [a]
reverse ([(Properties, Text)] -> [(Properties, Text)])
-> (RTFState -> [(Properties, Text)])
-> RTFState
-> [(Properties, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTFState -> [(Properties, Text)]
sTextContent (RTFState -> [(Properties, Text)])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [(Properties, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [] }
      let ils :: Inlines
ils = Inlines -> Inlines
B.trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ((Properties, Text) -> Inlines)
-> [(Properties, Text)] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Inlines
addFormatting [(Properties, Text)]
annotatedToks
      (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sMetadata :: [(Text, Inlines)]
sMetadata = (Text
f, Inlines
ils) (Text, Inlines) -> [(Text, Inlines)] -> [(Text, Inlines)]
forall a. a -> [a] -> [a]
: RTFState -> [(Text, Inlines)]
sMetadata RTFState
s }
      Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped toks :: [Tok]
toks -> RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ((Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs [Tok]
toks)
    UnformattedText t :: Text
t -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      -- return $! traceShowId $! (pos, t)
      Int
eatChars <- RTFState -> Int
sEatChars (RTFState -> Int)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      case Int
eatChars of
        0 -> Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
t
        n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
T.length Text
t -> do
             (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = 0 }
             Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Int -> Text -> Text
T.drop Int
n Text
t)
          | Bool
otherwise -> do
             (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
t }
    HexVal n :: Word8
n -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      Int
eatChars <- RTFState -> Int
sEatChars (RTFState -> Int)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      if Int
eatChars Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
         then do
           CharSet
charset <- RTFState -> CharSet
sCharSet (RTFState -> CharSet)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m CharSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
           case CharSet
charset of
             ANSI -> Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
ansiToChar Word8
n)
             Mac  -> Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
macToChar Word8
n)
             Pc   -> Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
pcToChar Word8
n)
             Pca  -> Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
pcaToChar Word8
n)
         else (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Int
eatChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 }
    ControlWord "ansi" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\s :: RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
ANSI })
    ControlWord "mac" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\s :: RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
Mac })
    ControlWord "pc" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\s :: RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
Pc })
    ControlWord "pca" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\s :: RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
Pca })
    ControlWord "outlinelevel" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gOutlineLevel :: Maybe Int
gOutlineLevel = Maybe Int
mbp })
    ControlWord "ls" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gListOverride :: Maybe Int
gListOverride = Maybe Int
mbp })
    ControlWord "ilvl" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gListLevel :: Maybe Int
gListLevel = Maybe Int
mbp })
    ControlSymbol '\\' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\\"
    ControlSymbol '{' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "{"
    ControlSymbol '}' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "}"
    ControlSymbol '~' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x00a0"
    ControlSymbol '-' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x00ad"
    ControlSymbol '_' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2011"
    ControlWord "trowd" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do -- add new row
      (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTableRows :: [TableRow]
sTableRows = [Blocks] -> TableRow
TableRow [] TableRow -> [TableRow] -> [TableRow]
forall a. a -> [a] -> [a]
: RTFState -> [TableRow]
sTableRows RTFState
s
                           , sCurrentCell :: Blocks
sCurrentCell = Blocks
forall a. Monoid a => a
mempty }
    ControlWord "cell" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      Blocks
new <- Blocks -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks Blocks
forall a. Monoid a => a
mempty
      Blocks
curCell <- (Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
new) (Blocks -> Blocks) -> (RTFState -> Blocks) -> RTFState -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTFState -> Blocks
sCurrentCell (RTFState -> Blocks)
-> ParsecT Sources RTFState m RTFState -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTableRows :: [TableRow]
sTableRows =
                                case RTFState -> [TableRow]
sTableRows RTFState
s of
                                  TableRow cs :: [Blocks]
cs : rs :: [TableRow]
rs ->
                                    [Blocks] -> TableRow
TableRow (Blocks
curCell Blocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
: [Blocks]
cs) TableRow -> [TableRow] -> [TableRow]
forall a. a -> [a] -> [a]
: [TableRow]
rs
                                  [] -> [[Blocks] -> TableRow
TableRow [Blocks
curCell]] -- shouldn't happen
                           , sCurrentCell :: Blocks
sCurrentCell = Blocks
forall a. Monoid a => a
mempty }
    ControlWord "intbl" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gInTable :: Bool
gInTable = Bool
True })
    ControlWord "plain" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (Properties -> Properties -> Properties
forall a b. a -> b -> a
const Properties
forall a. Default a => a
def)
    ControlWord "lquote" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2018"
    ControlWord "rquote" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2019"
    ControlWord "ldblquote" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x201C"
    ControlWord "rdblquote" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x201D"
    ControlWord "emdash" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2014"
    ControlWord "emspace" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2003"
    ControlWord "enspace" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2002"
    ControlWord "endash" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2013"
    ControlWord "bullet" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2022"
    ControlWord "tab" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\t"
    ControlWord "line" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\n"
    ControlSymbol '\n' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\n"
    ControlSymbol '\r' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\n"
    ControlWord "uc" (Just i :: Int
i) -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gUC :: Int
gUC = Int
i })
    ControlWord "cs" (Just n :: Int
n) -> do
      Int -> RTFParser m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
n RTFParser m [Tok]
-> ([Tok] -> RTFParser m Blocks) -> RTFParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
    ControlWord "s" (Just n :: Int
n) -> do
      Int -> RTFParser m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
n RTFParser m [Tok]
-> ([Tok] -> RTFParser m Blocks) -> RTFParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
    ControlWord "ds" (Just n :: Int
n) -> do
      Int -> RTFParser m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
n RTFParser m [Tok]
-> ([Tok] -> RTFParser m Blocks) -> RTFParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
    ControlWord "f" (Just i :: Int
i) -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      FontTable
fontTable <- RTFState -> FontTable
sFontTable (RTFState -> FontTable)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m FontTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gFontFamily :: Maybe FontFamily
gFontFamily = Int -> FontTable -> Maybe FontFamily
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i FontTable
fontTable })
    ControlWord "u" (Just i :: Int
i) -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      RTFState
st <- ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      let curgroup :: Properties
curgroup = case RTFState -> [Properties]
sGroupStack RTFState
st of
                       [] -> Properties
forall a. Default a => a
def
                       (x :: Properties
x:_) -> Properties
x
      (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Properties -> Int
gUC Properties
curgroup }
      -- "RTF control words generally accept signed 16-bit numbers as
      -- arguments. For this reason, Unicode values greater than 32767
      -- must be expressed as negative numbers."
      let codepoint :: Word16
          codepoint :: Word16
codepoint = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
      Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton (Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
codepoint))
    ControlWord "caps" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gCaps :: Bool
gCaps = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "deleted" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "b" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gBold :: Bool
gBold = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "i" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gItalic :: Bool
gItalic = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "sub" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gSub :: Bool
gSub = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "super" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gSuper :: Bool
gSuper = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "up" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gSuper :: Bool
gSuper = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "strike" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "strikedl" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "striked" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "scaps" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gSmallCaps :: Bool
gSmallCaps = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "v" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gHidden :: Bool
gHidden = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord x :: Text
x mbp :: Maybe Int
mbp | Text -> Bool
isUnderline Text
x -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gUnderline :: Bool
gUnderline = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord "ulnone" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gUnderline :: Bool
gUnderline = Bool
False })
    ControlWord "pard" _ -> Blocks
bs Blocks -> RTFParser m Blocks -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (Properties -> Properties -> Properties
forall a b. a -> b -> a
const Properties
forall a. Default a => a
def)
      Int -> RTFParser m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting 0 RTFParser m [Tok]
-> ([Tok] -> RTFParser m Blocks) -> RTFParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
    ControlWord "par" _ -> Blocks -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks Blocks
bs
    _ -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs

processDestinationToks :: PandocMonad m => [Tok] -> RTFParser m Blocks
processDestinationToks :: [Tok] -> RTFParser m Blocks
processDestinationToks toks :: [Tok]
toks = do
  [(Properties, Text)]
textContent <- RTFState -> [(Properties, Text)]
sTextContent (RTFState -> [(Properties, Text)])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [(Properties, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  [List]
liststack <- RTFState -> [List]
sListStack (RTFState -> [List])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [List]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [(Properties, Text)]
forall a. Monoid a => a
mempty
                       , sListStack :: [List]
sListStack = [] }
  Blocks
result <- RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (RTFParser m Blocks -> RTFParser m Blocks)
-> RTFParser m Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$
              (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
forall a. Monoid a => a
mempty [Tok]
toks RTFParser m Blocks
-> (Blocks -> RTFParser m Blocks) -> RTFParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Blocks -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks
  Blocks
unclosed <- RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeContainers
  (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [(Properties, Text)]
textContent
                       , sListStack :: [List]
sListStack = [List]
liststack }
  Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
result Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
unclosed

-- close lists >= level
closeLists :: PandocMonad m => Int -> RTFParser m Blocks
closeLists :: Int -> RTFParser m Blocks
closeLists lvl :: Int
lvl = do
  [List]
lists <- RTFState -> [List]
sListStack (RTFState -> [List])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [List]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case [List]
lists of
    (List _ lvl' :: Int
lvl' lt :: ListType
lt items :: [Blocks]
items : rest :: [List]
rest) | Int
lvl' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lvl -> do
      let newlist :: Blocks
newlist = (case ListType
lt of
                      Bullet -> [Blocks] -> Blocks
B.bulletList
                      Ordered listAttr :: ListAttributes
listAttr -> ListAttributes -> [Blocks] -> Blocks
B.orderedListWith ListAttributes
listAttr)
                    ([Blocks] -> [Blocks]
forall a. [a] -> [a]
reverse [Blocks]
items)
      (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sListStack :: [List]
sListStack = [List]
rest }
      case [List]
rest of
        [] -> do
          (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sListStack :: [List]
sListStack = [List]
rest }
          Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
newlist
        (List lo :: Int
lo lvl'' :: Int
lvl'' lt' :: ListType
lt' [] : rest' :: [List]
rest') -> do -- should not happen
          (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sListStack :: [List]
sListStack =
               Int -> Int -> ListType -> [Blocks] -> List
List Int
lo Int
lvl'' ListType
lt' [Blocks
newlist] List -> [List] -> [List]
forall a. a -> [a] -> [a]
: [List]
rest' }
          Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
lvl
        (List lo :: Int
lo lvl'' :: Int
lvl'' lt' :: ListType
lt' (i :: Blocks
i:is :: [Blocks]
is) : rest' :: [List]
rest') -> do
          (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sListStack :: [List]
sListStack =
               Int -> Int -> ListType -> [Blocks] -> List
List Int
lo Int
lvl'' ListType
lt' (Blocks
i Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
newlist Blocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
: [Blocks]
is) List -> [List] -> [List]
forall a. a -> [a] -> [a]
: [List]
rest' }
          Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
lvl
    _ -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty

closeTable :: PandocMonad m => RTFParser m Blocks
closeTable :: RTFParser m Blocks
closeTable = do
  [TableRow]
rawrows <- RTFState -> [TableRow]
sTableRows (RTFState -> [TableRow])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [TableRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  if [TableRow] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TableRow]
rawrows
     then Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
     else do
       let getCells :: TableRow -> [Blocks]
getCells (TableRow cs :: [Blocks]
cs) = [Blocks] -> [Blocks]
forall a. [a] -> [a]
reverse [Blocks]
cs
       let rows :: [[Blocks]]
rows = (TableRow -> [Blocks]) -> [TableRow] -> [[Blocks]]
forall a b. (a -> b) -> [a] -> [b]
map TableRow -> [Blocks]
getCells ([TableRow] -> [[Blocks]])
-> ([TableRow] -> [TableRow]) -> [TableRow] -> [[Blocks]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TableRow] -> [TableRow]
forall a. [a] -> [a]
reverse ([TableRow] -> [[Blocks]]) -> [TableRow] -> [[Blocks]]
forall a b. (a -> b) -> a -> b
$ [TableRow]
rawrows
       (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sCurrentCell :: Blocks
sCurrentCell = Blocks
forall a. Monoid a => a
mempty
                            , sTableRows :: [TableRow]
sTableRows = [] }
       Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> [[Blocks]] -> Blocks
B.simpleTable [] [[Blocks]]
rows

closeContainers :: PandocMonad m => RTFParser m Blocks
closeContainers :: RTFParser m Blocks
closeContainers = do
  Blocks
tbl <- RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeTable
  Blocks
lists <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists 0
  Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
tbl Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
lists

trimFinalLineBreak :: Inlines -> Inlines
trimFinalLineBreak :: Inlines -> Inlines
trimFinalLineBreak ils :: Inlines
ils =
  case Seq Inline -> ViewR Inline
forall a. Seq a -> ViewR a
Seq.viewr (Inlines -> Seq Inline
forall a. Many a -> Seq a
B.unMany Inlines
ils) of
    rest :: Seq Inline
rest Seq.:> LineBreak -> Seq Inline -> Inlines
forall a. Seq a -> Many a
B.Many Seq Inline
rest
    _ -> Inlines
ils

emitBlocks :: PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks :: Blocks -> RTFParser m Blocks
emitBlocks bs :: Blocks
bs = do
  [(Properties, Text)]
annotatedToks <- [(Properties, Text)] -> [(Properties, Text)]
forall a. [a] -> [a]
reverse ([(Properties, Text)] -> [(Properties, Text)])
-> (RTFState -> [(Properties, Text)])
-> RTFState
-> [(Properties, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTFState -> [(Properties, Text)]
sTextContent (RTFState -> [(Properties, Text)])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [(Properties, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [] }
  let justCode :: Properties
justCode = Properties
forall a. Default a => a
def{ gFontFamily :: Maybe FontFamily
gFontFamily = FontFamily -> Maybe FontFamily
forall a. a -> Maybe a
Just FontFamily
Modern }
  let prop :: Properties
prop = case [(Properties, Text)]
annotatedToks of
               [] -> Properties
forall a. Default a => a
def
               ((p :: Properties
p,_):_) -> Properties
p
  Blocks
tbl <- if Properties -> Bool
gInTable Properties
prop Bool -> Bool -> Bool
|| [(Properties, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Properties, Text)]
annotatedToks
            then Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
            else RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeTable
  Blocks
new <-
    case [(Properties, Text)]
annotatedToks of
      [] -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
      _ | Just lst :: Int
lst <- Properties -> Maybe Int
gListOverride Properties
prop
         -> do
           let level :: Int
level = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Properties -> Maybe Int
gListLevel Properties
prop
           ListTable
listOverrideTable <- RTFState -> ListTable
sListOverrideTable (RTFState -> ListTable)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m ListTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
           let listType :: ListType
listType = ListType -> Maybe ListType -> ListType
forall a. a -> Maybe a -> a
fromMaybe ListType
Bullet (Maybe ListType -> ListType) -> Maybe ListType -> ListType
forall a b. (a -> b) -> a -> b
$
                 Int -> ListTable -> Maybe ListLevelTable
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
lst ListTable
listOverrideTable Maybe ListLevelTable
-> (ListLevelTable -> Maybe ListType) -> Maybe ListType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ListLevelTable -> Maybe ListType
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
level
           [List]
lists <- RTFState -> [List]
sListStack (RTFState -> [List])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [List]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
           -- get para contents of list item
           let newbs :: Blocks
newbs = Inlines -> Blocks
B.para (Inlines -> Blocks)
-> ([Inlines] -> Inlines) -> [Inlines] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
B.trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimFinalLineBreak (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Blocks) -> [Inlines] -> Blocks
forall a b. (a -> b) -> a -> b
$
                        ((Properties, Text) -> Inlines)
-> [(Properties, Text)] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Inlines
addFormatting [(Properties, Text)]
annotatedToks
           case [List]
lists of
             (List lo :: Int
lo parentlevel :: Int
parentlevel _lt :: ListType
_lt items :: [Blocks]
items : cs :: [List]
cs)
               | Int
lo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lst
               , Int
parentlevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
level
               -- add another item to existing list
               -> do (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s ->
                        RTFState
s{ sListStack :: [List]
sListStack =
                             Int -> Int -> ListType -> [Blocks] -> List
List Int
lo Int
level ListType
listType (Blocks
newbsBlocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[Blocks]
items) List -> [List] -> [List]
forall a. a -> [a] -> [a]
: [List]
cs }
                     Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
               | Int
lo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
lst Bool -> Bool -> Bool
|| Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
parentlevel
               -- close parent list and add new list
               -> do Blocks
new <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
level  -- close open lists > level
                     (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s ->
                       RTFState
s{ sListStack :: [List]
sListStack = Int -> Int -> ListType -> [Blocks] -> List
List Int
lst Int
level ListType
listType [Blocks
newbs] List -> [List] -> [List]
forall a. a -> [a] -> [a]
:
                           RTFState -> [List]
sListStack RTFState
s }
                     Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
new
             _ -> do -- add new list (level > parentlevel)
                  (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s ->
                    RTFState
s{ sListStack :: [List]
sListStack = Int -> Int -> ListType -> [Blocks] -> List
List Int
lst Int
level ListType
listType [Blocks
newbs] List -> [List] -> [List]
forall a. a -> [a] -> [a]
:
                         RTFState -> [List]
sListStack RTFState
s }
                  Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
        | Just lvl :: Int
lvl <- Properties -> Maybe Int
gOutlineLevel Properties
prop
         -> do
            Blocks
lists <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists 0
            Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
lists Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<>
                   Int -> Inlines -> Blocks
B.header (Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
                   (Inlines -> Inlines
B.trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ((Properties, Text) -> Inlines)
-> [(Properties, Text)] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Inlines
addFormatting
                                            ([(Properties, Text)] -> [Inlines])
-> [(Properties, Text)] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ [(Properties, Text)] -> [(Properties, Text)]
removeCommonFormatting
                                              [(Properties, Text)]
annotatedToks)
        | ((Properties, Text) -> Bool) -> [(Properties, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Properties -> Properties -> Bool
forall a. Eq a => a -> a -> Bool
== Properties
justCode) (Properties -> Bool)
-> ((Properties, Text) -> Properties) -> (Properties, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Properties, Text) -> Properties
forall a b. (a, b) -> a
fst) [(Properties, Text)]
annotatedToks
         -> do
            Blocks
lists <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists 0
            Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
lists Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<>
                    Text -> Blocks
B.codeBlock ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Properties, Text) -> Text) -> [(Properties, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Text
forall a b. (a, b) -> b
snd [(Properties, Text)]
annotatedToks)
        | ((Properties, Text) -> Bool) -> [(Properties, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace (Text -> Bool)
-> ((Properties, Text) -> Text) -> (Properties, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Properties, Text) -> Text
forall a b. (a, b) -> b
snd) [(Properties, Text)]
annotatedToks
         -> Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists 0
        | Bool
otherwise -> do
            Blocks
lists <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists 0
            Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
lists Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<>
              Inlines -> Blocks
B.para (Inlines -> Inlines
B.trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimFinalLineBreak (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat
                ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ((Properties, Text) -> Inlines)
-> [(Properties, Text)] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Inlines
addFormatting [(Properties, Text)]
annotatedToks)
  if Properties -> Bool
gInTable Properties
prop
     then do
       (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sCurrentCell :: Blocks
sCurrentCell = RTFState -> Blocks
sCurrentCell RTFState
s Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
new }
       Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
     else do
       Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
bs Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
tbl Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
new

-- Headers often have a style applied. We usually want to remove
-- this, because headers will have their own styling in the target
-- format.
removeCommonFormatting :: [(Properties, Text)] -> [(Properties, Text)]
removeCommonFormatting :: [(Properties, Text)] -> [(Properties, Text)]
removeCommonFormatting =
  (\ts :: [(Properties, Text)]
ts ->
    if ((Properties, Text) -> Bool) -> [(Properties, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Properties -> Bool
gBold (Properties -> Bool)
-> ((Properties, Text) -> Properties) -> (Properties, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Properties, Text) -> Properties
forall a b. (a, b) -> a
fst) [(Properties, Text)]
ts
       then ((Properties, Text) -> (Properties, Text))
-> [(Properties, Text)] -> [(Properties, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(p :: Properties
p,t :: Text
t) -> (Properties
p{ gBold :: Bool
gBold = Bool
False }, Text
t)) [(Properties, Text)]
ts
       else [(Properties, Text)]
ts) ([(Properties, Text)] -> [(Properties, Text)])
-> ([(Properties, Text)] -> [(Properties, Text)])
-> [(Properties, Text)]
-> [(Properties, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (\ts :: [(Properties, Text)]
ts ->
    if ((Properties, Text) -> Bool) -> [(Properties, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Properties -> Bool
gItalic (Properties -> Bool)
-> ((Properties, Text) -> Properties) -> (Properties, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Properties, Text) -> Properties
forall a b. (a, b) -> a
fst) [(Properties, Text)]
ts
       then ((Properties, Text) -> (Properties, Text))
-> [(Properties, Text)] -> [(Properties, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(p :: Properties
p,t :: Text
t) -> (Properties
p{ gItalic :: Bool
gItalic = Bool
False }, Text
t)) [(Properties, Text)]
ts
       else [(Properties, Text)]
ts)


-- {\field{\*\fldinst{HYPERLINK "http://pandoc.org"}}{\fldrslt foo}}
handleField :: PandocMonad m => Blocks -> [Tok] -> RTFParser m Blocks
handleField :: Blocks -> [Tok] -> RTFParser m Blocks
handleField bs :: Blocks
bs
  (Tok _
    (Grouped
     (Tok _ (ControlSymbol '*')
     :Tok _ (ControlWord "fldinst" Nothing)
     :Tok _ (Grouped (Tok _ (UnformattedText insttext :: Text
insttext):rest :: [Tok]
rest))
     :_))
  :linktoks :: [Tok]
linktoks)
  | Just linkdest :: Text
linkdest <- Text -> Maybe Text
getHyperlink Text
insttext
  = do let linkdest' :: Text
linkdest' = case [Tok]
rest of
                         (Tok _ (ControlSymbol '\\')
                          : Tok _ (UnformattedText t :: Text
t)
                          : _) | Just bkmrk :: Text
bkmrk <- Text -> Text -> Maybe Text
T.stripPrefix "l" Text
t
                           -> "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
unquote Text
bkmrk
                         _ -> Text
linkdest
       (Properties -> Properties) -> RTFParser m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup ((Properties -> Properties) -> RTFParser m ())
-> (Properties -> Properties) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \g :: Properties
g -> Properties
g{ gHyperlink :: Maybe Text
gHyperlink = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
linkdest' }
       Blocks
result <- (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs [Tok]
linktoks
       (Properties -> Properties) -> RTFParser m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup ((Properties -> Properties) -> RTFParser m ())
-> (Properties -> Properties) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \g :: Properties
g -> Properties
g{ gHyperlink :: Maybe Text
gHyperlink = Maybe Text
forall a. Maybe a
Nothing }
       Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
result
handleField bs :: Blocks
bs _ = Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs

unquote :: Text -> Text
unquote :: Text -> Text
unquote = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='"') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='"') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip

handleListTable :: PandocMonad m => [Tok] -> RTFParser m ()
handleListTable :: [Tok] -> RTFParser m ()
handleListTable toks :: [Tok]
toks = do
  (Tok -> RTFParser m ()) -> [Tok] -> RTFParser m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Tok -> RTFParser m ()
forall (m :: * -> *). PandocMonad m => Tok -> RTFParser m ()
handleList [Tok]
toks

handleList :: PandocMonad m => Tok -> RTFParser m ()
handleList :: Tok -> RTFParser m ()
handleList (Tok _ (Grouped (Tok _ (ControlWord "list" _) : toks :: [Tok]
toks))) = do
  let listid :: Int
listid = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef 0 [Int
n | Tok _ (ControlWord "listid" (Just n :: Int
n)) <- [Tok]
toks]
  let levels :: [[Tok]]
levels = [[Tok]
ts | Tok _ (Grouped (Tok _ (ControlWord "listlevel" _) : ts :: [Tok]
ts))
                 <- [Tok]
toks]
  ListLevelTable
tbl <- (ListLevelTable
 -> (Int, [Tok]) -> ParsecT Sources RTFState m ListLevelTable)
-> ListLevelTable
-> [(Int, [Tok])]
-> ParsecT Sources RTFState m ListLevelTable
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ListLevelTable
-> (Int, [Tok]) -> ParsecT Sources RTFState m ListLevelTable
forall (m :: * -> *).
PandocMonad m =>
ListLevelTable -> (Int, [Tok]) -> RTFParser m ListLevelTable
handleListLevel ListLevelTable
forall a. Monoid a => a
mempty ([Int] -> [[Tok]] -> [(Int, [Tok])]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [[Tok]]
levels)
  (RTFState -> RTFState) -> RTFParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> RTFParser m ())
-> (RTFState -> RTFState) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sListTable :: ListTable
sListTable = Int -> ListLevelTable -> ListTable -> ListTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
listid ListLevelTable
tbl (ListTable -> ListTable) -> ListTable -> ListTable
forall a b. (a -> b) -> a -> b
$ RTFState -> ListTable
sListTable RTFState
s }
handleList _ = () -> RTFParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

handleListLevel :: PandocMonad m
                => ListLevelTable
                -> (Int, [Tok])
                -> RTFParser m ListLevelTable
handleListLevel :: ListLevelTable -> (Int, [Tok]) -> RTFParser m ListLevelTable
handleListLevel levelTable :: ListLevelTable
levelTable (lvl :: Int
lvl, toks :: [Tok]
toks) = do
  let start :: Int
start = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef 1
                [Int
n | Tok _ (ControlWord "levelstartat" (Just n :: Int
n)) <- [Tok]
toks]
  let mbNumberStyle :: Maybe ListNumberStyle
mbNumberStyle =
        case [Int
n | Tok _ (ControlWord "levelnfc" (Just n :: Int
n)) <- [Tok]
toks] of
          [] -> Maybe ListNumberStyle
forall a. Maybe a
Nothing
          (0:_) -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
Decimal
          (1:_) -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
UpperRoman
          (2:_) -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
LowerRoman
          (3:_) -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
UpperAlpha
          (4:_) -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
LowerAlpha
          (23:_) -> Maybe ListNumberStyle
forall a. Maybe a
Nothing
          (255:_) -> Maybe ListNumberStyle
forall a. Maybe a
Nothing
          _ -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
DefaultStyle
  let listType :: ListType
listType = case Maybe ListNumberStyle
mbNumberStyle of
                   Nothing -> ListType
Bullet
                   Just numStyle :: ListNumberStyle
numStyle -> ListAttributes -> ListType
Ordered (Int
start,ListNumberStyle
numStyle,ListNumberDelim
Period)
  ListLevelTable -> RTFParser m ListLevelTable
forall (m :: * -> *) a. Monad m => a -> m a
return (ListLevelTable -> RTFParser m ListLevelTable)
-> ListLevelTable -> RTFParser m ListLevelTable
forall a b. (a -> b) -> a -> b
$ Int -> ListType -> ListLevelTable -> ListLevelTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
lvl ListType
listType ListLevelTable
levelTable

handleListOverrideTable :: PandocMonad m => [Tok] -> RTFParser m ()
handleListOverrideTable :: [Tok] -> RTFParser m ()
handleListOverrideTable toks :: [Tok]
toks = (Tok -> RTFParser m ()) -> [Tok] -> RTFParser m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Tok -> RTFParser m ()
forall (m :: * -> *). PandocMonad m => Tok -> RTFParser m ()
handleListOverride [Tok]
toks

handleListOverride :: PandocMonad m => Tok -> RTFParser m ()
handleListOverride :: Tok -> RTFParser m ()
handleListOverride
 (Tok _ (Grouped (Tok _ (ControlWord "listoverride" _) : toks :: [Tok]
toks))) = do
  let listid :: Int
listid = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef 0 [Int
n | Tok _ (ControlWord "listid" (Just n :: Int
n)) <- [Tok]
toks]
  let lsn :: Int
lsn = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef 0 [Int
n | Tok _ (ControlWord "ls" (Just n :: Int
n)) <- [Tok]
toks]
  -- TODO override stuff, esp. start num -- for now we just handle indirection
  ListTable
listTable <- RTFState -> ListTable
sListTable (RTFState -> ListTable)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m ListTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case Int -> ListTable -> Maybe ListLevelTable
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
listid ListTable
listTable of
    Nothing -> () -> RTFParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just tbl :: ListLevelTable
tbl -> (RTFState -> RTFState) -> RTFParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> RTFParser m ())
-> (RTFState -> RTFState) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s ->
                   RTFState
s{ sListOverrideTable :: ListTable
sListOverrideTable = Int -> ListLevelTable -> ListTable -> ListTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
lsn ListLevelTable
tbl (ListTable -> ListTable) -> ListTable -> ListTable
forall a b. (a -> b) -> a -> b
$
                        RTFState -> ListTable
sListOverrideTable RTFState
s }
handleListOverride _ = () -> RTFParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

handleStylesheet :: PandocMonad m => [Tok] -> RTFParser m ()
handleStylesheet :: [Tok] -> RTFParser m ()
handleStylesheet toks :: [Tok]
toks = do
  let styles :: [Style]
styles = (Tok -> Maybe Style) -> [Tok] -> [Style]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tok -> Maybe Style
parseStyle [Tok]
toks
  (RTFState -> RTFState) -> RTFParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> RTFParser m ())
-> (RTFState -> RTFState) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sStylesheet :: Stylesheet
sStylesheet = [(Int, Style)] -> Stylesheet
forall a. [(Int, a)] -> IntMap a
IntMap.fromList
                                     ([(Int, Style)] -> Stylesheet) -> [(Int, Style)] -> Stylesheet
forall a b. (a -> b) -> a -> b
$ [Int] -> [Style] -> [(Int, Style)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Style -> Int) -> [Style] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Style -> Int
styleNum [Style]
styles) [Style]
styles }

parseStyle :: Tok -> Maybe Style
parseStyle :: Tok -> Maybe Style
parseStyle (Tok _ (Grouped toks :: [Tok]
toks)) = do
  let (styType :: StyleType
styType, styNum :: Int
styNum, rest :: [Tok]
rest) =
        case [Tok]
toks of
          Tok _ (ControlWord "s" (Just n :: Int
n)) : ts :: [Tok]
ts -> (StyleType
ParagraphStyle, Int
n, [Tok]
ts)
          Tok _ (ControlWord "ds" (Just n :: Int
n)) : ts :: [Tok]
ts -> (StyleType
SectionStyle, Int
n, [Tok]
ts)
          Tok _ (ControlWord "cs" (Just n :: Int
n)) : ts :: [Tok]
ts -> (StyleType
CharStyle, Int
n, [Tok]
ts)
          Tok _ (ControlWord "ts" (Just n :: Int
n)) : ts :: [Tok]
ts -> (StyleType
TableStyle, Int
n, [Tok]
ts)
          _ -> (StyleType
ParagraphStyle, 0, [Tok]
toks)
  let styName :: Text
styName = case [Tok] -> Maybe Tok
forall a. [a] -> Maybe a
lastMay [Tok]
rest of
                  Just (Tok _ (UnformattedText t :: Text
t)) -> (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==';') Text
t
                  _ -> Text
forall a. Monoid a => a
mempty
  let isBasedOn :: Tok -> Bool
isBasedOn (Tok _ (ControlWord "sbasedon" (Just _))) = Bool
True
      isBasedOn _ = Bool
False
  let styBasedOn :: Maybe Int
styBasedOn = case (Tok -> Bool) -> [Tok] -> Maybe Tok
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Tok -> Bool
isBasedOn [Tok]
toks of
                     Just (Tok _ (ControlWord "sbasedon" (Just i :: Int
i))) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
                     _ -> Maybe Int
forall a. Maybe a
Nothing
  let isStyleControl :: Tok -> Bool
isStyleControl (Tok _ (ControlWord x :: Text
x _)) =
         Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["cs", "s", "ds", "additive", "sbasedon", "snext",
                   "sautoupd", "shidden", "keycode", "alt", "shift",
                   "ctrl", "fn"]
      isStyleControl _ = Bool
False
  let styFormatting :: [Tok]
styFormatting = (Tok -> Bool) -> [Tok] -> [Tok]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> Bool
isStyleControl) ([Tok] -> [Tok]
forall a. [a] -> [a]
initSafe [Tok]
rest)
  Style -> Maybe Style
forall (m :: * -> *) a. Monad m => a -> m a
return (Style -> Maybe Style) -> Style -> Maybe Style
forall a b. (a -> b) -> a -> b
$ Style :: Int -> StyleType -> Maybe Int -> Text -> [Tok] -> Style
Style{ styleNum :: Int
styleNum = Int
styNum
                , styleType :: StyleType
styleType = StyleType
styType
                , styleBasedOn :: Maybe Int
styleBasedOn = Maybe Int
styBasedOn
                , styleName :: Text
styleName = Text
styName
                , styleFormatting :: [Tok]
styleFormatting = [Tok]
styFormatting
                }
parseStyle _ = Maybe Style
forall a. Maybe a
Nothing

hexToWord  :: Text -> Word8
hexToWord :: Text -> Word8
hexToWord t :: Text
t = case Reader Word8
forall a. Integral a => Reader a
TR.hexadecimal Text
t of
                Left _ -> 0
                Right (x :: Word8
x,_) -> Word8
x


handlePict :: PandocMonad m => [Tok] -> RTFParser m ()
handlePict :: [Tok] -> RTFParser m ()
handlePict toks :: [Tok]
toks = do
  let pict :: Pict
pict = (Pict -> Tok -> Pict) -> Pict -> [Tok] -> Pict
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Pict -> Tok -> Pict
getPictData Pict
forall a. Default a => a
def [Tok]
toks
  let altText :: Text
altText = "image"
  let bytes :: ByteString
bytes =
        if Pict -> Bool
picBinary Pict
pict
           then Pict -> ByteString
picBytes Pict
pict
           else [Word8] -> ByteString
BL.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Text -> Word8) -> [Text] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Word8
hexToWord ([Text] -> [Word8]) -> [Text] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf 2 (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Pict -> Text
picData Pict
pict
  let (mimetype :: Maybe Text
mimetype, ext :: String
ext) =
        case Pict -> Maybe PictType
picType Pict
pict of
          Just Emfblip -> (Text -> Maybe Text
forall a. a -> Maybe a
Just "image/x-emf", ".emf")
          Just Pngblip -> (Text -> Maybe Text
forall a. a -> Maybe a
Just "image/png", ".png")
          Just Jpegblip -> (Text -> Maybe Text
forall a. a -> Maybe a
Just "image/jpeg", ".jpg")
          Nothing -> (Maybe Text
forall a. Maybe a
Nothing, "")
  case Maybe Text
mimetype of
    Just mt :: Text
mt -> do
      let pictname :: String
pictname = Digest SHA1State -> String
forall t. Digest t -> String
showDigest (ByteString -> Digest SHA1State
sha1 ByteString
bytes) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ext
      String -> Maybe Text -> ByteString -> RTFParser m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia String
pictname (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mt) ByteString
bytes
      (Properties -> Properties) -> RTFParser m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup ((Properties -> Properties) -> RTFParser m ())
-> (Properties -> Properties) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \g :: Properties
g -> Properties
g{ gImage :: Maybe Pict
gImage = Pict -> Maybe Pict
forall a. a -> Maybe a
Just Pict
pict{ picName :: Text
picName = String -> Text
T.pack String
pictname,
                                                 picBytes :: ByteString
picBytes = ByteString
bytes } }
      Text -> RTFParser m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
altText
      (Properties -> Properties) -> RTFParser m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup ((Properties -> Properties) -> RTFParser m ())
-> (Properties -> Properties) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \g :: Properties
g -> Properties
g{ gImage :: Maybe Pict
gImage = Maybe Pict
forall a. Maybe a
Nothing }
    _ -> () -> RTFParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  getPictData :: Pict -> Tok -> Pict
  getPictData :: Pict -> Tok -> Pict
getPictData pict :: Pict
pict (Tok _ tok' :: TokContents
tok') =
    case TokContents
tok' of
      ControlWord "emfblip" _-> Pict
pict{ picType :: Maybe PictType
picType = PictType -> Maybe PictType
forall a. a -> Maybe a
Just PictType
Emfblip }
      ControlWord "pngblip" _-> Pict
pict{ picType :: Maybe PictType
picType = PictType -> Maybe PictType
forall a. a -> Maybe a
Just PictType
Pngblip }
      ControlWord "jpegblip" _-> Pict
pict{ picType :: Maybe PictType
picType = PictType -> Maybe PictType
forall a. a -> Maybe a
Just PictType
Jpegblip }
      ControlWord "picw" (Just w :: Int
w) -> Pict
pict{ picWidth :: Maybe Int
picWidth = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w }
      ControlWord "pich" (Just h :: Int
h) -> Pict
pict{ picHeight :: Maybe Int
picHeight = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h }
      ControlWord "picwgoal" (Just w :: Int
w) -> Pict
pict{ picWidthGoal :: Maybe Int
picWidthGoal = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w }
      ControlWord "pichgoal" (Just h :: Int
h) -> Pict
pict{ picHeightGoal :: Maybe Int
picHeightGoal = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h }
      BinData d :: ByteString
d | Bool -> Bool
not (ByteString -> Bool
BL.null ByteString
d)
                  -> Pict
pict{ picBinary :: Bool
picBinary = Bool
True, picBytes :: ByteString
picBytes = Pict -> ByteString
picBytes Pict
pict ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
d }
      UnformattedText t :: Text
t -> Pict
pict{ picData :: Text
picData = Text
t }
      _ -> Pict
pict


getHyperlink :: Text -> Maybe Text
getHyperlink :: Text -> Maybe Text
getHyperlink t :: Text
t =
  case Text -> Text -> Maybe Text
T.stripPrefix "HYPERLINK" (Text -> Text
T.strip Text
t) of
    Nothing -> Maybe Text
forall a. Maybe a
Nothing
    Just rest :: Text
rest -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
unquote Text
rest

processFontTable :: [Tok] -> FontTable
processFontTable :: [Tok] -> FontTable
processFontTable = (Int, FontTable) -> FontTable
forall a b. (a, b) -> b
snd ((Int, FontTable) -> FontTable)
-> ([Tok] -> (Int, FontTable)) -> [Tok] -> FontTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, FontTable) -> Tok -> (Int, FontTable))
-> (Int, FontTable) -> [Tok] -> (Int, FontTable)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, FontTable) -> Tok -> (Int, FontTable)
go (0, FontTable
forall a. Monoid a => a
mempty)
 where
  go :: (Int, FontTable) -> Tok -> (Int, FontTable)
go (fontnum :: Int
fontnum, tbl :: FontTable
tbl) (Tok _ tok' :: TokContents
tok') =
    case TokContents
tok' of
     (ControlWord "f" (Just i :: Int
i)) -> (Int
i, FontTable
tbl)
     (ControlWord "fnil" _) -> (Int
fontnum, FontTable
tbl)
     (ControlWord "froman" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Roman FontTable
tbl)
     (ControlWord "fswiss" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Swiss FontTable
tbl)
     (ControlWord "fmodern" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Modern FontTable
tbl)
     (ControlWord "fscript" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Script FontTable
tbl)
     (ControlWord "fdecor" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Decor FontTable
tbl)
     (ControlWord "ftech" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Tech FontTable
tbl)
     (ControlWord "fbidi" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Bidi FontTable
tbl)
     (Grouped ts :: [Tok]
ts) -> ((Int, FontTable) -> Tok -> (Int, FontTable))
-> (Int, FontTable) -> [Tok] -> (Int, FontTable)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, FontTable) -> Tok -> (Int, FontTable)
go (Int
fontnum, FontTable
tbl) [Tok]
ts
     _ -> (Int
fontnum, FontTable
tbl)


ansiToChar :: Word8 -> Char
ansiToChar :: Word8 -> Char
ansiToChar i :: Word8
i = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$
  case Word8
i of
    128 -> 8364
    130 -> 8218
    131 -> 402
    132 -> 8222
    133 -> 8230
    134 -> 8224
    135 -> 8225
    136 -> 710
    137 -> 8240
    138 -> 352
    139 -> 8249
    140 -> 338
    142 -> 381
    145 -> 8216
    146 -> 8217
    147 -> 8220
    148 -> 8221
    149 -> 8226
    150 -> 8211
    151 -> 8212
    152 -> 732
    153 -> 8482
    154 -> 353
    155 -> 8250
    156 -> 339
    158 -> 382
    159 -> 376
    173 -> 0xAD
    _ -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

macToChar :: Word8 -> Char
macToChar :: Word8 -> Char
macToChar i :: Word8
i = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$
  case Word8
i of
    0x80 -> 0xC4
    0x81 -> 0xC5
    0x82 -> 0xC7
    0x83 -> 0xC9
    0x84 -> 0xD1
    0x85 -> 0xD6
    0x86 -> 0xDC
    0x87 -> 0xE1
    0x88 -> 0xE0
    0x89 -> 0xE2
    0x8A -> 0xE4
    0x8B -> 0xE3
    0x8C -> 0xE5
    0x8D -> 0xE7
    0x8E -> 0xE9
    0x8F -> 0xE8
    0x90 -> 0xEA
    0x91 -> 0xEB
    0x92 -> 0xED
    0x93 -> 0xEC
    0x94 -> 0xEE
    0x95 -> 0xEF
    0x96 -> 0xF1
    0x97 -> 0xF3
    0x98 -> 0xF2
    0x99 -> 0xF4
    0x9A -> 0xF6
    0x9B -> 0xF5
    0x9C -> 0xFA
    0x9D -> 0xF9
    0x9E -> 0xFB
    0x9F -> 0xFC
    0xA0 -> 0xDD
    0xA1 -> 0xB0
    0xA2 -> 0xA2
    0xA3 -> 0xA3
    0xA4 -> 0xA7
    0xA5 -> 0xD7
    0xA6 -> 0xB6
    0xA7 -> 0xDF
    0xA8 -> 0xAE
    0xA9 -> 0xA9
    0xAA -> 0xB2
    0xAB -> 0xB4
    0xAC -> 0xA8
    0xAD -> 0xB3
    0xAE -> 0xC6
    0xAF -> 0xD8
    0xB0 -> 0xB9
    0xB1 -> 0xB1
    0xB2 -> 0xBC
    0xB3 -> 0xBD
    0xB4 -> 0xA5
    0xB5 -> 0xB5
    0xBA -> 0xBE
    0xBB -> 0xAA
    0xBC -> 0xBA
    0xBE -> 0xE6
    0xBF -> 0xF8
    0xC0 -> 0xBF
    0xC1 -> 0xA1
    0xC2 -> 0xAC
    0xC3 -> 0x0141
    0xC4 -> 0x0192
    0xC5 -> 0x02CB
    0xC7 -> 0xAB
    0xC8 -> 0xBB
    0xC9 -> 0xA6
    0xCA -> 0xA0
    0xCB -> 0xC0
    0xCC -> 0xC3
    0xCD -> 0xD5
    0xCE -> 0x0152
    0xCF -> 0x0153
    0xD0 -> 0xAD
    0xD4 -> 0x0142
    0xD6 -> 0xF7
    0xD8 -> 0xFF
    0xD9 -> 0x0178
    0xDB -> 0xA4
    0xDC -> 0xD0
    0xDD -> 0xF0
    0xDE -> 0xDE
    0xDF -> 0xFE
    0xE0 -> 0xFD
    0xE1 -> 0xB7
    0xE5 -> 0xC2
    0xE6 -> 0xCA
    0xE7 -> 0xC1
    0xE8 -> 0xCB
    0xE9 -> 0xC8
    0xEA -> 0xCD
    0xEB -> 0xCE
    0xEC -> 0xCF
    0xED -> 0xCC
    0xEE -> 0xD3
    0xEF -> 0xD4
    0xF1 -> 0xD2
    0xF2 -> 0xDA
    0xF3 -> 0xDB
    0xF4 -> 0xD9
    0xF5 -> 0x0131
    0xF6 -> 0x02C6
    0xF7 -> 0x02DC
    0xF8 -> 0xAF
    0xF9 -> 0x02D8
    0xFA -> 0x02D9
    0xFB -> 0x02DA
    0xFC -> 0xB8
    0xFD -> 0x02DD
    0xFE -> 0x02DB
    0xFF -> 0x02C7
    _ -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

pcToChar :: Word8 -> Char
pcToChar :: Word8 -> Char
pcToChar i :: Word8
i = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$
  case Word8
i of
    0x80 -> 0xc7
    0x81 -> 0xfc
    0x82 -> 0xe9
    0x83 -> 0xe2
    0x84 -> 0xe4
    0x85 -> 0xe0
    0x86 -> 0xe5
    0x87 -> 0xe7
    0x88 -> 0xea
    0x89 -> 0xeb
    0x8a -> 0xe8
    0x8b -> 0xef
    0x8c -> 0xee
    0x8d -> 0xec
    0x8e -> 0xc4
    0x8f -> 0xc5
    0x90 -> 0xc9
    0x91 -> 0xe6
    0x92 -> 0xc6
    0x93 -> 0xf4
    0x94 -> 0xf6
    0x95 -> 0xf2
    0x96 -> 0xfb
    0x97 -> 0xf9
    0x98 -> 0xff
    0x99 -> 0xd6
    0x9a -> 0xdc
    0x9b -> 0xa2
    0x9c -> 0xa3
    0x9d -> 0xa5
    0x9e -> 0x20a7
    0x9f -> 0x0192
    0xa0 -> 0xe1
    0xa1 -> 0xed
    0xa2 -> 0xf3
    0xa3 -> 0xfa
    0xa4 -> 0xf1
    0xa5 -> 0xd1
    0xa6 -> 0xaa
    0xa7 -> 0xba
    0xa8 -> 0xbf
    0xa9 -> 0x2310
    0xaa -> 0xac
    0xab -> 0xbd
    0xac -> 0xbc
    0xad -> 0xa1
    0xae -> 0xab
    0xaf -> 0xbb
    0xb0 -> 0x2591
    0xb1 -> 0x2592
    0xb2 -> 0x2593
    0xb3 -> 0x2502
    0xb4 -> 0x2524
    0xb5 -> 0x2561
    0xb6 -> 0x2562
    0xb7 -> 0x2556
    0xb8 -> 0x2555
    0xb9 -> 0x2563
    0xba -> 0x2551
    0xbb -> 0x2557
    0xbc -> 0x255d
    0xbd -> 0x255c
    0xbe -> 0x255b
    0xbf -> 0x2510
    0xc0 -> 0x2514
    0xc1 -> 0x2534
    0xc2 -> 0x252c
    0xc3 -> 0x251c
    0xc4 -> 0x2500
    0xc5 -> 0x253c
    0xc6 -> 0x255e
    0xc7 -> 0x255f
    0xc8 -> 0x255a
    0xc9 -> 0x2554
    0xca -> 0x2569
    0xcb -> 0x2566
    0xcc -> 0x2560
    0xcd -> 0x2550
    0xce -> 0x256c
    0xcf -> 0x2567
    0xd0 -> 0x2568
    0xd1 -> 0x2564
    0xd2 -> 0x2565
    0xd3 -> 0x2559
    0xd4 -> 0x2558
    0xd5 -> 0x2552
    0xd6 -> 0x2553
    0xd7 -> 0x256b
    0xd8 -> 0x256a
    0xd9 -> 0x2518
    0xda -> 0x250c
    0xdb -> 0x2588
    0xdc -> 0x2584
    0xdd -> 0x258c
    0xde -> 0x2590
    0xdf -> 0x2580
    0xe0 -> 0x03b1
    0xe1 -> 0xdf
    0xe2 -> 0x0393
    0xe3 -> 0x03c0
    0xe4 -> 0x03a3
    0xe5 -> 0x03c3
    0xe6 -> 0xb5
    0xe7 -> 0x03c4
    0xe8 -> 0x03a6
    0xe9 -> 0x0398
    0xea -> 0x03a9
    0xeb -> 0x03b4
    0xec -> 0x221e
    0xed -> 0x03c6
    0xee -> 0x03b5
    0xef -> 0x2229
    0xf0 -> 0x2261
    0xf1 -> 0xb1
    0xf2 -> 0x2265
    0xf3 -> 0x2264
    0xf4 -> 0x2320
    0xf5 -> 0x2321
    0xf6 -> 0xf7
    0xf7 -> 0x2248
    0xf8 -> 0xb0
    0xf9 -> 0x2219
    0xfa -> 0xb7
    0xfb -> 0x221a
    0xfc -> 0x207f
    0xfd -> 0xb2
    0xfe -> 0x25a0
    0xff -> 0xa0
    _    -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

pcaToChar :: Word8 -> Char
pcaToChar :: Word8 -> Char
pcaToChar i :: Word8
i = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$
  case Word8
i of
    0x80 -> 0x00c7
    0x81 -> 0x00fc
    0x82 -> 0x00e9
    0x83 -> 0x00e2
    0x84 -> 0x00e4
    0x85 -> 0x00e0
    0x86 -> 0x00e5
    0x87 -> 0x00e7
    0x88 -> 0x00ea
    0x89 -> 0x00eb
    0x8a -> 0x00e8
    0x8b -> 0x00ef
    0x8c -> 0x00ee
    0x8d -> 0x00ec
    0x8e -> 0x00c4
    0x8f -> 0x00c5
    0x90 -> 0x00c9
    0x91 -> 0x00e6
    0x92 -> 0x00c6
    0x93 -> 0x00f4
    0x94 -> 0x00f6
    0x95 -> 0x00f2
    0x96 -> 0x00fb
    0x97 -> 0x00f9
    0x98 -> 0x00ff
    0x99 -> 0x00d6
    0x9a -> 0x00dc
    0x9b -> 0x00f8
    0x9c -> 0x00a3
    0x9d -> 0x00d8
    0x9e -> 0x00d7
    0x9f -> 0x0192
    0xa0 -> 0x00e1
    0xa1 -> 0x00ed
    0xa2 -> 0x00f3
    0xa3 -> 0x00fa
    0xa4 -> 0x00f1
    0xa5 -> 0x00d1
    0xa6 -> 0x00aa
    0xa7 -> 0x00ba
    0xa8 -> 0x00bf
    0xa9 -> 0x00ae
    0xaa -> 0x00ac
    0xab -> 0x00bd
    0xac -> 0x00bc
    0xad -> 0x00a1
    0xae -> 0x00ab
    0xaf -> 0x00bb
    0xb0 -> 0x2591
    0xb1 -> 0x2592
    0xb2 -> 0x2593
    0xb3 -> 0x2502
    0xb4 -> 0x2524
    0xb5 -> 0x00c1
    0xb6 -> 0x00c2
    0xb7 -> 0x00c0
    0xb8 -> 0x00a9
    0xb9 -> 0x2563
    0xba -> 0x2551
    0xbb -> 0x2557
    0xbc -> 0x255d
    0xbd -> 0x00a2
    0xbe -> 0x00a5
    0xbf -> 0x2510
    0xc0 -> 0x2514
    0xc1 -> 0x2534
    0xc2 -> 0x252c
    0xc3 -> 0x251c
    0xc4 -> 0x2500
    0xc5 -> 0x253c
    0xc6 -> 0x00e3
    0xc7 -> 0x00c3
    0xc8 -> 0x255a
    0xc9 -> 0x2554
    0xca -> 0x2569
    0xcb -> 0x2566
    0xcc -> 0x2560
    0xcd -> 0x2550
    0xce -> 0x256c
    0xcf -> 0x00a4
    0xd0 -> 0x00f0
    0xd1 -> 0x00d0
    0xd2 -> 0x00ca
    0xd3 -> 0x00cb
    0xd4 -> 0x00c8
    0xd5 -> 0x0131
    0xd6 -> 0x00cd
    0xd7 -> 0x00ce
    0xd8 -> 0x00cf
    0xd9 -> 0x2518
    0xda -> 0x250c
    0xdb -> 0x2588
    0xdc -> 0x2584
    0xdd -> 0x00a6
    0xde -> 0x00cc
    0xdf -> 0x2580
    0xe0 -> 0x00d3
    0xe1 -> 0x00df
    0xe2 -> 0x00d4
    0xe3 -> 0x00d2
    0xe4 -> 0x00f5
    0xe5 -> 0x00d5
    0xe6 -> 0x00b5
    0xe7 -> 0x00fe
    0xe8 -> 0x00de
    0xe9 -> 0x00da
    0xea -> 0x00db
    0xeb -> 0x00d9
    0xec -> 0x00fd
    0xed -> 0x00dd
    0xee -> 0x00af
    0xef -> 0x00b4
    0xf0 -> 0x00ad
    0xf1 -> 0x00b1
    0xf2 -> 0x2017
    0xf3 -> 0x00be
    0xf4 -> 0x00b6
    0xf5 -> 0x00a7
    0xf6 -> 0x00f7
    0xf7 -> 0x00b8
    0xf8 -> 0x00b0
    0xf9 -> 0x00a8
    0xfa -> 0x00b7
    0xfb -> 0x00b9
    0xfc -> 0x00b3
    0xfd -> 0x00b2
    0xfe -> 0x25a0
    0xff -> 0x00a0
    _    -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i