{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.RTF
   Copyright   : Copyright (C) 2021-2023 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 (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 :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readRTF ReaderOptions
opts a
s = do
  let sources :: Sources
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
s
  Either PandocError Pandoc
parsed <- ParsecT Sources RTFState m Pandoc
-> RTFState -> Sources -> m (Either PandocError Pandoc)
forall (m :: * -> *) t st a.
(Monad m, ToSources t) =>
ParsecT Sources st m a -> st -> t -> m (Either PandocError a)
readWithM ParsecT 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 PandocError
e  -> PandocError -> m Pandoc
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
       Right Pandoc
d -> Pandoc -> m Pandoc
forall a. a -> m a
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
$cshowsPrec :: Int -> CharSet -> ShowS
showsPrec :: Int -> CharSet -> ShowS
$cshow :: CharSet -> String
show :: CharSet -> String
$cshowList :: [CharSet] -> ShowS
showList :: [CharSet] -> ShowS
Show, CharSet -> CharSet -> Bool
(CharSet -> CharSet -> Bool)
-> (CharSet -> CharSet -> Bool) -> Eq CharSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CharSet -> CharSet -> Bool
== :: CharSet -> CharSet -> Bool
$c/= :: CharSet -> CharSet -> Bool
/= :: 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
$cshowsPrec :: Int -> RTFState -> ShowS
showsPrec :: Int -> RTFState -> ShowS
$cshow :: RTFState -> String
show :: RTFState -> String
$cshowList :: [RTFState] -> ShowS
showList :: [RTFState] -> ShowS
Show)

instance Default RTFState where
 def :: RTFState
def = 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 = Int
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
$cshowsPrec :: Int -> FontFamily -> ShowS
showsPrec :: Int -> FontFamily -> ShowS
$cshow :: FontFamily -> String
show :: FontFamily -> String
$cshowList :: [FontFamily] -> ShowS
showList :: [FontFamily] -> ShowS
Show, FontFamily -> FontFamily -> Bool
(FontFamily -> FontFamily -> Bool)
-> (FontFamily -> FontFamily -> Bool) -> Eq FontFamily
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontFamily -> FontFamily -> Bool
== :: FontFamily -> FontFamily -> Bool
$c/= :: FontFamily -> FontFamily -> Bool
/= :: 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
$cshowsPrec :: Int -> StyleType -> ShowS
showsPrec :: Int -> StyleType -> ShowS
$cshow :: StyleType -> String
show :: StyleType -> String
$cshowList :: [StyleType] -> ShowS
showList :: [StyleType] -> ShowS
Show, StyleType -> StyleType -> Bool
(StyleType -> StyleType -> Bool)
-> (StyleType -> StyleType -> Bool) -> Eq StyleType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StyleType -> StyleType -> Bool
== :: StyleType -> StyleType -> Bool
$c/= :: StyleType -> StyleType -> Bool
/= :: 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
$cshowsPrec :: Int -> Style -> ShowS
showsPrec :: Int -> Style -> ShowS
$cshow :: Style -> String
show :: Style -> String
$cshowList :: [Style] -> ShowS
showList :: [Style] -> ShowS
Show, Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
/= :: 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
$cshowsPrec :: Int -> PictType -> ShowS
showsPrec :: Int -> PictType -> ShowS
$cshow :: PictType -> String
show :: PictType -> String
$cshowList :: [PictType] -> ShowS
showList :: [PictType] -> ShowS
Show, PictType -> PictType -> Bool
(PictType -> PictType -> Bool)
-> (PictType -> PictType -> Bool) -> Eq PictType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PictType -> PictType -> Bool
== :: PictType -> PictType -> Bool
$c/= :: PictType -> PictType -> Bool
/= :: 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
$cshowsPrec :: Int -> Pict -> ShowS
showsPrec :: Int -> Pict -> ShowS
$cshow :: Pict -> String
show :: Pict -> String
$cshowList :: [Pict] -> ShowS
showList :: [Pict] -> ShowS
Show, Pict -> Pict -> Bool
(Pict -> Pict -> Bool) -> (Pict -> Pict -> Bool) -> Eq Pict
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pict -> Pict -> Bool
== :: Pict -> Pict -> Bool
$c/= :: Pict -> Pict -> Bool
/= :: Pict -> Pict -> Bool
Eq)

instance Default Pict where
 def :: Pict
def = 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
$cshowsPrec :: Int -> Properties -> ShowS
showsPrec :: Int -> Properties -> ShowS
$cshow :: Properties -> String
show :: Properties -> String
$cshowList :: [Properties] -> ShowS
showList :: [Properties] -> ShowS
Show, Properties -> Properties -> Bool
(Properties -> Properties -> Bool)
-> (Properties -> Properties -> Bool) -> Eq Properties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Properties -> Properties -> Bool
== :: Properties -> Properties -> Bool
$c/= :: Properties -> Properties -> Bool
/= :: Properties -> Properties -> Bool
Eq)

instance Default Properties where
   def :: Properties
def = 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 = Int
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 = ParsecT 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
$cshowsPrec :: Int -> ListType -> ShowS
showsPrec :: Int -> ListType -> ShowS
$cshow :: ListType -> String
show :: ListType -> String
$cshowList :: [ListType] -> ShowS
showList :: [ListType] -> ShowS
Show, ListType -> ListType -> Bool
(ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool) -> Eq ListType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
/= :: 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
$cshowsPrec :: Int -> List -> ShowS
showsPrec :: Int -> List -> ShowS
$cshow :: List -> String
show :: List -> String
$cshowList :: [List] -> ShowS
showList :: [List] -> ShowS
Show, List -> List -> Bool
(List -> List -> Bool) -> (List -> List -> Bool) -> Eq List
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: List -> List -> Bool
== :: List -> List -> Bool
$c/= :: List -> List -> Bool
/= :: 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
$cshowsPrec :: Int -> TableRow -> ShowS
showsPrec :: Int -> TableRow -> ShowS
$cshow :: TableRow -> String
show :: TableRow -> String
$cshowList :: [TableRow] -> ShowS
showList :: [TableRow] -> ShowS
Show, TableRow -> TableRow -> Bool
(TableRow -> TableRow -> Bool)
-> (TableRow -> TableRow -> Bool) -> Eq TableRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableRow -> TableRow -> Bool
== :: TableRow -> TableRow -> Bool
$c/= :: TableRow -> TableRow -> Bool
/= :: TableRow -> TableRow -> Bool
Eq)

parseRTF :: PandocMonad m => RTFParser m Pandoc
parseRTF :: forall (m :: * -> *). PandocMonad m => 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
  Blocks
bs <- 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 ParsecT Sources RTFState m [Tok]
-> ([Tok] -> ParsecT Sources RTFState m Blocks)
-> ParsecT Sources RTFState m Blocks
forall a b.
ParsecT Sources RTFState m a
-> (a -> ParsecT Sources RTFState m b)
-> ParsecT Sources RTFState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (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 ParsecT Sources RTFState m Blocks
-> (Blocks -> ParsecT Sources RTFState m Blocks)
-> ParsecT Sources RTFState m Blocks
forall a b.
ParsecT Sources RTFState m a
-> (a -> ParsecT Sources RTFState m b)
-> ParsecT Sources RTFState m b
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 a. a -> ParsecT Sources RTFState m a
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 a b. (a -> b -> b) -> b -> [a] -> b
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
forall b. ToMetaValue b => Text -> b -> Pandoc -> Pandoc
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
$cshowsPrec :: Int -> Tok -> ShowS
showsPrec :: Int -> Tok -> ShowS
$cshow :: Tok -> String
show :: Tok -> String
$cshowList :: [Tok] -> ShowS
showList :: [Tok] -> ShowS
Show, Tok -> Tok -> Bool
(Tok -> Tok -> Bool) -> (Tok -> Tok -> Bool) -> Eq Tok
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tok -> Tok -> Bool
== :: Tok -> Tok -> Bool
$c/= :: Tok -> Tok -> Bool
/= :: 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
$cshowsPrec :: Int -> TokContents -> ShowS
showsPrec :: Int -> TokContents -> ShowS
$cshow :: TokContents -> String
show :: TokContents -> String
$cshowList :: [TokContents] -> ShowS
showList :: [TokContents] -> ShowS
Show, TokContents -> TokContents -> Bool
(TokContents -> TokContents -> Bool)
-> (TokContents -> TokContents -> Bool) -> Eq TokContents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TokContents -> TokContents -> Bool
== :: TokContents -> TokContents -> Bool
$c/= :: TokContents -> TokContents -> Bool
/= :: TokContents -> TokContents -> Bool
Eq)

tok :: PandocMonad m => RTFParser m Tok
tok :: forall (m :: * -> *). PandocMonad m => 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 (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m 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
forall {u}. ParsecT Sources u 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 a b.
ParsecT Sources RTFState m a
-> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 Char
'\\' ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall a b.
ParsecT Sources RTFState m a
-> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      ( ParsecT Sources RTFState m TokContents
controlWord
     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) )
  controlWord :: ParsecT Sources RTFState m TokContents
controlWord = do
    Text
name <- ParsecT Sources RTFState m Text
forall {u}. ParsecT Sources u m Text
letterSequence
    Maybe Int
param <- 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 a b.
ParsecT Sources RTFState m a
-> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
    case Text
name of
      Text
"bin" -> do
        let n :: Int
n = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
param
        ParsecT Sources RTFState 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 RTFState m String
-> ParsecT Sources RTFState m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState 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 RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
        TokContents -> ParsecT Sources RTFState m TokContents
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TokContents -> ParsecT Sources RTFState m TokContents)
-> TokContents -> ParsecT Sources RTFState m TokContents
forall a b. (a -> b) -> a -> b
$! ByteString -> TokContents
BinData ByteString
dat
      Text
_ -> TokContents -> ParsecT Sources RTFState m TokContents
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TokContents -> ParsecT Sources RTFState m TokContents)
-> TokContents -> ParsecT Sources RTFState m TokContents
forall a b. (a -> b) -> a -> b
$! Text -> Maybe Int -> TokContents
ControlWord Text
name Maybe Int
param
  parameter :: ParsecT Sources u m (Maybe Int)
parameter = do
    Bool
hyph <- Bool -> ParsecT Sources u m Bool -> ParsecT Sources u m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (ParsecT Sources u m Bool -> ParsecT Sources u m Bool)
-> ParsecT Sources u m Bool -> ParsecT Sources u m Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> ParsecT Sources u m Char -> ParsecT Sources u m Bool
forall a b. a -> ParsecT Sources u m b -> ParsecT Sources u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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
'-'
    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
    if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
       then Maybe Int -> ParsecT Sources u m (Maybe Int)
forall a. a -> ParsecT Sources u m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
       else do
         let pstr :: Text
pstr = String -> Text
T.pack String
rest
         case Reader Int
forall a. Integral a => Reader a
TR.decimal Text
pstr of
           Right (!Int
i,Text
_) ->
                Maybe Int -> ParsecT Sources u m (Maybe Int)
forall a. a -> ParsecT Sources u m a
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
$! Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! if Bool
hyph
                                     then (-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i
                                     else Int
i
           Either String (Int, Text)
_ -> Maybe Int -> ParsecT Sources u m (Maybe Int)
forall a. a -> ParsecT Sources u m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
  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
'\''
    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 a. a -> ParsecT Sources u m a
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 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isLetter Char
c))
  unformattedText :: ParsecT Sources u m TokContents
unformattedText = do
    String
ts <-  (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') ShowS -> ParsecT Sources u m String -> ParsecT Sources u m String
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 (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpecial Char
c) Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')))
    TokContents -> ParsecT Sources u m TokContents
forall a. a -> ParsecT Sources u m a
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
$! Text -> TokContents
UnformattedText (Text -> TokContents) -> Text -> TokContents
forall a b. (a -> b) -> a -> b
$! String -> Text
T.pack String
ts
  grouped :: ParsecT Sources RTFState m TokContents
grouped = 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 Char
'{'
    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]
ts <- 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 Char
'}')
    case [Tok]
ts of
       Tok SourcePos
_ (ControlWord Text
"rtf" (Just Int
1)) : [Tok]
_ -> do
         Sources -> ParsecT Sources RTFState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput Sources
forall a. Monoid a => a
mempty -- discard remaining input: content after the \rtf1
                         -- group can be non-RTF
       [Tok]
_ -> () -> ParsecT Sources RTFState m ()
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    TokContents -> ParsecT Sources RTFState m TokContents
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TokContents -> ParsecT Sources RTFState m TokContents)
-> TokContents -> ParsecT Sources RTFState m TokContents
forall a b. (a -> b) -> a -> b
$! [Tok] -> TokContents
Grouped [Tok]
ts

nl :: PandocMonad m => RTFParser m ()
nl :: forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl = ParsecT Sources RTFState m Char -> ParsecT Sources RTFState 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 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 Char
'\r')

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

delimChar :: PandocMonad m => RTFParser m Char
delimChar :: forall (m :: * -> *). PandocMonad m => RTFParser m Char
delimChar = (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 (\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 :: forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup Properties -> Properties
f =
  (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
$ \RTFState
st ->
    RTFState
st{ sGroupStack :: [Properties]
sGroupStack =
          case RTFState -> [Properties]
sGroupStack RTFState
st of
            [] -> []
            (Properties
x:[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 (Properties
_, Text
"\n") = Inlines
B.linebreak
addFormatting (Properties
props, Text
_) | Properties -> Bool
gHidden Properties
props = Inlines
forall a. Monoid a => a
mempty
addFormatting (Properties
props, Text
_) | Just Blocks
bs <- Properties -> Maybe Blocks
gFootnote Properties
props = Blocks -> Inlines
B.note Blocks
bs
addFormatting (Properties
props, 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
     Maybe Text
Nothing -> Inlines -> Inlines
forall a. a -> a
id
     Just 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
     Maybe Text
Nothing -> Inlines -> Inlines
forall a. a -> a
id
     Just 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 FontFamily
Modern -> Text -> Inlines
B.code
     Maybe FontFamily
_ -> case Properties -> Maybe Pict
gImage Properties
props of
            Just Pict
pict ->
              let attr :: (Text, [a], [(Text, Text)])
attr = (Text
"",[],
                         (case Pict -> Maybe Int
picWidthGoal Pict
pict of
                           Maybe Int
Nothing -> []
                           Just Int
w  -> [(Text
"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
/ Double
1440
                                                         :: Double)
                                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"in")]) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
                         (case Pict -> Maybe Int
picHeightGoal Pict
pict of
                            Maybe Int
Nothing -> []
                            Just Int
h -> [(Text
"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
/ Double
1440
                                                         :: Double)
                                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"in")]))
              in  Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith Attr
forall {a}. (Text, [a], [(Text, Text)])
attr (Pict -> Text
picName Pict
pict) Text
"" (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
B.text
            Maybe Pict
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 :: forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText 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
                (Properties
x:[Properties]
_) -> Properties
x
                [Properties]
_ -> Properties
forall a. Default a => a
def
  (RTFState -> RTFState) -> RTFParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\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 :: forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup 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
$ \RTFState
st ->
    RTFState
st{ sGroupStack :: [Properties]
sGroupStack =
        case RTFState -> [Properties]
sGroupStack RTFState
st of
          [] -> [Properties
forall a. Default a => a
def]
          (Properties
x:[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
$ \RTFState
st ->
    RTFState
st{ sGroupStack :: [Properties]
sGroupStack =
        case RTFState -> [Properties]
sGroupStack RTFState
st of
          [] -> [] -- should not happen
          (Properties
_:[Properties]
xs) -> [Properties]
xs }
  a -> RTFParser m a
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

getStyleFormatting :: PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting :: forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting 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
    Maybe Style
Nothing -> [Tok] -> RTFParser m [Tok]
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just Style
sty ->
      case Style -> Maybe Int
styleBasedOn Style
sty of
        Just 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
        Maybe Int
Nothing -> [Tok] -> RTFParser m [Tok]
forall a. a -> ParsecT Sources RTFState m a
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 Text
"title" = Bool
True
isMetadataField Text
"subject" = Bool
True
isMetadataField Text
"author" = Bool
True
isMetadataField Text
"manager" = Bool
True
isMetadataField Text
"company" = Bool
True
isMetadataField Text
"operator" = Bool
True
isMetadataField Text
"category" = Bool
True
isMetadataField Text
"keywords" = Bool
True
isMetadataField Text
"comment" = Bool
True
isMetadataField Text
"doccomm" = Bool
True
isMetadataField Text
"hlinkbase" = Bool
True
isMetadataField Text
"generator" = Bool
True
isMetadataField Text
_ = Bool
False

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

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

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

processTok :: PandocMonad m => Blocks -> Tok -> RTFParser m Blocks
processTok :: forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs (Tok SourcePos
pos 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 a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    UnformattedText{} -> () -> ParsecT Sources RTFState m ()
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    TokContents
_ -> (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
$ \RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Int
0 }
  case TokContents
tok' of
    Grouped (Tok SourcePos
_ (ControlSymbol Char
'*') : [Tok]
toks) ->
      Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
$ \RTFState
st -> RTFState
st{ sTextContent :: [(Properties, Text)]
sTextContent = [(Properties, Text)]
oldTextContent })
    Grouped (Tok SourcePos
_ (ControlWord Text
"fonttbl" Maybe Int
_) : [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
$ \RTFState
s -> RTFState
s{ sFontTable :: FontTable
sFontTable = [Tok] -> FontTable
processFontTable [Tok]
toks }
      Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"field" Maybe Int
_) : [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 SourcePos
_ (ControlWord Text
"pict" Maybe Int
_) : [Tok]
toks) ->
      Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 SourcePos
_ (ControlWord Text
"stylesheet" Maybe Int
_) : [Tok]
toks) ->
      Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 SourcePos
_ (ControlWord Text
"listtext" Maybe Int
_) : [Tok]
_) -> 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 SourcePos
_ (ControlWord Text
"pgdsc" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"colortbl" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"listtable" Maybe Int
_) : [Tok]
toks) ->
      Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 SourcePos
_ (ControlWord Text
"listoverridetable" Maybe Int
_) : [Tok]
toks) ->
      Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 SourcePos
_ (ControlWord Text
"wgrffmtfilter" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"themedata" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"colorschememapping" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"datastore" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"latentstyles" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"pntxta" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs -- TODO
    Grouped (Tok SourcePos
_ (ControlWord Text
"pntxtb" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs -- TODO
    Grouped (Tok SourcePos
_ (ControlWord Text
"xmlnstbl" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"filetbl" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"expandedcolortbl" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"listtables" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"revtbl" Maybe Int
_) : [Tok]
_) -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"bkmkstart" Maybe Int
_)
             : Tok SourcePos
_ (UnformattedText Text
t) : [Tok]
_) -> 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 (\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 a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"bkmkend" Maybe Int
_) : [Tok]
_) -> do
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\Properties
g -> Properties
g{ gAnchor :: Maybe Text
gAnchor = Maybe Text
forall a. Maybe a
Nothing })
      Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
f Maybe Int
_) : [Tok]
_) | Text -> Bool
isHeaderFooter Text
f -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"footnote" Maybe Int
_) : [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 (\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 Text
"*"
      (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\Properties
g -> Properties
g{ gFootnote :: Maybe Blocks
gFootnote = Maybe Blocks
forall a. Maybe a
Nothing })
      Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"info" Maybe Int
_) : [Tok]
toks) ->
      Blocks
bs Blocks -> RTFParser m Blocks -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 SourcePos
_ (ControlWord Text
f Maybe Int
_) : [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
$ \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
$ \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 a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped [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 Text
t -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
        Int
0 -> Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
t
        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
$ \RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Int
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
$ \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 Word8
n -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
== Int
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
             CharSet
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)
             CharSet
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)
             CharSet
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)
             CharSet
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
$ \RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Int
eatChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
    ControlWord Text
"ansi" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 (\RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
ANSI })
    ControlWord Text
"mac" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 (\RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
Mac })
    ControlWord Text
"pc" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 (\RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
Pc })
    ControlWord Text
"pca" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 (\RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
Pca })
    ControlWord Text
"outlinelevel" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gOutlineLevel :: Maybe Int
gOutlineLevel = Maybe Int
mbp })
    ControlWord Text
"ls" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gListOverride :: Maybe Int
gListOverride = Maybe Int
mbp })
    ControlWord Text
"ilvl" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gListLevel :: Maybe Int
gListLevel = Maybe Int
mbp })
    ControlSymbol Char
'\\' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\\"
    ControlSymbol Char
'{' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"{"
    ControlSymbol Char
'}' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"}"
    ControlSymbol Char
'~' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x00a0"
    ControlSymbol Char
'-' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x00ad"
    ControlSymbol Char
'_' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2011"
    ControlWord Text
"trowd" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
$ \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 Text
"cell" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
$ \RTFState
s -> RTFState
s{ sTableRows :: [TableRow]
sTableRows =
                                case RTFState -> [TableRow]
sTableRows RTFState
s of
                                  TableRow [Blocks]
cs : [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 Text
"intbl" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gInTable :: Bool
gInTable = Bool
True })
    ControlWord Text
"plain" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 Text
"lquote" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2018"
    ControlWord Text
"rquote" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2019"
    ControlWord Text
"ldblquote" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x201C"
    ControlWord Text
"rdblquote" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x201D"
    ControlWord Text
"emdash" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2014"
    ControlWord Text
"emspace" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2003"
    ControlWord Text
"enspace" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2002"
    ControlWord Text
"endash" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2013"
    ControlWord Text
"bullet" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2022"
    ControlWord Text
"tab" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\t"
    ControlWord Text
"line" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\n"
    ControlSymbol Char
'\n' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\n"
    ControlSymbol Char
'\r' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\n"
    ControlWord Text
"uc" (Just Int
i) -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gUC :: Int
gUC = Int
i })
    ControlWord Text
"cs" (Just 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 a b.
ParsecT Sources RTFState m a
-> (a -> ParsecT Sources RTFState m b)
-> ParsecT Sources RTFState m b
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 Text
"s" (Just 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 a b.
ParsecT Sources RTFState m a
-> (a -> ParsecT Sources RTFState m b)
-> ParsecT Sources RTFState m b
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 Text
"ds" (Just 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 a b.
ParsecT Sources RTFState m a
-> (a -> ParsecT Sources RTFState m b)
-> ParsecT Sources RTFState m b
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 Text
"f" (Just Int
i) -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 (\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 Text
"u" (Just Int
i) -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
                       (Properties
x:[Properties]
_) -> 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
$ \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 Text
"caps" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gCaps :: Bool
gCaps = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"deleted" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"b" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gBold :: Bool
gBold = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"i" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gItalic :: Bool
gItalic = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"sub" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gSub :: Bool
gSub = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"super" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gSuper :: Bool
gSuper = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"nosupersub" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gSuper :: Bool
gSuper = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Bool
boolParam Maybe Int
mbp
                          , gSub :: Bool
gSub = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"up" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gSuper :: Bool
gSuper = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"strike" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"strikedl" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"striked" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"scaps" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gSmallCaps :: Bool
gSmallCaps = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"v" Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gHidden :: Bool
gHidden = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
x Maybe Int
mbp | Text -> Bool
isUnderline Text
x -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gUnderline :: Bool
gUnderline = Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"ulnone" Maybe Int
_ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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
g -> Properties
g{ gUnderline :: Bool
gUnderline = Bool
False })
    ControlWord Text
"pard" Maybe Int
_ -> Blocks
bs Blocks -> RTFParser m Blocks -> RTFParser m Blocks
forall a b.
a -> ParsecT Sources RTFState m b -> ParsecT Sources RTFState m a
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 Int
0 RTFParser m [Tok]
-> ([Tok] -> RTFParser m Blocks) -> RTFParser m Blocks
forall a b.
ParsecT Sources RTFState m a
-> (a -> ParsecT Sources RTFState m b)
-> ParsecT Sources RTFState m b
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 Text
"par" Maybe Int
_ -> Blocks -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks Blocks
bs
    TokContents
_ -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs

processDestinationToks :: PandocMonad m => [Tok] -> RTFParser m Blocks
processDestinationToks :: forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m Blocks
processDestinationToks [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
$ \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 a b.
ParsecT Sources RTFState m a
-> (a -> ParsecT Sources RTFState m b)
-> ParsecT Sources RTFState m b
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
$ \RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [(Properties, Text)]
textContent
                       , sListStack :: [List]
sListStack = [List]
liststack }
  Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
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 :: forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists 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 Int
_ Int
lvl' ListType
lt [Blocks]
items : [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
                      ListType
Bullet -> [Blocks] -> Blocks
B.bulletList
                      Ordered 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
$ \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
$ \RTFState
s -> RTFState
s{ sListStack :: [List]
sListStack = [List]
rest }
          Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
newlist
        (List Int
lo Int
lvl'' ListType
lt' [] : [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
$ \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 Int
lo Int
lvl'' ListType
lt' (Blocks
i:[Blocks]
is) : [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
$ \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
    [List]
_ -> Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty

closeTable :: PandocMonad m => RTFParser m Blocks
closeTable :: forall (m :: * -> *). PandocMonad m => 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TableRow]
rawrows
     then Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
     else do
       let getCells :: TableRow -> [Blocks]
getCells (TableRow [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
$ \RTFState
s -> RTFState
s{ sCurrentCell :: Blocks
sCurrentCell = Blocks
forall a. Monoid a => a
mempty
                            , sTableRows :: [TableRow]
sTableRows = [] }
       Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
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 :: forall (m :: * -> *). PandocMonad m => 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 Int
0
  Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
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 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
    Seq Inline
rest Seq.:> Inline
LineBreak -> Seq Inline -> Inlines
forall a. Seq a -> Many a
B.Many Seq Inline
rest
    ViewR Inline
_ -> Inlines
ils

emitBlocks :: PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks :: forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks 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
$ \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
               ((Properties
p,Text
_):[(Properties, Text)]
_) -> Properties
p
  Blocks
tbl <- if Properties -> Bool
gInTable Properties
prop Bool -> Bool -> Bool
|| [(Properties, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Properties, Text)]
annotatedToks
            then Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
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 a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
      [(Properties, Text)]
_ | Just Int
lst <- Properties -> Maybe Int
gListOverride Properties
prop
         -> do
           let level :: Int
level = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
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 (IntMap ListType)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
lst ListTable
listOverrideTable Maybe (IntMap ListType)
-> (IntMap ListType -> Maybe ListType) -> Maybe ListType
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> IntMap ListType -> 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 Int
lo Int
parentlevel ListType
_lt [Blocks]
items : [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
$ \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 a. a -> ParsecT Sources RTFState m a
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
$ \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 a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
new
             [List]
_ -> 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
$ \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 a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
        | Just Int
lvl <- Properties -> Maybe Int
gOutlineLevel Properties
prop
         -> do
            Blocks
lists <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
0
            Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
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
+ Int
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 Int
0
            Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
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 Int
0
        | Bool
otherwise -> do
            Blocks
lists <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
0
            Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
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
$ \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 a. a -> ParsecT Sources RTFState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
     else do
       Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
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 =
  (\[(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 (\(Properties
p,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
.
  (\[(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 (\(Properties
p,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 :: forall (m :: * -> *).
PandocMonad m =>
Blocks -> [Tok] -> RTFParser m Blocks
handleField Blocks
bs
  (Tok SourcePos
_
    (Grouped
     (Tok SourcePos
_ (ControlSymbol Char
'*')
     :Tok SourcePos
_ (ControlWord Text
"fldinst" Maybe Int
Nothing)
     :Tok SourcePos
_ (Grouped (Tok SourcePos
_ (UnformattedText Text
insttext):[Tok]
rest))
     :[Tok]
_))
  :[Tok]
linktoks)
  | Just Text
linkdest <- Text -> Maybe Text
getHyperlink Text
insttext
  = do let linkdest' :: Text
linkdest' = case [Tok]
rest of
                         (Tok SourcePos
_ (ControlSymbol Char
'\\')
                          : Tok SourcePos
_ (UnformattedText Text
t)
                          : [Tok]
_) | Just Text
bkmrk <- Text -> Text -> Maybe Text
T.stripPrefix Text
"l" Text
t
                           -> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
unquote Text
bkmrk
                         [Tok]
_ -> 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
$ \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
$ \Properties
g -> Properties
g{ gHyperlink :: Maybe Text
gHyperlink = Maybe Text
forall a. Maybe a
Nothing }
       Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
result
handleField Blocks
bs [Tok]
_ = Blocks -> RTFParser m Blocks
forall a. a -> ParsecT Sources RTFState m a
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
==Char
'"') (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
==Char
'"') (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 :: forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handleListTable [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 :: forall (m :: * -> *). PandocMonad m => Tok -> RTFParser m ()
handleList (Tok SourcePos
_ (Grouped (Tok SourcePos
_ (ControlWord Text
"list" Maybe Int
_) : [Tok]
toks))) = do
  let listid :: Int
listid = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef Int
0 [Int
n | Tok SourcePos
_ (ControlWord Text
"listid" (Just Int
n)) <- [Tok]
toks]
  let levels :: [[Tok]]
levels = [[Tok]
ts | Tok SourcePos
_ (Grouped (Tok SourcePos
_ (ControlWord Text
"listlevel" Maybe Int
_) : [Tok]
ts))
                 <- [Tok]
toks]
  IntMap ListType
tbl <- (IntMap ListType
 -> (Int, [Tok]) -> ParsecT Sources RTFState m (IntMap ListType))
-> IntMap ListType
-> [(Int, [Tok])]
-> ParsecT Sources RTFState m (IntMap ListType)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM IntMap ListType
-> (Int, [Tok]) -> ParsecT Sources RTFState m (IntMap ListType)
forall (m :: * -> *).
PandocMonad m =>
IntMap ListType -> (Int, [Tok]) -> RTFParser m (IntMap ListType)
handleListLevel IntMap ListType
forall a. Monoid a => a
mempty ([Int] -> [[Tok]] -> [(Int, [Tok])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
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
$ \RTFState
s -> RTFState
s{ sListTable :: ListTable
sListTable = Int -> IntMap ListType -> ListTable -> ListTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
listid IntMap ListType
tbl (ListTable -> ListTable) -> ListTable -> ListTable
forall a b. (a -> b) -> a -> b
$ RTFState -> ListTable
sListTable RTFState
s }
handleList Tok
_ = () -> RTFParser m ()
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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

handleListOverride :: PandocMonad m => Tok -> RTFParser m ()
handleListOverride :: forall (m :: * -> *). PandocMonad m => Tok -> RTFParser m ()
handleListOverride
 (Tok SourcePos
_ (Grouped (Tok SourcePos
_ (ControlWord Text
"listoverride" Maybe Int
_) : [Tok]
toks))) = do
  let listid :: Int
listid = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef Int
0 [Int
n | Tok SourcePos
_ (ControlWord Text
"listid" (Just Int
n)) <- [Tok]
toks]
  let lsn :: Int
lsn = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef Int
0 [Int
n | Tok SourcePos
_ (ControlWord Text
"ls" (Just 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 (IntMap ListType)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
listid ListTable
listTable of
    Maybe (IntMap ListType)
Nothing -> () -> RTFParser m ()
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just IntMap ListType
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
$ \RTFState
s ->
                   RTFState
s{ sListOverrideTable :: ListTable
sListOverrideTable = Int -> IntMap ListType -> ListTable -> ListTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
lsn IntMap ListType
tbl (ListTable -> ListTable) -> ListTable -> ListTable
forall a b. (a -> b) -> a -> b
$
                        RTFState -> ListTable
sListOverrideTable RTFState
s }
handleListOverride Tok
_ = () -> RTFParser m ()
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

handleStylesheet :: PandocMonad m => [Tok] -> RTFParser m ()
handleStylesheet :: forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handleStylesheet [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
$ \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 SourcePos
_ (Grouped [Tok]
toks)) = do
  let (StyleType
styType, Int
styNum, [Tok]
rest) =
        case [Tok]
toks of
          Tok SourcePos
_ (ControlWord Text
"s" (Just Int
n)) : [Tok]
ts -> (StyleType
ParagraphStyle, Int
n, [Tok]
ts)
          Tok SourcePos
_ (ControlWord Text
"ds" (Just Int
n)) : [Tok]
ts -> (StyleType
SectionStyle, Int
n, [Tok]
ts)
          Tok SourcePos
_ (ControlWord Text
"cs" (Just Int
n)) : [Tok]
ts -> (StyleType
CharStyle, Int
n, [Tok]
ts)
          Tok SourcePos
_ (ControlWord Text
"ts" (Just Int
n)) : [Tok]
ts -> (StyleType
TableStyle, Int
n, [Tok]
ts)
          [Tok]
_ -> (StyleType
ParagraphStyle, Int
0, [Tok]
toks)
  let styName :: Text
styName = case [Tok] -> Maybe Tok
forall a. [a] -> Maybe a
lastMay [Tok]
rest of
                  Just (Tok SourcePos
_ (UnformattedText Text
t)) -> (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';') Text
t
                  Maybe Tok
_ -> Text
forall a. Monoid a => a
mempty
  let isBasedOn :: Tok -> Bool
isBasedOn (Tok SourcePos
_ (ControlWord Text
"sbasedon" (Just Int
_))) = Bool
True
      isBasedOn Tok
_ = 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 SourcePos
_ (ControlWord Text
"sbasedon" (Just Int
i))) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
                     Maybe Tok
_ -> Maybe Int
forall a. Maybe a
Nothing
  let isStyleControl :: Tok -> Bool
isStyleControl (Tok SourcePos
_ (ControlWord Text
x Maybe Int
_)) =
         Text
x Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"cs", Text
"s", Text
"ds", Text
"additive", Text
"sbasedon", Text
"snext",
                   Text
"sautoupd", Text
"shidden", Text
"keycode", Text
"alt", Text
"shift",
                   Text
"ctrl", Text
"fn"]
      isStyleControl Tok
_ = 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 a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Style -> Maybe Style) -> Style -> Maybe Style
forall a b. (a -> b) -> a -> b
$ 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 Tok
_ = Maybe Style
forall a. Maybe a
Nothing

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


handlePict :: PandocMonad m => [Tok] -> RTFParser m ()
handlePict :: forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handlePict [Tok]
toks = do
  let pict :: Pict
pict = (Pict -> Tok -> Pict) -> Pict -> [Tok] -> Pict
forall b a. (b -> a -> b) -> b -> [a] -> b
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 = Text
"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 Int
2 (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Pict -> Text
picData Pict
pict
  let (Maybe Text
mimetype, String
ext) =
        case Pict -> Maybe PictType
picType Pict
pict of
          Just PictType
Emfblip -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"image/x-emf", String
".emf")
          Just PictType
Pngblip -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"image/png", String
".png")
          Just PictType
Jpegblip -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"image/jpeg", String
".jpg")
          Maybe PictType
Nothing -> (Maybe Text
forall a. Maybe a
Nothing, String
"")
  case Maybe Text
mimetype of
    Just 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
$ \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
$ \Properties
g -> Properties
g{ gImage :: Maybe Pict
gImage = Maybe Pict
forall a. Maybe a
Nothing }
    Maybe Text
_ -> () -> RTFParser m ()
forall a. a -> ParsecT Sources RTFState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  getPictData :: Pict -> Tok -> Pict
  getPictData :: Pict -> Tok -> Pict
getPictData Pict
pict (Tok SourcePos
_ TokContents
tok') =
    case TokContents
tok' of
      ControlWord Text
"emfblip" Maybe Int
_-> Pict
pict{ picType :: Maybe PictType
picType = PictType -> Maybe PictType
forall a. a -> Maybe a
Just PictType
Emfblip }
      ControlWord Text
"pngblip" Maybe Int
_-> Pict
pict{ picType :: Maybe PictType
picType = PictType -> Maybe PictType
forall a. a -> Maybe a
Just PictType
Pngblip }
      ControlWord Text
"jpegblip" Maybe Int
_-> Pict
pict{ picType :: Maybe PictType
picType = PictType -> Maybe PictType
forall a. a -> Maybe a
Just PictType
Jpegblip }
      ControlWord Text
"picw" (Just Int
w) -> Pict
pict{ picWidth :: Maybe Int
picWidth = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w }
      ControlWord Text
"pich" (Just Int
h) -> Pict
pict{ picHeight :: Maybe Int
picHeight = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h }
      ControlWord Text
"picwgoal" (Just Int
w) -> Pict
pict{ picWidthGoal :: Maybe Int
picWidthGoal = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w }
      ControlWord Text
"pichgoal" (Just Int
h) -> Pict
pict{ picHeightGoal :: Maybe Int
picHeightGoal = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h }
      BinData 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 Text
t -> Pict
pict{ picData :: Text
picData = Text
t }
      TokContents
_ -> Pict
pict


getHyperlink :: Text -> Maybe Text
getHyperlink :: Text -> Maybe Text
getHyperlink Text
t =
  case Text -> Text -> Maybe Text
T.stripPrefix Text
"HYPERLINK" (Text -> Text
T.strip Text
t) of
    Maybe Text
Nothing -> Maybe Text
forall a. Maybe a
Nothing
    Just 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 b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, FontTable) -> Tok -> (Int, FontTable)
go (Int
0, FontTable
forall a. Monoid a => a
mempty)
 where
  go :: (Int, FontTable) -> Tok -> (Int, FontTable)
go (Int
fontnum, FontTable
tbl) (Tok SourcePos
_ TokContents
tok') =
    case TokContents
tok' of
     (ControlWord Text
"f" (Just Int
i)) -> (Int
i, FontTable
tbl)
     (ControlWord Text
"fnil" Maybe Int
_) -> (Int
fontnum, FontTable
tbl)
     (ControlWord Text
"froman" Maybe Int
_) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Roman FontTable
tbl)
     (ControlWord Text
"fswiss" Maybe Int
_) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Swiss FontTable
tbl)
     (ControlWord Text
"fmodern" Maybe Int
_) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Modern FontTable
tbl)
     (ControlWord Text
"fscript" Maybe Int
_) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Script FontTable
tbl)
     (ControlWord Text
"fdecor" Maybe Int
_) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Decor FontTable
tbl)
     (ControlWord Text
"ftech" Maybe Int
_) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Tech FontTable
tbl)
     (ControlWord Text
"fbidi" Maybe Int
_) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Bidi FontTable
tbl)
     (Grouped [Tok]
ts) -> ((Int, FontTable) -> Tok -> (Int, FontTable))
-> (Int, FontTable) -> [Tok] -> (Int, FontTable)
forall b a. (b -> a -> b) -> b -> [a] -> b
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
     TokContents
_ -> (Int
fontnum, FontTable
tbl)


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

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

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

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