{-# 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 = forall a. ToSources a => a -> Sources
toSources a
s
  Either PandocError Pandoc
parsed <- forall (m :: * -> *) t st a.
(Monad m, ToSources t) =>
ParsecT Sources st m a -> st -> t -> m (Either PandocError a)
readWithM forall (m :: * -> *). PandocMonad m => RTFParser m Pandoc
parseRTF forall a. Default a => a
def{ sOptions :: ReaderOptions
sOptions = ReaderOptions
opts } Sources
sources
  case Either PandocError Pandoc
parsed of
       Left PandocError
e  -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
       Right Pandoc
d -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharSet] -> ShowS
$cshowList :: [CharSet] -> ShowS
show :: CharSet -> String
$cshow :: CharSet -> String
showsPrec :: Int -> CharSet -> ShowS
$cshowsPrec :: Int -> CharSet -> ShowS
Show, CharSet -> CharSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharSet -> CharSet -> Bool
$c/= :: CharSet -> CharSet -> Bool
== :: CharSet -> CharSet -> Bool
$c== :: CharSet -> CharSet -> Bool
Eq)

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

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

instance Default RTFState where
 def :: RTFState
def = RTFState { sOptions :: ReaderOptions
sOptions = forall a. Default a => a
def
                , sCharSet :: CharSet
sCharSet = CharSet
ANSI
                , sGroupStack :: [Properties]
sGroupStack = []
                , sListStack :: [List]
sListStack = []
                , sCurrentCell :: Blocks
sCurrentCell = forall a. Monoid a => a
mempty
                , sTableRows :: [TableRow]
sTableRows = []
                , sTextContent :: [(Properties, Text)]
sTextContent = []
                , sMetadata :: [(Text, Inlines)]
sMetadata = []
                , sFontTable :: FontTable
sFontTable = forall a. Monoid a => a
mempty
                , sStylesheet :: Stylesheet
sStylesheet = forall a. Monoid a => a
mempty
                , sListTable :: ListTable
sListTable = forall a. Monoid a => a
mempty
                , sListOverrideTable :: ListTable
sListOverrideTable = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontFamily] -> ShowS
$cshowList :: [FontFamily] -> ShowS
show :: FontFamily -> String
$cshow :: FontFamily -> String
showsPrec :: Int -> FontFamily -> ShowS
$cshowsPrec :: Int -> FontFamily -> ShowS
Show, FontFamily -> FontFamily -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontFamily -> FontFamily -> Bool
$c/= :: FontFamily -> FontFamily -> Bool
== :: FontFamily -> FontFamily -> Bool
$c== :: FontFamily -> FontFamily -> Bool
Eq)

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

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

type Stylesheet = IntMap.IntMap Style

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

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

instance Default Pict where
 def :: Pict
def = Pict { picType :: Maybe PictType
picType = forall a. Maybe a
Nothing
            , picWidth :: Maybe Int
picWidth = forall a. Maybe a
Nothing
            , picHeight :: Maybe Int
picHeight = forall a. Maybe a
Nothing
            , picWidthGoal :: Maybe Int
picWidthGoal = forall a. Maybe a
Nothing
            , picHeightGoal :: Maybe Int
picHeightGoal = forall a. Maybe a
Nothing
            , picBinary :: Bool
picBinary = Bool
False
            , picData :: Text
picData = forall a. Monoid a => a
mempty
            , picName :: Text
picName = forall a. Monoid a => a
mempty
            , picBytes :: ByteString
picBytes = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Properties] -> ShowS
$cshowList :: [Properties] -> ShowS
show :: Properties -> String
$cshow :: Properties -> String
showsPrec :: Int -> Properties -> ShowS
$cshowsPrec :: Int -> Properties -> ShowS
Show, Properties -> Properties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Properties -> Properties -> Bool
$c/= :: Properties -> Properties -> Bool
== :: Properties -> Properties -> Bool
$c== :: Properties -> Properties -> Bool
Eq)

instance Default Properties where
   def :: Properties
def = Properties { 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 = forall a. Maybe a
Nothing
                    , gAnchor :: Maybe Text
gAnchor = forall a. Maybe a
Nothing
                    , gImage :: Maybe Pict
gImage = forall a. Maybe a
Nothing
                    , gFontFamily :: Maybe FontFamily
gFontFamily = forall a. Maybe a
Nothing
                    , gHidden :: Bool
gHidden = Bool
False
                    , gUC :: Int
gUC = Int
1
                    , gFootnote :: Maybe Blocks
gFootnote = forall a. Maybe a
Nothing
                    , gOutlineLevel :: Maybe Int
gOutlineLevel = forall a. Maybe a
Nothing
                    , gListOverride :: Maybe Int
gListOverride = forall a. Maybe a
Nothing
                    , gListLevel :: Maybe Int
gListLevel = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListType] -> ShowS
$cshowList :: [ListType] -> ShowS
show :: ListType -> String
$cshow :: ListType -> String
showsPrec :: Int -> ListType -> ShowS
$cshowsPrec :: Int -> ListType -> ShowS
Show, ListType -> ListType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c== :: ListType -> ListType -> Bool
Eq)

type Override = Int

type ListLevel = Int

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

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

parseRTF :: PandocMonad m => RTFParser m Pandoc
parseRTF :: forall (m :: * -> *). PandocMonad m => RTFParser m Pandoc
parseRTF = do
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl
  Blocks
bs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). PandocMonad m => RTFParser m Tok
tok forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok forall a. Monoid a => a
mempty forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks
  Blocks
unclosed <- forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeContainers
  let doc :: Pandoc
doc = Blocks -> Pandoc
B.doc forall a b. (a -> b) -> a -> b
$ Blocks
bs forall a. Semigroup a => a -> a -> a
<> Blocks
unclosed
  [(Text, Inlines)]
kvs <- RTFState -> [(Text, Inlines)]
sMetadata forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta) Pandoc
doc [(Text, Inlines)]
kvs

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

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

tok :: PandocMonad m => RTFParser m Tok
tok :: forall (m :: * -> *). PandocMonad m => RTFParser m Tok
tok = do
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  SourcePos -> TokContents -> Tok
Tok SourcePos
pos forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ((ParsecT Sources RTFState m TokContents
controlThing forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT Sources u m TokContents
unformattedText 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) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl)
 where
  controlThing :: ParsecT Sources RTFState m TokContents
controlThing = do
    forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      ( ParsecT Sources RTFState m TokContents
controlWord
     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Word8 -> TokContents
HexVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Sources u m Word8
hexVal)
     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> TokContents
ControlSymbol forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall {u}. ParsecT Sources u m Text
letterSequence
    Maybe Int
param <- forall {u}. ParsecT Sources u m (Maybe Int)
parameter forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *). PandocMonad m => RTFParser m Char
delimChar
    case Text
name of
      Text
"bin" -> do
        let n :: Int
n = forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
param
        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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ByteString -> TokContents
BinData ByteString
dat
      Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False forall a b. (a -> b) -> a -> b
$ Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'-'
    String
rest <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
digit
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
       then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
       else do
         let pstr :: Text
pstr = String -> Text
T.pack String
rest
         case forall a. Integral a => Reader a
TR.decimal Text
pstr of
           Right (!Int
i,Text
_) ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! if Bool
hyph
                                     then (-Int
1) forall a. Num a => a -> a -> a
* Int
i
                                     else Int
i
           Either String (Int, Text)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  hexVal :: ParsecT Sources u m Word8
hexVal = do
    forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\''
    Char
x <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
hexDigit
    Char
y <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
hexDigit
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (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 <-  forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\r' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           ( forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (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 forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n')))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Text -> TokContents
UnformattedText forall a b. (a -> b) -> a -> b
$! String -> Text
T.pack String
ts
  grouped :: ParsecT Sources RTFState m TokContents
grouped = do
    forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'{'
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl
    [Tok]
ts <- 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 forall (m :: * -> *). PandocMonad m => RTFParser m Tok
tok (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
         forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput forall a. Monoid a => a
mempty -- discard remaining input: content after the \rtf1
                         -- group can be non-RTF
       [Tok]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\n' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 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 = 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 =
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState 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 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 = 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 forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gItalic Properties
props then Inlines -> Inlines
B.emph else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gDeleted Properties
props then Inlines -> Inlines
B.strikeout else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gSub Properties
props then Inlines -> Inlines
B.subscript else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gSuper Properties
props then Inlines -> Inlines
B.superscript else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gSmallCaps Properties
props then Inlines -> Inlines
B.smallcaps else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gUnderline Properties
props then Inlines -> Inlines
B.underline else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (case Properties -> Maybe Text
gHyperlink Properties
props of
     Maybe Text
Nothing -> forall a. a -> a
id
     Just Text
linkdest -> Text -> Text -> Inlines -> Inlines
B.link Text
linkdest forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (case Properties -> Maybe Text
gAnchor Properties
props of
     Maybe Text
Nothing -> forall a. a -> a
id
     Just Text
ident -> Attr -> Inlines -> Inlines
B.spanWith (Text
ident,[],[])) 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", forall a. Show a => a -> Text
tshow (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w forall a. Fractional a => a -> a -> a
/ Double
1440
                                                         :: Double)
                                          forall a. Semigroup a => a -> a -> a
<> Text
"in")]) forall a. [a] -> [a] -> [a]
++
                         (case Pict -> Maybe Int
picHeightGoal Pict
pict of
                            Maybe Int
Nothing -> []
                            Just Int
h -> [(Text
"height", forall a. Show a => a -> Text
tshow (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h forall a. Fractional a => a -> a -> a
/ Double
1440
                                                         :: Double)
                                          forall a. Semigroup a => a -> a -> a
<> Text
"in")]))
              in  Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith forall {a}. (Text, [a], [(Text, Text)])
attr (Pict -> Text
picName Pict
pict) Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
B.text
            Maybe Pict
Nothing -> Text -> Inlines
B.text) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (if Properties -> Bool
gCaps Properties
props then Text -> Text
T.toUpper else forall a. a -> a
id)
  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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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]
_ -> forall a. Default a => a
def
  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) 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
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
st ->
    RTFState
st{ sGroupStack :: [Properties]
sGroupStack =
        case RTFState -> [Properties]
sGroupStack RTFState
st of
          [] -> [forall a. Default a => a
def]
          (Properties
x:[Properties]
xs) -> (Properties
xforall a. a -> [a] -> [a]
:Properties
xforall a. a -> [a] -> [a]
:[Properties]
xs) } -- inherit current group's properties
  a
result <- RTFParser m a
p
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState 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 }
  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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
stynum Stylesheet
stylesheet of
    Maybe Style
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just Style
sty ->
      case Style -> Maybe Int
styleBasedOn Style
sty of
        Just Int
i -> (forall a. Semigroup a => a -> a -> a
<> Style -> [Tok]
styleFormatting Style
sty)  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
i
        Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return 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
  forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
  case TokContents
tok' of
    HexVal{} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    UnformattedText{} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    TokContents
_ -> forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (do [(Properties, Text)]
oldTextContent <- RTFState -> [(Properties, Text)]
sTextContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok forall a. Monoid a => a
mempty (SourcePos -> TokContents -> Tok
Tok SourcePos
pos ([Tok] -> TokContents
Grouped [Tok]
toks))
                forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState 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) -> forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sFontTable :: FontTable
sFontTable = [Tok] -> FontTable
processFontTable [Tok]
toks }
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"field" Maybe Int
_) : [Tok]
toks) ->
      forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handlePict [Tok]
toks)
    Grouped (Tok SourcePos
_ (ControlWord Text
"stylesheet" Maybe Int
_) : [Tok]
toks) ->
      Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (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
      forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"pgdsc" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"colortbl" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"listtable" Maybe Int
_) : [Tok]
toks) ->
      Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handleListTable [Tok]
toks)
    Grouped (Tok SourcePos
_ (ControlWord Text
"listoverridetable" Maybe Int
_) : [Tok]
toks) ->
      Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handleListOverrideTable [Tok]
toks)
    Grouped (Tok SourcePos
_ (ControlWord Text
"wgrffmtfilter" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"themedata" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"colorschememapping" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"datastore" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"latentstyles" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"pntxta" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs -- TODO
    Grouped (Tok SourcePos
_ (ControlWord Text
"pntxtb" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs -- TODO
    Grouped (Tok SourcePos
_ (ControlWord Text
"xmlnstbl" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"filetbl" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"expandedcolortbl" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"listtables" Maybe Int
_) : [Tok]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"revtbl" Maybe Int
_) : [Tok]
_) -> 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:
      forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\Properties
g -> Properties
g{ gAnchor :: Maybe Text
gAnchor = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t })
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"bkmkend" Maybe Int
_) : [Tok]
_) -> do
      forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\Properties
g -> Properties
g{ gAnchor :: Maybe Text
gAnchor = forall a. Maybe a
Nothing })
      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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"footnote" Maybe Int
_) : [Tok]
toks) -> do
      Blocks
noteBs <- forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m Blocks
processDestinationToks [Tok]
toks
      forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\Properties
g -> Properties
g{ gFootnote :: Maybe Blocks
gFootnote = forall a. a -> Maybe a
Just Blocks
noteBs })
      forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"*"
      forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\Properties
g -> Properties
g{ gFootnote :: Maybe Blocks
gFootnote = forall a. Maybe a
Nothing })
      forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
bs
    Grouped (Tok SourcePos
_ (ControlWord Text
"info" Maybe Int
_) : [Tok]
toks) ->
      Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (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 -> forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup forall a b. (a -> b) -> a -> b
$ do
      forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok forall a. Monoid a => a
mempty [Tok]
toks
      [(Properties, Text)]
annotatedToks <- forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTFState -> [(Properties, Text)]
sTextContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [] }
      let ils :: Inlines
ils = Inlines -> Inlines
B.trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Inlines
addFormatting [(Properties, Text)]
annotatedToks
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sMetadata :: [(Text, Inlines)]
sMetadata = (Text
f, Inlines
ils) forall a. a -> [a] -> [a]
: RTFState -> [(Text, Inlines)]
sMetadata RTFState
s }
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
    Grouped [Tok]
toks -> forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs [Tok]
toks)
    UnformattedText Text
t -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      -- return $! traceShowId $! (pos, t)
      Int
eatChars <- RTFState -> Int
sEatChars forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      case Int
eatChars of
        Int
0 -> forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
t
        Int
n | Int
n forall a. Ord a => a -> a -> Bool
< Text -> Int
T.length Text
t -> do
             forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Int
0 }
             forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Int -> Text -> Text
T.drop Int
n Text
t)
          | Bool
otherwise -> do
             forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Int
n forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
t }
    HexVal Word8
n -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      Int
eatChars <- RTFState -> Int
sEatChars forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      if Int
eatChars forall a. Eq a => a -> a -> Bool
== Int
0
         then do
           CharSet
charset <- RTFState -> CharSet
sCharSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
           case CharSet
charset of
             CharSet
ANSI -> forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Word8 -> Char
ansiToChar Word8
n)
             CharSet
Mac  -> forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Word8 -> Char
macToChar Word8
n)
             CharSet
Pc   -> forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Word8 -> Char
pcToChar Word8
n)
             CharSet
Pca  -> forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Word8 -> Char
pcaToChar Word8
n)
         else forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Int
eatChars forall a. Num a => a -> a -> a
- Int
1 }
    ControlWord Text
"ansi" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\Properties
g -> Properties
g{ gListLevel :: Maybe Int
gListLevel = Maybe Int
mbp })
    ControlSymbol Char
'\\' -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\\"
    ControlSymbol Char
'{' -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"{"
    ControlSymbol Char
'}' -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"}"
    ControlSymbol Char
'~' -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x00a0"
    ControlSymbol Char
'-' -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x00ad"
    ControlSymbol Char
'_' -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2011"
    ControlWord Text
"trowd" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do -- add new row
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sTableRows :: [TableRow]
sTableRows = [Blocks] -> TableRow
TableRow [] forall a. a -> [a] -> [a]
: RTFState -> [TableRow]
sTableRows RTFState
s
                           , sCurrentCell :: Blocks
sCurrentCell = forall a. Monoid a => a
mempty }
    ControlWord Text
"cell" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      Blocks
new <- forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks forall a. Monoid a => a
mempty
      Blocks
curCell <- (forall a. Semigroup a => a -> a -> a
<> Blocks
new) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTFState -> Blocks
sCurrentCell forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState 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 forall a. a -> [a] -> [a]
: [Blocks]
cs) forall a. a -> [a] -> [a]
: [TableRow]
rs
                                  [] -> [[Blocks] -> TableRow
TableRow [Blocks
curCell]] -- shouldn't happen
                           , sCurrentCell :: Blocks
sCurrentCell = forall a. Monoid a => a
mempty }
    ControlWord Text
"intbl" Maybe Int
_ ->
      forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks Blocks
bs forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (forall a b. a -> b -> a
const forall a. Default a => a
def)
    ControlWord Text
"lquote" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2018"
    ControlWord Text
"rquote" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2019"
    ControlWord Text
"ldblquote" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x201C"
    ControlWord Text
"rdblquote" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x201D"
    ControlWord Text
"emdash" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2014"
    ControlWord Text
"emspace" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2003"
    ControlWord Text
"enspace" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2002"
    ControlWord Text
"endash" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2013"
    ControlWord Text
"bullet" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\x2022"
    ControlWord Text
"tab" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\t"
    ControlWord Text
"line" Maybe Int
_ -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\n"
    ControlSymbol Char
'\n' -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\n"
    ControlSymbol Char
'\r' -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
"\n"
    ControlWord Text
"uc" (Just Int
i) -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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
      forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
    ControlWord Text
"s" (Just Int
n) -> do
      forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
    ControlWord Text
"ds" (Just Int
n) -> do
      forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
    ControlWord Text
"f" (Just Int
i) -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      FontTable
fontTable <- RTFState -> FontTable
sFontTable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\Properties
g -> Properties
g{ gFontFamily :: Maybe FontFamily
gFontFamily = forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i FontTable
fontTable })
    ControlWord Text
"u" (Just Int
i) -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      RTFState
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      let curgroup :: Properties
curgroup = case RTFState -> [Properties]
sGroupStack RTFState
st of
                       [] -> forall a. Default a => a
def
                       (Properties
x:[Properties]
_) -> Properties
x
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
      forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton (Int -> Char
chr forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
codepoint))
    ControlWord Text
"caps" Maybe Int
mbp -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\Properties
g -> Properties
g{ gSuper :: Bool
gSuper = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Maybe Int -> Bool
boolParam Maybe Int
mbp
                          , gSub :: Bool
gSub = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Maybe Int -> Bool
boolParam Maybe Int
mbp })
    ControlWord Text
"up" Maybe Int
mbp -> Blocks
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      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 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
      forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (forall a b. a -> b -> a
const forall a. Default a => a
def)
      forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
    ControlWord Text
"par" Maybe Int
_ -> forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks Blocks
bs
    TokContents
_ -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  [List]
liststack <- RTFState -> [List]
sListStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = forall a. Monoid a => a
mempty
                       , sListStack :: [List]
sListStack = [] }
  Blocks
result <- forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup forall a b. (a -> b) -> a -> b
$
              forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok forall a. Monoid a => a
mempty [Tok]
toks forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks
  Blocks
unclosed <- forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeContainers
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [(Properties, Text)]
textContent
                       , sListStack :: [List]
sListStack = [List]
liststack }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Blocks
result 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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' 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)
                    (forall a. [a] -> [a]
reverse [Blocks]
items)
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sListStack :: [List]
sListStack = [List]
rest }
      case [List]
rest of
        [] -> do
          forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sListStack :: [List]
sListStack = [List]
rest }
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
newlist
        (List Int
lo Int
lvl'' ListType
lt' [] : [List]
rest') -> do -- should not happen
          forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState 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] forall a. a -> [a] -> [a]
: [List]
rest' }
          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
          forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState 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 forall a. Semigroup a => a -> a -> a
<> Blocks
newlist forall a. a -> [a] -> [a]
: [Blocks]
is) forall a. a -> [a] -> [a]
: [List]
rest' }
          forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
lvl
    [List]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TableRow]
rawrows
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
     else do
       let getCells :: TableRow -> [Blocks]
getCells (TableRow [Blocks]
cs) = forall a. [a] -> [a]
reverse [Blocks]
cs
       let rows :: [[Blocks]]
rows = forall a b. (a -> b) -> [a] -> [b]
map TableRow -> [Blocks]
getCells forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [TableRow]
rawrows
       forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sCurrentCell :: Blocks
sCurrentCell = forall a. Monoid a => a
mempty
                            , sTableRows :: [TableRow]
sTableRows = [] }
       forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeTable
  Blocks
lists <- forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
0
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Blocks
tbl forall a. Semigroup a => a -> a -> a
<> Blocks
lists

trimFinalLineBreak :: Inlines -> Inlines
trimFinalLineBreak :: Inlines -> Inlines
trimFinalLineBreak Inlines
ils =
  case forall a. Seq a -> ViewR a
Seq.viewr (forall a. Many a -> Seq a
B.unMany Inlines
ils) of
    Seq Inline
rest Seq.:> Inline
LineBreak -> 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 <- forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTFState -> [(Properties, Text)]
sTextContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [] }
  let justCode :: Properties
justCode = forall a. Default a => a
def{ gFontFamily :: Maybe FontFamily
gFontFamily = forall a. a -> Maybe a
Just FontFamily
Modern }
  let prop :: Properties
prop = case [(Properties, Text)]
annotatedToks of
               [] -> forall a. Default a => a
def
               ((Properties
p,Text
_):[(Properties, Text)]
_) -> Properties
p
  Blocks
tbl <- if Properties -> Bool
gInTable Properties
prop Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Properties, Text)]
annotatedToks
            then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
            else forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeTable
  Blocks
new <-
    case [(Properties, Text)]
annotatedToks of
      [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
      [(Properties, Text)]
_ | Just Int
lst <- Properties -> Maybe Int
gListOverride Properties
prop
         -> do
           let level :: Int
level = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ Properties -> Maybe Int
gListLevel Properties
prop
           ListTable
listOverrideTable <- RTFState -> ListTable
sListOverrideTable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
           let listType :: ListType
listType = forall a. a -> Maybe a -> a
fromMaybe ListType
Bullet forall a b. (a -> b) -> a -> b
$
                 forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
lst ListTable
listOverrideTable forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
level
           [List]
lists <- RTFState -> [List]
sListStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
B.trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimFinalLineBreak forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
                        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 forall a. Eq a => a -> a -> Bool
== Int
lst
               , Int
parentlevel forall a. Eq a => a -> a -> Bool
== Int
level
               -- add another item to existing list
               -> do forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState 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
newbsforall a. a -> [a] -> [a]
:[Blocks]
items) forall a. a -> [a] -> [a]
: [List]
cs }
                     forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
               | Int
lo forall a. Eq a => a -> a -> Bool
/= Int
lst Bool -> Bool -> Bool
|| Int
level forall a. Ord a => a -> a -> Bool
< Int
parentlevel
               -- close parent list and add new list
               -> do Blocks
new <- forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
level  -- close open lists > level
                     forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState 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] forall a. a -> [a] -> [a]
:
                           RTFState -> [List]
sListStack RTFState
s }
                     forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
new
             [List]
_ -> do -- add new list (level > parentlevel)
                  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState 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] forall a. a -> [a] -> [a]
:
                         RTFState -> [List]
sListStack RTFState
s }
                  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
        | Just Int
lvl <- Properties -> Maybe Int
gOutlineLevel Properties
prop
         -> do
            Blocks
lists <- forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
0
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Blocks
lists forall a. Semigroup a => a -> a -> a
<>
                   Int -> Inlines -> Blocks
B.header (Int
lvl forall a. Num a => a -> a -> a
+ Int
1)
                   (Inlines -> Inlines
B.trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Inlines
addFormatting
                                            forall a b. (a -> b) -> a -> b
$ [(Properties, Text)] -> [(Properties, Text)]
removeCommonFormatting
                                              [(Properties, Text)]
annotatedToks)
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Eq a => a -> a -> Bool
== Properties
justCode) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Properties, Text)]
annotatedToks
         -> do
            Blocks
lists <- forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
0
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Blocks
lists forall a. Semigroup a => a -> a -> a
<>
                    Text -> Blocks
B.codeBlock (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Properties, Text)]
annotatedToks)
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Properties, Text)]
annotatedToks
         -> forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
0
        | Bool
otherwise -> do
            Blocks
lists <- forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
0
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Blocks
lists forall a. Semigroup a => a -> a -> a
<>
              Inlines -> Blocks
B.para (Inlines -> Inlines
B.trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimFinalLineBreak forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
                forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Inlines
addFormatting [(Properties, Text)]
annotatedToks)
  if Properties -> Bool
gInTable Properties
prop
     then do
       forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sCurrentCell :: Blocks
sCurrentCell = RTFState -> Blocks
sCurrentCell RTFState
s forall a. Semigroup a => a -> a -> a
<> Blocks
new }
       forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
     else do
       forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Blocks
bs forall a. Semigroup a => a -> a -> a
<> Blocks
tbl 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Properties -> Bool
gBold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Properties, Text)]
ts
       then 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (\[(Properties, Text)]
ts ->
    if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Properties -> Bool
gItalic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Properties, Text)]
ts
       then 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
"#" forall a. Semigroup a => a -> a -> a
<> Text -> Text
unquote Text
bkmrk
                         [Tok]
_ -> Text
linkdest
       forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup forall a b. (a -> b) -> a -> b
$ \Properties
g -> Properties
g{ gHyperlink :: Maybe Text
gHyperlink = forall a. a -> Maybe a
Just Text
linkdest' }
       Blocks
result <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs [Tok]
linktoks
       forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup forall a b. (a -> b) -> a -> b
$ \Properties
g -> Properties
g{ gHyperlink :: Maybe Text
gHyperlink = forall a. Maybe a
Nothing }
       forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
result
handleField Blocks
bs [Tok]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs

unquote :: Text -> Text
unquote :: Text -> Text
unquote = (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'"') forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
==Char
'"') 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
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ 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 = 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 <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
PandocMonad m =>
IntMap ListType -> (Int, [Tok]) -> RTFParser m (IntMap ListType)
handleListLevel forall a. Monoid a => a
mempty (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [[Tok]]
levels)
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sListTable :: ListTable
sListTable = forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
listid IntMap ListType
tbl forall a b. (a -> b) -> a -> b
$ RTFState -> ListTable
sListTable RTFState
s }
handleList Tok
_ = 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 = 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
          [] -> forall a. Maybe a
Nothing
          (Int
0:[Int]
_) -> forall a. a -> Maybe a
Just ListNumberStyle
Decimal
          (Int
1:[Int]
_) -> forall a. a -> Maybe a
Just ListNumberStyle
UpperRoman
          (Int
2:[Int]
_) -> forall a. a -> Maybe a
Just ListNumberStyle
LowerRoman
          (Int
3:[Int]
_) -> forall a. a -> Maybe a
Just ListNumberStyle
UpperAlpha
          (Int
4:[Int]
_) -> forall a. a -> Maybe a
Just ListNumberStyle
LowerAlpha
          (Int
23:[Int]
_) -> forall a. Maybe a
Nothing
          (Int
255:[Int]
_) -> forall a. Maybe a
Nothing
          [Int]
_ -> 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)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ 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 = forall a. a -> [a] -> a
headDef Int
0 [Int
n | Tok SourcePos
_ (ControlWord Text
"listid" (Just Int
n)) <- [Tok]
toks]
  let lsn :: Int
lsn = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
listid ListTable
listTable of
    Maybe (IntMap ListType)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just IntMap ListType
tbl -> forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s ->
                   RTFState
s{ sListOverrideTable :: ListTable
sListOverrideTable = forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
lsn IntMap ListType
tbl forall a b. (a -> b) -> a -> b
$
                        RTFState -> ListTable
sListOverrideTable RTFState
s }
handleListOverride Tok
_ = 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tok -> Maybe Style
parseStyle [Tok]
toks
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \RTFState
s -> RTFState
s{ sStylesheet :: Stylesheet
sStylesheet = forall a. [(Int, a)] -> IntMap a
IntMap.fromList
                                     forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (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 forall a. [a] -> Maybe a
lastMay [Tok]
rest of
                  Just (Tok SourcePos
_ (UnformattedText Text
t)) -> (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
==Char
';') Text
t
                  Maybe Tok
_ -> 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 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))) -> forall a. a -> Maybe a
Just Int
i
                     Maybe Tok
_ -> forall a. Maybe a
Nothing
  let isStyleControl :: Tok -> Bool
isStyleControl (Tok SourcePos
_ (ControlWord Text
x Maybe Int
_)) =
         Text
x 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 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> Bool
isStyleControl) (forall a. [a] -> [a]
initSafe [Tok]
rest)
  forall (m :: * -> *) a. Monad m => a -> m a
return 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
_ = forall a. Maybe a
Nothing

hexToWord  :: Text -> Word8
hexToWord :: Text -> Word8
hexToWord Text
t = case 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Pict -> Tok -> Pict
getPictData 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Word8
hexToWord forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
2 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 -> (forall a. a -> Maybe a
Just Text
"image/x-emf", String
".emf")
          Just PictType
Pngblip -> (forall a. a -> Maybe a
Just Text
"image/png", String
".png")
          Just PictType
Jpegblip -> (forall a. a -> Maybe a
Just Text
"image/jpeg", String
".jpg")
          Maybe PictType
Nothing -> (forall a. Maybe a
Nothing, String
"")
  case Maybe Text
mimetype of
    Just Text
mt -> do
      let pictname :: String
pictname = forall t. Digest t -> String
showDigest (ByteString -> Digest SHA1State
sha1 ByteString
bytes) forall a. Semigroup a => a -> a -> a
<> String
ext
      forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia String
pictname (forall a. a -> Maybe a
Just Text
mt) ByteString
bytes
      forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup forall a b. (a -> b) -> a -> b
$ \Properties
g -> Properties
g{ gImage :: Maybe Pict
gImage = forall a. a -> Maybe a
Just Pict
pict{ picName :: Text
picName = String -> Text
T.pack String
pictname,
                                                 picBytes :: ByteString
picBytes = ByteString
bytes } }
      forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
altText
      forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup forall a b. (a -> b) -> a -> b
$ \Properties
g -> Properties
g{ gImage :: Maybe Pict
gImage = forall a. Maybe a
Nothing }
    Maybe Text
_ -> 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 = forall a. a -> Maybe a
Just PictType
Emfblip }
      ControlWord Text
"pngblip" Maybe Int
_-> Pict
pict{ picType :: Maybe PictType
picType = forall a. a -> Maybe a
Just PictType
Pngblip }
      ControlWord Text
"jpegblip" Maybe Int
_-> Pict
pict{ picType :: Maybe PictType
picType = forall a. a -> Maybe a
Just PictType
Jpegblip }
      ControlWord Text
"picw" (Just Int
w) -> Pict
pict{ picWidth :: Maybe Int
picWidth = forall a. a -> Maybe a
Just Int
w }
      ControlWord Text
"pich" (Just Int
h) -> Pict
pict{ picHeight :: Maybe Int
picHeight = forall a. a -> Maybe a
Just Int
h }
      ControlWord Text
"picwgoal" (Just Int
w) -> Pict
pict{ picWidthGoal :: Maybe Int
picWidthGoal = forall a. a -> Maybe a
Just Int
w }
      ControlWord Text
"pichgoal" (Just Int
h) -> Pict
pict{ picHeightGoal :: Maybe Int
picHeightGoal = 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 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 -> forall a. Maybe a
Nothing
    Just Text
rest -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Text
unquote Text
rest

processFontTable :: [Tok] -> FontTable
processFontTable :: [Tok] -> FontTable
processFontTable = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, FontTable) -> Tok -> (Int, FontTable)
go (Int
0, 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, forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Roman FontTable
tbl)
     (ControlWord Text
"fswiss" Maybe Int
_) -> (Int
fontnum, forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Swiss FontTable
tbl)
     (ControlWord Text
"fmodern" Maybe Int
_) -> (Int
fontnum, forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Modern FontTable
tbl)
     (ControlWord Text
"fscript" Maybe Int
_) -> (Int
fontnum, forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Script FontTable
tbl)
     (ControlWord Text
"fdecor" Maybe Int
_) -> (Int
fontnum, forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Decor FontTable
tbl)
     (ControlWord Text
"ftech" Maybe Int
_) -> (Int
fontnum, forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Tech FontTable
tbl)
     (ControlWord Text
"fbidi" Maybe Int
_) -> (Int
fontnum, forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Bidi FontTable
tbl)
     (Grouped [Tok]
ts) -> 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 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
_ -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

macToChar :: Word8 -> Char
macToChar :: Word8 -> Char
macToChar Word8
i = Int -> Char
chr 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
_ -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

pcToChar :: Word8 -> Char
pcToChar :: Word8 -> Char
pcToChar Word8
i = Int -> Char
chr 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
_    -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i

pcaToChar :: Word8 -> Char
pcaToChar :: Word8 -> Char
pcaToChar Word8
i = Int -> Char
chr 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
_    -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i