{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.RTF (readRTF) where
import qualified Data.IntMap as IntMap
import qualified Data.Sequence as Seq
import Control.Monad
import Control.Monad.Except (throwError)
import Data.List (find, foldl')
import Data.Word (Word8, Word16)
import Data.Default
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Read as TR
import Text.Pandoc.Builder (Blocks, Inlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad (..), insertMedia)
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Parsing
import Text.Pandoc.Shared (safeRead, tshow)
import Data.Char (isAlphaNum, chr, isAscii, isLetter, isSpace, ord)
import qualified Data.ByteString.Lazy as BL
import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.Maybe (mapMaybe, fromMaybe)
import Safe (lastMay, initSafe, headDef)
readRTF :: (PandocMonad m, ToSources a)
=> ReaderOptions
-> a
-> m Pandoc
readRTF :: ReaderOptions -> a -> m Pandoc
readRTF opts :: ReaderOptions
opts s :: a
s = do
let sources :: Sources
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
s
Either PandocError Pandoc
parsed <- ParserT Sources RTFState m Pandoc
-> RTFState -> Sources -> m (Either PandocError Pandoc)
forall (m :: * -> *) t st a.
(Monad m, ToSources t) =>
ParserT Sources st m a -> st -> t -> m (Either PandocError a)
readWithM ParserT Sources RTFState m Pandoc
forall (m :: * -> *). PandocMonad m => RTFParser m Pandoc
parseRTF RTFState
forall a. Default a => a
def{ sOptions :: ReaderOptions
sOptions = ReaderOptions
opts } Sources
sources
case Either PandocError Pandoc
parsed of
Left e :: PandocError
e -> PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
Right d :: Pandoc
d -> Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
d
data CharSet = ANSI | Mac | Pc | Pca
deriving (Int -> CharSet -> ShowS
[CharSet] -> ShowS
CharSet -> String
(Int -> CharSet -> ShowS)
-> (CharSet -> String) -> ([CharSet] -> ShowS) -> Show CharSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharSet] -> ShowS
$cshowList :: [CharSet] -> ShowS
show :: CharSet -> String
$cshow :: CharSet -> String
showsPrec :: Int -> CharSet -> ShowS
$cshowsPrec :: Int -> CharSet -> ShowS
Show, CharSet -> CharSet -> Bool
(CharSet -> CharSet -> Bool)
-> (CharSet -> CharSet -> Bool) -> Eq CharSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharSet -> CharSet -> Bool
$c/= :: CharSet -> CharSet -> Bool
== :: CharSet -> CharSet -> Bool
$c== :: CharSet -> CharSet -> Bool
Eq)
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]
, RTFState -> [(Properties, Text)]
sTextContent :: [(Properties, Text)]
, RTFState -> [(Text, Inlines)]
sMetadata :: [(Text, Inlines)]
, RTFState -> FontTable
sFontTable :: FontTable
, RTFState -> Stylesheet
sStylesheet :: Stylesheet
, RTFState -> ListTable
sListTable :: ListTable
, RTFState -> ListTable
sListOverrideTable :: ListTable
, RTFState -> Int
sEatChars :: Int
} deriving (Int -> RTFState -> ShowS
[RTFState] -> ShowS
RTFState -> String
(Int -> RTFState -> ShowS)
-> (RTFState -> String) -> ([RTFState] -> ShowS) -> Show RTFState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RTFState] -> ShowS
$cshowList :: [RTFState] -> ShowS
show :: RTFState -> String
$cshow :: RTFState -> String
showsPrec :: Int -> RTFState -> ShowS
$cshowsPrec :: Int -> RTFState -> ShowS
Show)
instance Default RTFState where
def :: RTFState
def = RTFState :: ReaderOptions
-> CharSet
-> [Properties]
-> [List]
-> Blocks
-> [TableRow]
-> [(Properties, Text)]
-> [(Text, Inlines)]
-> FontTable
-> Stylesheet
-> ListTable
-> ListTable
-> Int
-> RTFState
RTFState { sOptions :: ReaderOptions
sOptions = ReaderOptions
forall a. Default a => a
def
, sCharSet :: CharSet
sCharSet = CharSet
ANSI
, sGroupStack :: [Properties]
sGroupStack = []
, sListStack :: [List]
sListStack = []
, sCurrentCell :: Blocks
sCurrentCell = Blocks
forall a. Monoid a => a
mempty
, sTableRows :: [TableRow]
sTableRows = []
, sTextContent :: [(Properties, Text)]
sTextContent = []
, sMetadata :: [(Text, Inlines)]
sMetadata = []
, sFontTable :: FontTable
sFontTable = FontTable
forall a. Monoid a => a
mempty
, sStylesheet :: Stylesheet
sStylesheet = Stylesheet
forall a. Monoid a => a
mempty
, sListTable :: ListTable
sListTable = ListTable
forall a. Monoid a => a
mempty
, sListOverrideTable :: ListTable
sListOverrideTable = ListTable
forall a. Monoid a => a
mempty
, sEatChars :: Int
sEatChars = 0
}
type FontTable = IntMap.IntMap FontFamily
data FontFamily =
Roman | Swiss | Modern | Script | Decor | Tech | Bidi
deriving (Int -> FontFamily -> ShowS
[FontFamily] -> ShowS
FontFamily -> String
(Int -> FontFamily -> ShowS)
-> (FontFamily -> String)
-> ([FontFamily] -> ShowS)
-> Show FontFamily
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontFamily] -> ShowS
$cshowList :: [FontFamily] -> ShowS
show :: FontFamily -> String
$cshow :: FontFamily -> String
showsPrec :: Int -> FontFamily -> ShowS
$cshowsPrec :: Int -> FontFamily -> ShowS
Show, FontFamily -> FontFamily -> Bool
(FontFamily -> FontFamily -> Bool)
-> (FontFamily -> FontFamily -> Bool) -> Eq FontFamily
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontFamily -> FontFamily -> Bool
$c/= :: FontFamily -> FontFamily -> Bool
== :: FontFamily -> FontFamily -> Bool
$c== :: FontFamily -> FontFamily -> Bool
Eq)
data StyleType = ParagraphStyle | SectionStyle | CharStyle | TableStyle
deriving (Int -> StyleType -> ShowS
[StyleType] -> ShowS
StyleType -> String
(Int -> StyleType -> ShowS)
-> (StyleType -> String)
-> ([StyleType] -> ShowS)
-> Show StyleType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StyleType] -> ShowS
$cshowList :: [StyleType] -> ShowS
show :: StyleType -> String
$cshow :: StyleType -> String
showsPrec :: Int -> StyleType -> ShowS
$cshowsPrec :: Int -> StyleType -> ShowS
Show, StyleType -> StyleType -> Bool
(StyleType -> StyleType -> Bool)
-> (StyleType -> StyleType -> Bool) -> Eq StyleType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StyleType -> StyleType -> Bool
$c/= :: StyleType -> StyleType -> Bool
== :: StyleType -> StyleType -> Bool
$c== :: StyleType -> StyleType -> Bool
Eq)
data Style =
Style { Style -> Int
styleNum :: Int
, Style -> StyleType
styleType :: StyleType
, Style -> Maybe Int
styleBasedOn :: Maybe Int
, Style -> Text
styleName :: Text
, Style -> [Tok]
styleFormatting :: [Tok]
} deriving (Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Style] -> ShowS
$cshowList :: [Style] -> ShowS
show :: Style -> String
$cshow :: Style -> String
showsPrec :: Int -> Style -> ShowS
$cshowsPrec :: Int -> Style -> ShowS
Show, Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq)
type Stylesheet = IntMap.IntMap Style
data PictType =
Emfblip | Pngblip | Jpegblip
deriving (Int -> PictType -> ShowS
[PictType] -> ShowS
PictType -> String
(Int -> PictType -> ShowS)
-> (PictType -> String) -> ([PictType] -> ShowS) -> Show PictType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PictType] -> ShowS
$cshowList :: [PictType] -> ShowS
show :: PictType -> String
$cshow :: PictType -> String
showsPrec :: Int -> PictType -> ShowS
$cshowsPrec :: Int -> PictType -> ShowS
Show, PictType -> PictType -> Bool
(PictType -> PictType -> Bool)
-> (PictType -> PictType -> Bool) -> Eq PictType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PictType -> PictType -> Bool
$c/= :: PictType -> PictType -> Bool
== :: PictType -> PictType -> Bool
$c== :: PictType -> PictType -> Bool
Eq)
data Pict =
Pict { Pict -> Maybe PictType
picType :: Maybe PictType
, Pict -> Maybe Int
picWidth :: Maybe Int
, Pict -> Maybe Int
picHeight :: Maybe Int
, Pict -> Maybe Int
picWidthGoal :: Maybe Int
, Pict -> Maybe Int
picHeightGoal :: Maybe Int
, Pict -> Bool
picBinary :: Bool
, Pict -> Text
picData :: Text
, Pict -> Text
picName :: Text
, Pict -> ByteString
picBytes :: BL.ByteString
} deriving (Int -> Pict -> ShowS
[Pict] -> ShowS
Pict -> String
(Int -> Pict -> ShowS)
-> (Pict -> String) -> ([Pict] -> ShowS) -> Show Pict
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pict] -> ShowS
$cshowList :: [Pict] -> ShowS
show :: Pict -> String
$cshow :: Pict -> String
showsPrec :: Int -> Pict -> ShowS
$cshowsPrec :: Int -> Pict -> ShowS
Show, Pict -> Pict -> Bool
(Pict -> Pict -> Bool) -> (Pict -> Pict -> Bool) -> Eq Pict
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pict -> Pict -> Bool
$c/= :: Pict -> Pict -> Bool
== :: Pict -> Pict -> Bool
$c== :: Pict -> Pict -> Bool
Eq)
instance Default Pict where
def :: Pict
def = Pict :: Maybe PictType
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bool
-> Text
-> Text
-> ByteString
-> Pict
Pict { picType :: Maybe PictType
picType = Maybe PictType
forall a. Maybe a
Nothing
, picWidth :: Maybe Int
picWidth = Maybe Int
forall a. Maybe a
Nothing
, picHeight :: Maybe Int
picHeight = Maybe Int
forall a. Maybe a
Nothing
, picWidthGoal :: Maybe Int
picWidthGoal = Maybe Int
forall a. Maybe a
Nothing
, picHeightGoal :: Maybe Int
picHeightGoal = Maybe Int
forall a. Maybe a
Nothing
, picBinary :: Bool
picBinary = Bool
False
, picData :: Text
picData = Text
forall a. Monoid a => a
mempty
, picName :: Text
picName = Text
forall a. Monoid a => a
mempty
, picBytes :: ByteString
picBytes = ByteString
forall a. Monoid a => a
mempty }
data Properties =
Properties
{ Properties -> Bool
gBold :: Bool
, Properties -> Bool
gItalic :: Bool
, Properties -> Bool
gCaps :: Bool
, Properties -> Bool
gDeleted :: Bool
, Properties -> Bool
gSub :: Bool
, Properties -> Bool
gSuper :: Bool
, Properties -> Bool
gSmallCaps :: Bool
, Properties -> Bool
gUnderline :: Bool
, Properties -> Maybe Text
gHyperlink :: Maybe Text
, Properties -> Maybe Text
gAnchor :: Maybe Text
, Properties -> Maybe Pict
gImage :: Maybe Pict
, Properties -> Maybe FontFamily
gFontFamily :: Maybe FontFamily
, Properties -> Bool
gHidden :: Bool
, Properties -> Int
gUC :: Int
, :: Maybe Blocks
, Properties -> Maybe Int
gOutlineLevel :: Maybe ListLevel
, Properties -> Maybe Int
gListOverride :: Maybe Override
, Properties -> Maybe Int
gListLevel :: Maybe Int
, Properties -> Bool
gInTable :: Bool
} deriving (Int -> Properties -> ShowS
[Properties] -> ShowS
Properties -> String
(Int -> Properties -> ShowS)
-> (Properties -> String)
-> ([Properties] -> ShowS)
-> Show Properties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Properties] -> ShowS
$cshowList :: [Properties] -> ShowS
show :: Properties -> String
$cshow :: Properties -> String
showsPrec :: Int -> Properties -> ShowS
$cshowsPrec :: Int -> Properties -> ShowS
Show, Properties -> Properties -> Bool
(Properties -> Properties -> Bool)
-> (Properties -> Properties -> Bool) -> Eq Properties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Properties -> Properties -> Bool
$c/= :: Properties -> Properties -> Bool
== :: Properties -> Properties -> Bool
$c== :: Properties -> Properties -> Bool
Eq)
instance Default Properties where
def :: Properties
def = Properties :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> Maybe Text
-> Maybe Pict
-> Maybe FontFamily
-> Bool
-> Int
-> Maybe Blocks
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bool
-> Properties
Properties { gBold :: Bool
gBold = Bool
False
, gItalic :: Bool
gItalic = Bool
False
, gCaps :: Bool
gCaps = Bool
False
, gDeleted :: Bool
gDeleted = Bool
False
, gSub :: Bool
gSub = Bool
False
, gSuper :: Bool
gSuper = Bool
False
, gSmallCaps :: Bool
gSmallCaps = Bool
False
, gUnderline :: Bool
gUnderline = Bool
False
, gHyperlink :: Maybe Text
gHyperlink = Maybe Text
forall a. Maybe a
Nothing
, gAnchor :: Maybe Text
gAnchor = Maybe Text
forall a. Maybe a
Nothing
, gImage :: Maybe Pict
gImage = Maybe Pict
forall a. Maybe a
Nothing
, gFontFamily :: Maybe FontFamily
gFontFamily = Maybe FontFamily
forall a. Maybe a
Nothing
, gHidden :: Bool
gHidden = Bool
False
, gUC :: Int
gUC = 1
, gFootnote :: Maybe Blocks
gFootnote = Maybe Blocks
forall a. Maybe a
Nothing
, gOutlineLevel :: Maybe Int
gOutlineLevel = Maybe Int
forall a. Maybe a
Nothing
, gListOverride :: Maybe Int
gListOverride = Maybe Int
forall a. Maybe a
Nothing
, gListLevel :: Maybe Int
gListLevel = Maybe Int
forall a. Maybe a
Nothing
, gInTable :: Bool
gInTable = Bool
False
}
type RTFParser m = ParserT Sources RTFState m
data ListType = Bullet | Ordered ListAttributes
deriving (Int -> ListType -> ShowS
[ListType] -> ShowS
ListType -> String
(Int -> ListType -> ShowS)
-> (ListType -> String) -> ([ListType] -> ShowS) -> Show ListType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListType] -> ShowS
$cshowList :: [ListType] -> ShowS
show :: ListType -> String
$cshow :: ListType -> String
showsPrec :: Int -> ListType -> ShowS
$cshowsPrec :: Int -> ListType -> ShowS
Show, ListType -> ListType -> Bool
(ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool) -> Eq ListType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c== :: ListType -> ListType -> Bool
Eq)
type Override = Int
type ListLevel = Int
data List =
List Override ListLevel ListType [Blocks]
deriving (Int -> List -> ShowS
[List] -> ShowS
List -> String
(Int -> List -> ShowS)
-> (List -> String) -> ([List] -> ShowS) -> Show List
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [List] -> ShowS
$cshowList :: [List] -> ShowS
show :: List -> String
$cshow :: List -> String
showsPrec :: Int -> List -> ShowS
$cshowsPrec :: Int -> List -> ShowS
Show, List -> List -> Bool
(List -> List -> Bool) -> (List -> List -> Bool) -> Eq List
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: List -> List -> Bool
$c/= :: List -> List -> Bool
== :: List -> List -> Bool
$c== :: List -> List -> Bool
Eq)
newtype TableRow = TableRow [Blocks]
deriving (Int -> TableRow -> ShowS
[TableRow] -> ShowS
TableRow -> String
(Int -> TableRow -> ShowS)
-> (TableRow -> String) -> ([TableRow] -> ShowS) -> Show TableRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableRow] -> ShowS
$cshowList :: [TableRow] -> ShowS
show :: TableRow -> String
$cshow :: TableRow -> String
showsPrec :: Int -> TableRow -> ShowS
$cshowsPrec :: Int -> TableRow -> ShowS
Show, TableRow -> TableRow -> Bool
(TableRow -> TableRow -> Bool)
-> (TableRow -> TableRow -> Bool) -> Eq TableRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableRow -> TableRow -> Bool
$c/= :: TableRow -> TableRow -> Bool
== :: TableRow -> TableRow -> Bool
$c== :: TableRow -> TableRow -> Bool
Eq)
parseRTF :: PandocMonad m => RTFParser m Pandoc
parseRTF :: RTFParser m Pandoc
parseRTF = do
ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl
[Tok]
toks <- ParsecT Sources RTFState m Tok -> ParsecT Sources RTFState m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources RTFState m Tok
forall (m :: * -> *). PandocMonad m => RTFParser m Tok
tok
Blocks
bs <- (case [Tok]
toks of
rtftok :: Tok
rtftok@(Tok _ (Grouped (Tok _ (ControlWord "rtf" (Just 1)) : _))) : _
-> (Blocks -> Tok -> ParsecT Sources RTFState m Blocks)
-> Blocks -> [Tok] -> ParsecT Sources RTFState m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> ParsecT Sources RTFState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
forall a. Monoid a => a
mempty [Tok
rtftok]
_ -> (Blocks -> Tok -> ParsecT Sources RTFState m Blocks)
-> Blocks -> [Tok] -> ParsecT Sources RTFState m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> ParsecT Sources RTFState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
forall a. Monoid a => a
mempty [Tok]
toks)
ParsecT Sources RTFState m Blocks
-> (Blocks -> ParsecT Sources RTFState m Blocks)
-> ParsecT Sources RTFState m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Blocks -> ParsecT Sources RTFState m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks
Blocks
unclosed <- ParsecT Sources RTFState m Blocks
forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeContainers
let doc :: Pandoc
doc = Blocks -> Pandoc
B.doc (Blocks -> Pandoc) -> Blocks -> Pandoc
forall a b. (a -> b) -> a -> b
$ Blocks
bs Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
unclosed
[(Text, Inlines)]
kvs <- RTFState -> [(Text, Inlines)]
sMetadata (RTFState -> [(Text, Inlines)])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [(Text, Inlines)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Pandoc -> RTFParser m Pandoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pandoc -> RTFParser m Pandoc) -> Pandoc -> RTFParser m Pandoc
forall a b. (a -> b) -> a -> b
$ ((Text, Inlines) -> Pandoc -> Pandoc)
-> Pandoc -> [(Text, Inlines)] -> Pandoc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Text -> Inlines -> Pandoc -> Pandoc)
-> (Text, Inlines) -> Pandoc -> Pandoc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Inlines -> Pandoc -> Pandoc
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta) Pandoc
doc [(Text, Inlines)]
kvs
data Tok = Tok SourcePos TokContents
deriving (Int -> Tok -> ShowS
[Tok] -> ShowS
Tok -> String
(Int -> Tok -> ShowS)
-> (Tok -> String) -> ([Tok] -> ShowS) -> Show Tok
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tok] -> ShowS
$cshowList :: [Tok] -> ShowS
show :: Tok -> String
$cshow :: Tok -> String
showsPrec :: Int -> Tok -> ShowS
$cshowsPrec :: Int -> Tok -> ShowS
Show, Tok -> Tok -> Bool
(Tok -> Tok -> Bool) -> (Tok -> Tok -> Bool) -> Eq Tok
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tok -> Tok -> Bool
$c/= :: Tok -> Tok -> Bool
== :: Tok -> Tok -> Bool
$c== :: Tok -> Tok -> Bool
Eq)
data TokContents =
ControlWord Text (Maybe Int)
| ControlSymbol Char
| UnformattedText Text
| BinData BL.ByteString
| HexVal Word8
| Grouped [Tok]
deriving (Int -> TokContents -> ShowS
[TokContents] -> ShowS
TokContents -> String
(Int -> TokContents -> ShowS)
-> (TokContents -> String)
-> ([TokContents] -> ShowS)
-> Show TokContents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokContents] -> ShowS
$cshowList :: [TokContents] -> ShowS
show :: TokContents -> String
$cshow :: TokContents -> String
showsPrec :: Int -> TokContents -> ShowS
$cshowsPrec :: Int -> TokContents -> ShowS
Show, TokContents -> TokContents -> Bool
(TokContents -> TokContents -> Bool)
-> (TokContents -> TokContents -> Bool) -> Eq TokContents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokContents -> TokContents -> Bool
$c/= :: TokContents -> TokContents -> Bool
== :: TokContents -> TokContents -> Bool
$c== :: TokContents -> TokContents -> Bool
Eq)
tok :: PandocMonad m => RTFParser m Tok
tok :: RTFParser m Tok
tok = do
SourcePos
pos <- ParsecT Sources RTFState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
SourcePos -> TokContents -> Tok
Tok SourcePos
pos (TokContents -> Tok)
-> ParsecT Sources RTFState m TokContents -> RTFParser m Tok
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ParsecT Sources RTFState m TokContents
controlThing ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources RTFState m TokContents
unformattedText ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources RTFState m TokContents
grouped) ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m ()
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl)
where
controlThing :: ParsecT Sources RTFState m TokContents
controlThing = do
Char -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '\\' ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
( ParsecT Sources RTFState m TokContents
forall u. ParsecT Sources u m TokContents
binData
ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> Maybe Int -> TokContents
ControlWord (Text -> Maybe Int -> TokContents)
-> ParsecT Sources RTFState m Text
-> ParsecT Sources RTFState m (Maybe Int -> TokContents)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m Text
forall u. ParsecT Sources u m Text
letterSequence ParsecT Sources RTFState m (Maybe Int -> TokContents)
-> ParsecT Sources RTFState m (Maybe Int)
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Sources RTFState m (Maybe Int)
forall u. ParsecT Sources u m (Maybe Int)
parameter ParsecT Sources RTFState m (Maybe Int)
-> ParsecT Sources RTFState m ()
-> ParsecT Sources RTFState m (Maybe Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources RTFState m Char -> ParsecT Sources RTFState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources RTFState m Char
forall (m :: * -> *). PandocMonad m => RTFParser m Char
delimChar))
ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Word8 -> TokContents
HexVal (Word8 -> TokContents)
-> ParsecT Sources RTFState m Word8
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m Word8
forall u. ParsecT Sources u m Word8
hexVal)
ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
-> ParsecT Sources RTFState m TokContents
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> TokContents
ControlSymbol (Char -> TokContents)
-> ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar) )
binData :: ParsecT Sources u m TokContents
binData = ParsecT Sources u m TokContents -> ParsecT Sources u m TokContents
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources u m TokContents
-> ParsecT Sources u m TokContents)
-> ParsecT Sources u m TokContents
-> ParsecT Sources u m TokContents
forall a b. (a -> b) -> a -> b
$ do
String -> ParsecT Sources u m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string "bin" ParsecT Sources u m String
-> ParsecT Sources u m () -> ParsecT Sources u m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources u m Char -> ParsecT Sources u m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
letter
Int
n <- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int)
-> ParsecT Sources u m (Maybe Int) -> ParsecT Sources u m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources u m (Maybe Int)
forall u. ParsecT Sources u m (Maybe Int)
parameter
ParsecT Sources u m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
ByteString
dat <- [Word8] -> ByteString
BL.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) (String -> ByteString)
-> ParsecT Sources u m String -> ParsecT Sources u m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Sources u m Char -> ParsecT Sources u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
n ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
TokContents -> ParsecT Sources u m TokContents
forall (m :: * -> *) a. Monad m => a -> m a
return (TokContents -> ParsecT Sources u m TokContents)
-> TokContents -> ParsecT Sources u m TokContents
forall a b. (a -> b) -> a -> b
$ ByteString -> TokContents
BinData ByteString
dat
parameter :: ParsecT Sources u m (Maybe Int)
parameter = do
String
hyph <- String -> ParsecT Sources u m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string "-" ParsecT Sources u m String
-> ParsecT Sources u m String -> ParsecT Sources u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Sources u m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure ""
String
rest <- ParsecT Sources u m Char -> ParsecT Sources u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
digit
let pstr :: Text
pstr = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
hyph String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
rest
Maybe Int -> ParsecT Sources u m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> ParsecT Sources u m (Maybe Int))
-> Maybe Int -> ParsecT Sources u m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
pstr
hexVal :: ParsecT Sources u m Word8
hexVal = do
Char -> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '\''
Char
x <- ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
hexDigit
Char
y <- ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
hexDigit
Word8 -> ParsecT Sources u m Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ParsecT Sources u m Word8)
-> Word8 -> ParsecT Sources u m Word8
forall a b. (a -> b) -> a -> b
$ Text -> Word8
hexToWord (String -> Text
T.pack [Char
x,Char
y])
letterSequence :: ParsecT Sources u m Text
letterSequence = String -> Text
T.pack (String -> Text)
-> ParsecT Sources u m String -> ParsecT Sources u m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources u m Char -> ParsecT Sources u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\c :: Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isLetter Char
c))
unformattedText :: ParsecT Sources RTFState m TokContents
unformattedText =
Text -> TokContents
UnformattedText (Text -> TokContents)
-> ([String] -> Text) -> [String] -> TokContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> ([String] -> String) -> [String] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> TokContents)
-> ParsecT Sources RTFState m [String]
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ParsecT Sources RTFState m String
-> ParsecT Sources RTFState m [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ( ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpecial))
ParsecT Sources RTFState m String
-> ParsecT Sources RTFState m String
-> ParsecT Sources RTFState m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ("" String
-> ParsecT Sources RTFState m ()
-> ParsecT Sources RTFState m String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl))
grouped :: ParsecT Sources RTFState m TokContents
grouped = [Tok] -> TokContents
Grouped ([Tok] -> TokContents)
-> ParsecT Sources RTFState m [Tok]
-> ParsecT Sources RTFState m TokContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '{' ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => RTFParser m ()
nl ParsecT Sources RTFState m ()
-> ParsecT Sources RTFState m [Tok]
-> ParsecT Sources RTFState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RTFParser m Tok
-> ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill RTFParser m Tok
forall (m :: * -> *). PandocMonad m => RTFParser m Tok
tok (Char -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '}'))
nl :: PandocMonad m => RTFParser m ()
nl :: RTFParser m ()
nl = ParsecT Sources RTFState m Char -> RTFParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '\n' ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m Char
-> ParsecT Sources RTFState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Sources RTFState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char '\r')
isSpecial :: Char -> Bool
isSpecial :: Char -> Bool
isSpecial '{' = Bool
True
isSpecial '}' = Bool
True
isSpecial '\\' = Bool
True
isSpecial '\n' = Bool
True
isSpecial _ = Bool
False
delimChar :: PandocMonad m => RTFParser m Char
delimChar :: RTFParser m Char
delimChar = (Char -> Bool) -> RTFParser m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\c :: Char
c -> Bool -> Bool
not (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpecial Char
c))
modifyGroup :: PandocMonad m
=> (Properties -> Properties)
-> RTFParser m ()
modifyGroup :: (Properties -> Properties) -> RTFParser m ()
modifyGroup f :: Properties -> Properties
f =
(RTFState -> RTFState) -> RTFParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> RTFParser m ())
-> (RTFState -> RTFState) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \st :: RTFState
st ->
RTFState
st{ sGroupStack :: [Properties]
sGroupStack =
case RTFState -> [Properties]
sGroupStack RTFState
st of
[] -> []
(x :: Properties
x:xs :: [Properties]
xs) -> Properties -> Properties
f Properties
x Properties -> [Properties] -> [Properties]
forall a. a -> [a] -> [a]
: [Properties]
xs }
addFormatting :: (Properties, Text) -> Inlines
addFormatting :: (Properties, Text) -> Inlines
addFormatting (_, "\n") = Inlines
B.linebreak
addFormatting (props :: Properties
props, _) | Properties -> Bool
gHidden Properties
props = Inlines
forall a. Monoid a => a
mempty
addFormatting (props :: Properties
props, _) | Just bs :: Blocks
bs <- Properties -> Maybe Blocks
gFootnote Properties
props = Blocks -> Inlines
B.note Blocks
bs
addFormatting (props :: Properties
props, txt :: Text
txt) =
(if Properties -> Bool
gBold Properties
props then Inlines -> Inlines
B.strong else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Properties -> Bool
gItalic Properties
props then Inlines -> Inlines
B.emph else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Properties -> Bool
gDeleted Properties
props then Inlines -> Inlines
B.strikeout else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Properties -> Bool
gSub Properties
props then Inlines -> Inlines
B.subscript else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Properties -> Bool
gSuper Properties
props then Inlines -> Inlines
B.superscript else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Properties -> Bool
gSmallCaps Properties
props then Inlines -> Inlines
B.smallcaps else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Properties -> Bool
gUnderline Properties
props then Inlines -> Inlines
B.underline else Inlines -> Inlines
forall a. a -> a
id) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(case Properties -> Maybe Text
gHyperlink Properties
props of
Nothing -> Inlines -> Inlines
forall a. a -> a
id
Just linkdest :: Text
linkdest -> Text -> Text -> Inlines -> Inlines
B.link Text
linkdest Text
forall a. Monoid a => a
mempty) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(case Properties -> Maybe Text
gAnchor Properties
props of
Nothing -> Inlines -> Inlines
forall a. a -> a
id
Just ident :: Text
ident -> Attr -> Inlines -> Inlines
B.spanWith (Text
ident,[],[])) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(case Properties -> Maybe FontFamily
gFontFamily Properties
props of
Just Modern -> Text -> Inlines
B.code
_ -> case Properties -> Maybe Pict
gImage Properties
props of
Just pict :: Pict
pict ->
let attr :: (Text, [a], [(Text, Text)])
attr = ("",[],
(case Pict -> Maybe Int
picWidthGoal Pict
pict of
Nothing -> []
Just w :: Int
w -> [("width", Double -> Text
forall a. Show a => a -> Text
tshow (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 1440
:: Double)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "in")]) [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
(case Pict -> Maybe Int
picHeightGoal Pict
pict of
Nothing -> []
Just h :: Int
h -> [("height", Double -> Text
forall a. Show a => a -> Text
tshow (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 1440
:: Double)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "in")]))
in Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith Attr
forall a. (Text, [a], [(Text, Text)])
attr (Pict -> Text
picName Pict
pict) "" (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
B.text
Nothing -> Text -> Inlines
B.text) (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Properties -> Bool
gCaps Properties
props then Text -> Text
T.toUpper else Text -> Text
forall a. a -> a
id)
(Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text
txt
addText :: PandocMonad m => Text -> RTFParser m ()
addText :: Text -> RTFParser m ()
addText t :: Text
t = do
[Properties]
gs <- RTFState -> [Properties]
sGroupStack (RTFState -> [Properties])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [Properties]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let props :: Properties
props = case [Properties]
gs of
(x :: Properties
x:_) -> Properties
x
_ -> Properties
forall a. Default a => a
def
(RTFState -> RTFState) -> RTFParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\s :: RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = (Properties
props, Text
t) (Properties, Text) -> [(Properties, Text)] -> [(Properties, Text)]
forall a. a -> [a] -> [a]
: RTFState -> [(Properties, Text)]
sTextContent RTFState
s })
inGroup :: PandocMonad m => RTFParser m a -> RTFParser m a
inGroup :: RTFParser m a -> RTFParser m a
inGroup p :: RTFParser m a
p = do
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \st :: RTFState
st ->
RTFState
st{ sGroupStack :: [Properties]
sGroupStack =
case RTFState -> [Properties]
sGroupStack RTFState
st of
[] -> [Properties
forall a. Default a => a
def]
(x :: Properties
x:xs :: [Properties]
xs) -> (Properties
xProperties -> [Properties] -> [Properties]
forall a. a -> [a] -> [a]
:Properties
xProperties -> [Properties] -> [Properties]
forall a. a -> [a] -> [a]
:[Properties]
xs) }
a
result <- RTFParser m a
p
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \st :: RTFState
st ->
RTFState
st{ sGroupStack :: [Properties]
sGroupStack =
case RTFState -> [Properties]
sGroupStack RTFState
st of
[] -> []
(_:xs :: [Properties]
xs) -> [Properties]
xs }
a -> RTFParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
getStyleFormatting :: PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting :: Int -> RTFParser m [Tok]
getStyleFormatting stynum :: Int
stynum = do
Stylesheet
stylesheet <- RTFState -> Stylesheet
sStylesheet (RTFState -> Stylesheet)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m Stylesheet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case Int -> Stylesheet -> Maybe Style
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
stynum Stylesheet
stylesheet of
Nothing -> [Tok] -> RTFParser m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just sty :: Style
sty ->
case Style -> Maybe Int
styleBasedOn Style
sty of
Just i :: Int
i -> ([Tok] -> [Tok] -> [Tok]
forall a. Semigroup a => a -> a -> a
<> Style -> [Tok]
styleFormatting Style
sty) ([Tok] -> [Tok]) -> RTFParser m [Tok] -> RTFParser m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> RTFParser m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
i
Nothing -> [Tok] -> RTFParser m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> RTFParser m [Tok]) -> [Tok] -> RTFParser m [Tok]
forall a b. (a -> b) -> a -> b
$ Style -> [Tok]
styleFormatting Style
sty
isMetadataField :: Text -> Bool
isMetadataField :: Text -> Bool
isMetadataField "title" = Bool
True
isMetadataField "subject" = Bool
True
isMetadataField "author" = Bool
True
isMetadataField "manager" = Bool
True
isMetadataField "company" = Bool
True
isMetadataField "operator" = Bool
True
isMetadataField "category" = Bool
True
isMetadataField "keywords" = Bool
True
isMetadataField "comment" = Bool
True
isMetadataField "doccomm" = Bool
True
isMetadataField "hlinkbase" = Bool
True
isMetadataField "generator" = Bool
True
isMetadataField _ = Bool
False
isHeaderFooter :: Text -> Bool
"header" = Bool
True
isHeaderFooter "headerl" = Bool
True
isHeaderFooter "headerr" = Bool
True
isHeaderFooter "headerf" = Bool
True
isHeaderFooter "footer" = Bool
True
isHeaderFooter "footerl" = Bool
True
isHeaderFooter "footerr" = Bool
True
isHeaderFooter "footerf" = Bool
True
isHeaderFooter _ = Bool
False
boolParam :: Maybe Int -> Bool
boolParam :: Maybe Int -> Bool
boolParam (Just 0) = Bool
False
boolParam _ = Bool
True
isUnderline :: Text -> Bool
isUnderline :: Text -> Bool
isUnderline "ul" = Bool
True
isUnderline "uld" = Bool
True
isUnderline "uldash" = Bool
True
isUnderline "uldashd" = Bool
True
isUnderline "uldashdd" = Bool
True
isUnderline "uldb" = Bool
True
isUnderline "ulth" = Bool
True
isUnderline "ulthd" = Bool
True
isUnderline "ulthdash" = Bool
True
isUnderline "ulw" = Bool
True
isUnderline "ulwave" = Bool
True
isUnderline _ = Bool
False
processTok :: PandocMonad m => Blocks -> Tok -> RTFParser m Blocks
processTok :: Blocks -> Tok -> RTFParser m Blocks
processTok bs :: Blocks
bs (Tok pos :: SourcePos
pos tok' :: TokContents
tok') = do
SourcePos -> ParsecT Sources RTFState m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
case TokContents
tok' of
HexVal{} -> () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UnformattedText{} -> () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = 0 }
case TokContents
tok' of
Grouped (Tok _ (ControlSymbol '*') : toks :: [Tok]
toks) ->
Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (do [(Properties, Text)]
oldTextContent <- RTFState -> [(Properties, Text)]
sTextContent (RTFState -> [(Properties, Text)])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [(Properties, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
forall a. Monoid a => a
mempty (SourcePos -> TokContents -> Tok
Tok SourcePos
pos ([Tok] -> TokContents
Grouped [Tok]
toks))
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \st :: RTFState
st -> RTFState
st{ sTextContent :: [(Properties, Text)]
sTextContent = [(Properties, Text)]
oldTextContent })
Grouped (Tok _ (ControlWord "fonttbl" _) : toks :: [Tok]
toks) -> RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (RTFParser m Blocks -> RTFParser m Blocks)
-> RTFParser m Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sFontTable :: FontTable
sFontTable = [Tok] -> FontTable
processFontTable [Tok]
toks }
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "field" _) : toks :: [Tok]
toks) ->
RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (RTFParser m Blocks -> RTFParser m Blocks)
-> RTFParser m Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> [Tok] -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> [Tok] -> RTFParser m Blocks
handleField Blocks
bs [Tok]
toks
Grouped (Tok _ (ControlWord "pict" _) : toks :: [Tok]
toks) ->
Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ([Tok] -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handlePict [Tok]
toks)
Grouped (Tok _ (ControlWord "stylesheet" _) : toks :: [Tok]
toks) ->
Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ([Tok] -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handleStylesheet [Tok]
toks)
Grouped (Tok _ (ControlWord "listtext" _) : _) -> do
Blocks -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks Blocks
bs
Grouped (Tok _ (ControlWord "pgdsc" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "colortbl" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "listtable" _) : toks :: [Tok]
toks) ->
Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ([Tok] -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handleListTable [Tok]
toks)
Grouped (Tok _ (ControlWord "listoverridetable" _) : toks :: [Tok]
toks) ->
Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RTFState m () -> ParsecT Sources RTFState m ()
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ([Tok] -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m ()
handleListOverrideTable [Tok]
toks)
Grouped (Tok _ (ControlWord "wgrffmtfilter" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "themedata" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "colorschememapping" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "datastore" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "latentstyles" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "pntxta" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "pntxtb" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "xmlnstbl" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "filetbl" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "expandedcolortbl" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "listtables" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "revtbl" _) : _) -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "bkmkstart" _)
: Tok _ (UnformattedText t :: Text
t) : _) -> do
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gAnchor :: Maybe Text
gAnchor = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t })
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "bkmkend" _) : _) -> do
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gAnchor :: Maybe Text
gAnchor = Maybe Text
forall a. Maybe a
Nothing })
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord f :: Text
f _) : _) | Text -> Bool
isHeaderFooter Text
f -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped (Tok _ (ControlWord "footnote" _) : toks :: [Tok]
toks) -> do
Blocks
noteBs <- RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (RTFParser m Blocks -> RTFParser m Blocks)
-> RTFParser m Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Tok] -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m Blocks
processDestinationToks [Tok]
toks
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gFootnote :: Maybe Blocks
gFootnote = Blocks -> Maybe Blocks
forall a. a -> Maybe a
Just Blocks
noteBs })
Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "*"
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gFootnote :: Maybe Blocks
gFootnote = Maybe Blocks
forall a. Maybe a
Nothing })
Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
bs
Grouped (Tok _ (ControlWord "info" _) : toks :: [Tok]
toks) ->
Blocks
bs Blocks -> RTFParser m Blocks -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ([Tok] -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => [Tok] -> RTFParser m Blocks
processDestinationToks [Tok]
toks)
Grouped (Tok _ (ControlWord f :: Text
f _) : toks :: [Tok]
toks) | Text -> Bool
isMetadataField Text
f -> RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (RTFParser m Blocks -> RTFParser m Blocks)
-> RTFParser m Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
(Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> ParsecT Sources RTFState m ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
forall a. Monoid a => a
mempty [Tok]
toks
[(Properties, Text)]
annotatedToks <- [(Properties, Text)] -> [(Properties, Text)]
forall a. [a] -> [a]
reverse ([(Properties, Text)] -> [(Properties, Text)])
-> (RTFState -> [(Properties, Text)])
-> RTFState
-> [(Properties, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTFState -> [(Properties, Text)]
sTextContent (RTFState -> [(Properties, Text)])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [(Properties, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [] }
let ils :: Inlines
ils = Inlines -> Inlines
B.trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ((Properties, Text) -> Inlines)
-> [(Properties, Text)] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Inlines
addFormatting [(Properties, Text)]
annotatedToks
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sMetadata :: [(Text, Inlines)]
sMetadata = (Text
f, Inlines
ils) (Text, Inlines) -> [(Text, Inlines)] -> [(Text, Inlines)]
forall a. a -> [a] -> [a]
: RTFState -> [(Text, Inlines)]
sMetadata RTFState
s }
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
Grouped toks :: [Tok]
toks -> RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup ((Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs [Tok]
toks)
UnformattedText t :: Text
t -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
Int
eatChars <- RTFState -> Int
sEatChars (RTFState -> Int)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case Int
eatChars of
0 -> Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
t
n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
T.length Text
t -> do
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = 0 }
Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Int -> Text -> Text
T.drop Int
n Text
t)
| Bool
otherwise -> do
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
t }
HexVal n :: Word8
n -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
Int
eatChars <- RTFState -> Int
sEatChars (RTFState -> Int)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
if Int
eatChars Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then do
CharSet
charset <- RTFState -> CharSet
sCharSet (RTFState -> CharSet)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m CharSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case CharSet
charset of
ANSI -> Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
ansiToChar Word8
n)
Mac -> Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
macToChar Word8
n)
Pc -> Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
pcToChar Word8
n)
Pca -> Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
pcaToChar Word8
n)
else (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Int
eatChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 }
ControlWord "ansi" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\s :: RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
ANSI })
ControlWord "mac" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\s :: RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
Mac })
ControlWord "pc" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\s :: RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
Pc })
ControlWord "pca" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\s :: RTFState
s -> RTFState
s{ sCharSet :: CharSet
sCharSet = CharSet
Pca })
ControlWord "outlinelevel" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gOutlineLevel :: Maybe Int
gOutlineLevel = Maybe Int
mbp })
ControlWord "ls" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gListOverride :: Maybe Int
gListOverride = Maybe Int
mbp })
ControlWord "ilvl" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gListLevel :: Maybe Int
gListLevel = Maybe Int
mbp })
ControlSymbol '\\' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\\"
ControlSymbol '{' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "{"
ControlSymbol '}' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "}"
ControlSymbol '~' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x00a0"
ControlSymbol '-' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x00ad"
ControlSymbol '_' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2011"
ControlWord "trowd" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTableRows :: [TableRow]
sTableRows = [Blocks] -> TableRow
TableRow [] TableRow -> [TableRow] -> [TableRow]
forall a. a -> [a] -> [a]
: RTFState -> [TableRow]
sTableRows RTFState
s
, sCurrentCell :: Blocks
sCurrentCell = Blocks
forall a. Monoid a => a
mempty }
ControlWord "cell" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
Blocks
new <- Blocks -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks Blocks
forall a. Monoid a => a
mempty
Blocks
curCell <- (Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
new) (Blocks -> Blocks) -> (RTFState -> Blocks) -> RTFState -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTFState -> Blocks
sCurrentCell (RTFState -> Blocks)
-> ParsecT Sources RTFState m RTFState -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTableRows :: [TableRow]
sTableRows =
case RTFState -> [TableRow]
sTableRows RTFState
s of
TableRow cs :: [Blocks]
cs : rs :: [TableRow]
rs ->
[Blocks] -> TableRow
TableRow (Blocks
curCell Blocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
: [Blocks]
cs) TableRow -> [TableRow] -> [TableRow]
forall a. a -> [a] -> [a]
: [TableRow]
rs
[] -> [[Blocks] -> TableRow
TableRow [Blocks
curCell]]
, sCurrentCell :: Blocks
sCurrentCell = Blocks
forall a. Monoid a => a
mempty }
ControlWord "intbl" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gInTable :: Bool
gInTable = Bool
True })
ControlWord "plain" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (Properties -> Properties -> Properties
forall a b. a -> b -> a
const Properties
forall a. Default a => a
def)
ControlWord "lquote" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2018"
ControlWord "rquote" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2019"
ControlWord "ldblquote" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x201C"
ControlWord "rdblquote" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x201D"
ControlWord "emdash" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2014"
ControlWord "emspace" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2003"
ControlWord "enspace" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2002"
ControlWord "endash" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2013"
ControlWord "bullet" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\x2022"
ControlWord "tab" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\t"
ControlWord "line" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\n"
ControlSymbol '\n' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\n"
ControlSymbol '\r' -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText "\n"
ControlWord "uc" (Just i :: Int
i) -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gUC :: Int
gUC = Int
i })
ControlWord "cs" (Just n :: Int
n) -> do
Int -> RTFParser m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
n RTFParser m [Tok]
-> ([Tok] -> RTFParser m Blocks) -> RTFParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
ControlWord "s" (Just n :: Int
n) -> do
Int -> RTFParser m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
n RTFParser m [Tok]
-> ([Tok] -> RTFParser m Blocks) -> RTFParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
ControlWord "ds" (Just n :: Int
n) -> do
Int -> RTFParser m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting Int
n RTFParser m [Tok]
-> ([Tok] -> RTFParser m Blocks) -> RTFParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
ControlWord "f" (Just i :: Int
i) -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
FontTable
fontTable <- RTFState -> FontTable
sFontTable (RTFState -> FontTable)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m FontTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gFontFamily :: Maybe FontFamily
gFontFamily = Int -> FontTable -> Maybe FontFamily
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i FontTable
fontTable })
ControlWord "u" (Just i :: Int
i) -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
RTFState
st <- ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let curgroup :: Properties
curgroup = case RTFState -> [Properties]
sGroupStack RTFState
st of
[] -> Properties
forall a. Default a => a
def
(x :: Properties
x:_) -> Properties
x
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sEatChars :: Int
sEatChars = Properties -> Int
gUC Properties
curgroup }
let codepoint :: Word16
codepoint :: Word16
codepoint = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
Text -> ParsecT Sources RTFState m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText (Char -> Text
T.singleton (Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
codepoint))
ControlWord "caps" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gCaps :: Bool
gCaps = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "deleted" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "b" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gBold :: Bool
gBold = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "i" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gItalic :: Bool
gItalic = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "sub" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gSub :: Bool
gSub = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "super" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gSuper :: Bool
gSuper = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "up" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gSuper :: Bool
gSuper = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "strike" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "strikedl" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "striked" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gDeleted :: Bool
gDeleted = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "scaps" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gSmallCaps :: Bool
gSmallCaps = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "v" mbp :: Maybe Int
mbp -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gHidden :: Bool
gHidden = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord x :: Text
x mbp :: Maybe Int
mbp | Text -> Bool
isUnderline Text
x -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gUnderline :: Bool
gUnderline = Maybe Int -> Bool
boolParam Maybe Int
mbp })
ControlWord "ulnone" _ -> Blocks
bs Blocks -> ParsecT Sources RTFState m () -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (\g :: Properties
g -> Properties
g{ gUnderline :: Bool
gUnderline = Bool
False })
ControlWord "pard" _ -> Blocks
bs Blocks -> RTFParser m Blocks -> RTFParser m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
(Properties -> Properties) -> ParsecT Sources RTFState m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup (Properties -> Properties -> Properties
forall a b. a -> b -> a
const Properties
forall a. Default a => a
def)
Int -> RTFParser m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m [Tok]
getStyleFormatting 0 RTFParser m [Tok]
-> ([Tok] -> RTFParser m Blocks) -> RTFParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs
ControlWord "par" _ -> Blocks -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks Blocks
bs
_ -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
processDestinationToks :: PandocMonad m => [Tok] -> RTFParser m Blocks
processDestinationToks :: [Tok] -> RTFParser m Blocks
processDestinationToks toks :: [Tok]
toks = do
[(Properties, Text)]
textContent <- RTFState -> [(Properties, Text)]
sTextContent (RTFState -> [(Properties, Text)])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [(Properties, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
[List]
liststack <- RTFState -> [List]
sListStack (RTFState -> [List])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [List]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [(Properties, Text)]
forall a. Monoid a => a
mempty
, sListStack :: [List]
sListStack = [] }
Blocks
result <- RTFParser m Blocks -> RTFParser m Blocks
forall (m :: * -> *) a.
PandocMonad m =>
RTFParser m a -> RTFParser m a
inGroup (RTFParser m Blocks -> RTFParser m Blocks)
-> RTFParser m Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$
(Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
forall a. Monoid a => a
mempty [Tok]
toks RTFParser m Blocks
-> (Blocks -> RTFParser m Blocks) -> RTFParser m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Blocks -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks
Blocks
unclosed <- RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeContainers
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [(Properties, Text)]
textContent
, sListStack :: [List]
sListStack = [List]
liststack }
Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
result Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
unclosed
closeLists :: PandocMonad m => Int -> RTFParser m Blocks
closeLists :: Int -> RTFParser m Blocks
closeLists lvl :: Int
lvl = do
[List]
lists <- RTFState -> [List]
sListStack (RTFState -> [List])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [List]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case [List]
lists of
(List _ lvl' :: Int
lvl' lt :: ListType
lt items :: [Blocks]
items : rest :: [List]
rest) | Int
lvl' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lvl -> do
let newlist :: Blocks
newlist = (case ListType
lt of
Bullet -> [Blocks] -> Blocks
B.bulletList
Ordered listAttr :: ListAttributes
listAttr -> ListAttributes -> [Blocks] -> Blocks
B.orderedListWith ListAttributes
listAttr)
([Blocks] -> [Blocks]
forall a. [a] -> [a]
reverse [Blocks]
items)
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sListStack :: [List]
sListStack = [List]
rest }
case [List]
rest of
[] -> do
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sListStack :: [List]
sListStack = [List]
rest }
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
newlist
(List lo :: Int
lo lvl'' :: Int
lvl'' lt' :: ListType
lt' [] : rest' :: [List]
rest') -> do
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sListStack :: [List]
sListStack =
Int -> Int -> ListType -> [Blocks] -> List
List Int
lo Int
lvl'' ListType
lt' [Blocks
newlist] List -> [List] -> [List]
forall a. a -> [a] -> [a]
: [List]
rest' }
Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
lvl
(List lo :: Int
lo lvl'' :: Int
lvl'' lt' :: ListType
lt' (i :: Blocks
i:is :: [Blocks]
is) : rest' :: [List]
rest') -> do
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sListStack :: [List]
sListStack =
Int -> Int -> ListType -> [Blocks] -> List
List Int
lo Int
lvl'' ListType
lt' (Blocks
i Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
newlist Blocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
: [Blocks]
is) List -> [List] -> [List]
forall a. a -> [a] -> [a]
: [List]
rest' }
Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
lvl
_ -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
closeTable :: PandocMonad m => RTFParser m Blocks
closeTable :: RTFParser m Blocks
closeTable = do
[TableRow]
rawrows <- RTFState -> [TableRow]
sTableRows (RTFState -> [TableRow])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [TableRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
if [TableRow] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TableRow]
rawrows
then Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
else do
let getCells :: TableRow -> [Blocks]
getCells (TableRow cs :: [Blocks]
cs) = [Blocks] -> [Blocks]
forall a. [a] -> [a]
reverse [Blocks]
cs
let rows :: [[Blocks]]
rows = (TableRow -> [Blocks]) -> [TableRow] -> [[Blocks]]
forall a b. (a -> b) -> [a] -> [b]
map TableRow -> [Blocks]
getCells ([TableRow] -> [[Blocks]])
-> ([TableRow] -> [TableRow]) -> [TableRow] -> [[Blocks]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TableRow] -> [TableRow]
forall a. [a] -> [a]
reverse ([TableRow] -> [[Blocks]]) -> [TableRow] -> [[Blocks]]
forall a b. (a -> b) -> a -> b
$ [TableRow]
rawrows
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sCurrentCell :: Blocks
sCurrentCell = Blocks
forall a. Monoid a => a
mempty
, sTableRows :: [TableRow]
sTableRows = [] }
Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> [[Blocks]] -> Blocks
B.simpleTable [] [[Blocks]]
rows
closeContainers :: PandocMonad m => RTFParser m Blocks
closeContainers :: RTFParser m Blocks
closeContainers = do
Blocks
tbl <- RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeTable
Blocks
lists <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists 0
Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
tbl Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
lists
trimFinalLineBreak :: Inlines -> Inlines
trimFinalLineBreak :: Inlines -> Inlines
trimFinalLineBreak ils :: Inlines
ils =
case Seq Inline -> ViewR Inline
forall a. Seq a -> ViewR a
Seq.viewr (Inlines -> Seq Inline
forall a. Many a -> Seq a
B.unMany Inlines
ils) of
rest :: Seq Inline
rest Seq.:> LineBreak -> Seq Inline -> Inlines
forall a. Seq a -> Many a
B.Many Seq Inline
rest
_ -> Inlines
ils
emitBlocks :: PandocMonad m => Blocks -> RTFParser m Blocks
emitBlocks :: Blocks -> RTFParser m Blocks
emitBlocks bs :: Blocks
bs = do
[(Properties, Text)]
annotatedToks <- [(Properties, Text)] -> [(Properties, Text)]
forall a. [a] -> [a]
reverse ([(Properties, Text)] -> [(Properties, Text)])
-> (RTFState -> [(Properties, Text)])
-> RTFState
-> [(Properties, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTFState -> [(Properties, Text)]
sTextContent (RTFState -> [(Properties, Text)])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [(Properties, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sTextContent :: [(Properties, Text)]
sTextContent = [] }
let justCode :: Properties
justCode = Properties
forall a. Default a => a
def{ gFontFamily :: Maybe FontFamily
gFontFamily = FontFamily -> Maybe FontFamily
forall a. a -> Maybe a
Just FontFamily
Modern }
let prop :: Properties
prop = case [(Properties, Text)]
annotatedToks of
[] -> Properties
forall a. Default a => a
def
((p :: Properties
p,_):_) -> Properties
p
Blocks
tbl <- if Properties -> Bool
gInTable Properties
prop Bool -> Bool -> Bool
|| [(Properties, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Properties, Text)]
annotatedToks
then Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
else RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => RTFParser m Blocks
closeTable
Blocks
new <-
case [(Properties, Text)]
annotatedToks of
[] -> Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
_ | Just lst :: Int
lst <- Properties -> Maybe Int
gListOverride Properties
prop
-> do
let level :: Int
level = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Properties -> Maybe Int
gListLevel Properties
prop
ListTable
listOverrideTable <- RTFState -> ListTable
sListOverrideTable (RTFState -> ListTable)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m ListTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let listType :: ListType
listType = ListType -> Maybe ListType -> ListType
forall a. a -> Maybe a -> a
fromMaybe ListType
Bullet (Maybe ListType -> ListType) -> Maybe ListType -> ListType
forall a b. (a -> b) -> a -> b
$
Int -> ListTable -> Maybe ListLevelTable
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
lst ListTable
listOverrideTable Maybe ListLevelTable
-> (ListLevelTable -> Maybe ListType) -> Maybe ListType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ListLevelTable -> Maybe ListType
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
level
[List]
lists <- RTFState -> [List]
sListStack (RTFState -> [List])
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m [List]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let newbs :: Blocks
newbs = Inlines -> Blocks
B.para (Inlines -> Blocks)
-> ([Inlines] -> Inlines) -> [Inlines] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
B.trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimFinalLineBreak (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Blocks) -> [Inlines] -> Blocks
forall a b. (a -> b) -> a -> b
$
((Properties, Text) -> Inlines)
-> [(Properties, Text)] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Inlines
addFormatting [(Properties, Text)]
annotatedToks
case [List]
lists of
(List lo :: Int
lo parentlevel :: Int
parentlevel _lt :: ListType
_lt items :: [Blocks]
items : cs :: [List]
cs)
| Int
lo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lst
, Int
parentlevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
level
-> do (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s ->
RTFState
s{ sListStack :: [List]
sListStack =
Int -> Int -> ListType -> [Blocks] -> List
List Int
lo Int
level ListType
listType (Blocks
newbsBlocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[Blocks]
items) List -> [List] -> [List]
forall a. a -> [a] -> [a]
: [List]
cs }
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
| Int
lo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
lst Bool -> Bool -> Bool
|| Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
parentlevel
-> do Blocks
new <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists Int
level
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s ->
RTFState
s{ sListStack :: [List]
sListStack = Int -> Int -> ListType -> [Blocks] -> List
List Int
lst Int
level ListType
listType [Blocks
newbs] List -> [List] -> [List]
forall a. a -> [a] -> [a]
:
RTFState -> [List]
sListStack RTFState
s }
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
new
_ -> do
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s ->
RTFState
s{ sListStack :: [List]
sListStack = Int -> Int -> ListType -> [Blocks] -> List
List Int
lst Int
level ListType
listType [Blocks
newbs] List -> [List] -> [List]
forall a. a -> [a] -> [a]
:
RTFState -> [List]
sListStack RTFState
s }
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
| Just lvl :: Int
lvl <- Properties -> Maybe Int
gOutlineLevel Properties
prop
-> do
Blocks
lists <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists 0
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
lists Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<>
Int -> Inlines -> Blocks
B.header (Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
(Inlines -> Inlines
B.trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ((Properties, Text) -> Inlines)
-> [(Properties, Text)] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Inlines
addFormatting
([(Properties, Text)] -> [Inlines])
-> [(Properties, Text)] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ [(Properties, Text)] -> [(Properties, Text)]
removeCommonFormatting
[(Properties, Text)]
annotatedToks)
| ((Properties, Text) -> Bool) -> [(Properties, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Properties -> Properties -> Bool
forall a. Eq a => a -> a -> Bool
== Properties
justCode) (Properties -> Bool)
-> ((Properties, Text) -> Properties) -> (Properties, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Properties, Text) -> Properties
forall a b. (a, b) -> a
fst) [(Properties, Text)]
annotatedToks
-> do
Blocks
lists <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists 0
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
lists Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<>
Text -> Blocks
B.codeBlock ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Properties, Text) -> Text) -> [(Properties, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Text
forall a b. (a, b) -> b
snd [(Properties, Text)]
annotatedToks)
| ((Properties, Text) -> Bool) -> [(Properties, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace (Text -> Bool)
-> ((Properties, Text) -> Text) -> (Properties, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Properties, Text) -> Text
forall a b. (a, b) -> b
snd) [(Properties, Text)]
annotatedToks
-> Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists 0
| Bool
otherwise -> do
Blocks
lists <- Int -> RTFParser m Blocks
forall (m :: * -> *). PandocMonad m => Int -> RTFParser m Blocks
closeLists 0
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
lists Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<>
Inlines -> Blocks
B.para (Inlines -> Inlines
B.trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimFinalLineBreak (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat
([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ((Properties, Text) -> Inlines)
-> [(Properties, Text)] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Properties, Text) -> Inlines
addFormatting [(Properties, Text)]
annotatedToks)
if Properties -> Bool
gInTable Properties
prop
then do
(RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> ParsecT Sources RTFState m ())
-> (RTFState -> RTFState) -> ParsecT Sources RTFState m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sCurrentCell :: Blocks
sCurrentCell = RTFState -> Blocks
sCurrentCell RTFState
s Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
new }
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
else do
Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> RTFParser m Blocks) -> Blocks -> RTFParser m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
bs Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
tbl Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
new
removeCommonFormatting :: [(Properties, Text)] -> [(Properties, Text)]
removeCommonFormatting :: [(Properties, Text)] -> [(Properties, Text)]
removeCommonFormatting =
(\ts :: [(Properties, Text)]
ts ->
if ((Properties, Text) -> Bool) -> [(Properties, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Properties -> Bool
gBold (Properties -> Bool)
-> ((Properties, Text) -> Properties) -> (Properties, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Properties, Text) -> Properties
forall a b. (a, b) -> a
fst) [(Properties, Text)]
ts
then ((Properties, Text) -> (Properties, Text))
-> [(Properties, Text)] -> [(Properties, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(p :: Properties
p,t :: Text
t) -> (Properties
p{ gBold :: Bool
gBold = Bool
False }, Text
t)) [(Properties, Text)]
ts
else [(Properties, Text)]
ts) ([(Properties, Text)] -> [(Properties, Text)])
-> ([(Properties, Text)] -> [(Properties, Text)])
-> [(Properties, Text)]
-> [(Properties, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\ts :: [(Properties, Text)]
ts ->
if ((Properties, Text) -> Bool) -> [(Properties, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Properties -> Bool
gItalic (Properties -> Bool)
-> ((Properties, Text) -> Properties) -> (Properties, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Properties, Text) -> Properties
forall a b. (a, b) -> a
fst) [(Properties, Text)]
ts
then ((Properties, Text) -> (Properties, Text))
-> [(Properties, Text)] -> [(Properties, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(p :: Properties
p,t :: Text
t) -> (Properties
p{ gItalic :: Bool
gItalic = Bool
False }, Text
t)) [(Properties, Text)]
ts
else [(Properties, Text)]
ts)
handleField :: PandocMonad m => Blocks -> [Tok] -> RTFParser m Blocks
handleField :: Blocks -> [Tok] -> RTFParser m Blocks
handleField bs :: Blocks
bs
(Tok _
(Grouped
(Tok _ (ControlSymbol '*')
:Tok _ (ControlWord "fldinst" Nothing)
:Tok _ (Grouped (Tok _ (UnformattedText insttext :: Text
insttext):rest :: [Tok]
rest))
:_))
:linktoks :: [Tok]
linktoks)
| Just linkdest :: Text
linkdest <- Text -> Maybe Text
getHyperlink Text
insttext
= do let linkdest' :: Text
linkdest' = case [Tok]
rest of
(Tok _ (ControlSymbol '\\')
: Tok _ (UnformattedText t :: Text
t)
: _) | Just bkmrk :: Text
bkmrk <- Text -> Text -> Maybe Text
T.stripPrefix "l" Text
t
-> "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
unquote Text
bkmrk
_ -> Text
linkdest
(Properties -> Properties) -> RTFParser m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup ((Properties -> Properties) -> RTFParser m ())
-> (Properties -> Properties) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \g :: Properties
g -> Properties
g{ gHyperlink :: Maybe Text
gHyperlink = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
linkdest' }
Blocks
result <- (Blocks -> Tok -> RTFParser m Blocks)
-> Blocks -> [Tok] -> RTFParser m Blocks
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Blocks -> Tok -> RTFParser m Blocks
forall (m :: * -> *).
PandocMonad m =>
Blocks -> Tok -> RTFParser m Blocks
processTok Blocks
bs [Tok]
linktoks
(Properties -> Properties) -> RTFParser m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup ((Properties -> Properties) -> RTFParser m ())
-> (Properties -> Properties) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \g :: Properties
g -> Properties
g{ gHyperlink :: Maybe Text
gHyperlink = Maybe Text
forall a. Maybe a
Nothing }
Blocks -> RTFParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
result
handleField bs :: Blocks
bs _ = Blocks -> RTFParser m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
bs
unquote :: Text -> Text
unquote :: Text -> Text
unquote = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='"') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='"') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip
handleListTable :: PandocMonad m => [Tok] -> RTFParser m ()
handleListTable :: [Tok] -> RTFParser m ()
handleListTable toks :: [Tok]
toks = do
(Tok -> RTFParser m ()) -> [Tok] -> RTFParser m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Tok -> RTFParser m ()
forall (m :: * -> *). PandocMonad m => Tok -> RTFParser m ()
handleList [Tok]
toks
handleList :: PandocMonad m => Tok -> RTFParser m ()
handleList :: Tok -> RTFParser m ()
handleList (Tok _ (Grouped (Tok _ (ControlWord "list" _) : toks :: [Tok]
toks))) = do
let listid :: Int
listid = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef 0 [Int
n | Tok _ (ControlWord "listid" (Just n :: Int
n)) <- [Tok]
toks]
let levels :: [[Tok]]
levels = [[Tok]
ts | Tok _ (Grouped (Tok _ (ControlWord "listlevel" _) : ts :: [Tok]
ts))
<- [Tok]
toks]
ListLevelTable
tbl <- (ListLevelTable
-> (Int, [Tok]) -> ParsecT Sources RTFState m ListLevelTable)
-> ListLevelTable
-> [(Int, [Tok])]
-> ParsecT Sources RTFState m ListLevelTable
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ListLevelTable
-> (Int, [Tok]) -> ParsecT Sources RTFState m ListLevelTable
forall (m :: * -> *).
PandocMonad m =>
ListLevelTable -> (Int, [Tok]) -> RTFParser m ListLevelTable
handleListLevel ListLevelTable
forall a. Monoid a => a
mempty ([Int] -> [[Tok]] -> [(Int, [Tok])]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [[Tok]]
levels)
(RTFState -> RTFState) -> RTFParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> RTFParser m ())
-> (RTFState -> RTFState) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sListTable :: ListTable
sListTable = Int -> ListLevelTable -> ListTable -> ListTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
listid ListLevelTable
tbl (ListTable -> ListTable) -> ListTable -> ListTable
forall a b. (a -> b) -> a -> b
$ RTFState -> ListTable
sListTable RTFState
s }
handleList _ = () -> RTFParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleListLevel :: PandocMonad m
=> ListLevelTable
-> (Int, [Tok])
-> RTFParser m ListLevelTable
handleListLevel :: ListLevelTable -> (Int, [Tok]) -> RTFParser m ListLevelTable
handleListLevel levelTable :: ListLevelTable
levelTable (lvl :: Int
lvl, toks :: [Tok]
toks) = do
let start :: Int
start = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef 1
[Int
n | Tok _ (ControlWord "levelstartat" (Just n :: Int
n)) <- [Tok]
toks]
let mbNumberStyle :: Maybe ListNumberStyle
mbNumberStyle =
case [Int
n | Tok _ (ControlWord "levelnfc" (Just n :: Int
n)) <- [Tok]
toks] of
[] -> Maybe ListNumberStyle
forall a. Maybe a
Nothing
(0:_) -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
Decimal
(1:_) -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
UpperRoman
(2:_) -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
LowerRoman
(3:_) -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
UpperAlpha
(4:_) -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
LowerAlpha
(23:_) -> Maybe ListNumberStyle
forall a. Maybe a
Nothing
(255:_) -> Maybe ListNumberStyle
forall a. Maybe a
Nothing
_ -> ListNumberStyle -> Maybe ListNumberStyle
forall a. a -> Maybe a
Just ListNumberStyle
DefaultStyle
let listType :: ListType
listType = case Maybe ListNumberStyle
mbNumberStyle of
Nothing -> ListType
Bullet
Just numStyle :: ListNumberStyle
numStyle -> ListAttributes -> ListType
Ordered (Int
start,ListNumberStyle
numStyle,ListNumberDelim
Period)
ListLevelTable -> RTFParser m ListLevelTable
forall (m :: * -> *) a. Monad m => a -> m a
return (ListLevelTable -> RTFParser m ListLevelTable)
-> ListLevelTable -> RTFParser m ListLevelTable
forall a b. (a -> b) -> a -> b
$ Int -> ListType -> ListLevelTable -> ListLevelTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
lvl ListType
listType ListLevelTable
levelTable
handleListOverrideTable :: PandocMonad m => [Tok] -> RTFParser m ()
handleListOverrideTable :: [Tok] -> RTFParser m ()
handleListOverrideTable toks :: [Tok]
toks = (Tok -> RTFParser m ()) -> [Tok] -> RTFParser m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Tok -> RTFParser m ()
forall (m :: * -> *). PandocMonad m => Tok -> RTFParser m ()
handleListOverride [Tok]
toks
handleListOverride :: PandocMonad m => Tok -> RTFParser m ()
handleListOverride :: Tok -> RTFParser m ()
handleListOverride
(Tok _ (Grouped (Tok _ (ControlWord "listoverride" _) : toks :: [Tok]
toks))) = do
let listid :: Int
listid = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef 0 [Int
n | Tok _ (ControlWord "listid" (Just n :: Int
n)) <- [Tok]
toks]
let lsn :: Int
lsn = Int -> [Int] -> Int
forall a. a -> [a] -> a
headDef 0 [Int
n | Tok _ (ControlWord "ls" (Just n :: Int
n)) <- [Tok]
toks]
ListTable
listTable <- RTFState -> ListTable
sListTable (RTFState -> ListTable)
-> ParsecT Sources RTFState m RTFState
-> ParsecT Sources RTFState m ListTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RTFState m RTFState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case Int -> ListTable -> Maybe ListLevelTable
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
listid ListTable
listTable of
Nothing -> () -> RTFParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just tbl :: ListLevelTable
tbl -> (RTFState -> RTFState) -> RTFParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> RTFParser m ())
-> (RTFState -> RTFState) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s ->
RTFState
s{ sListOverrideTable :: ListTable
sListOverrideTable = Int -> ListLevelTable -> ListTable -> ListTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
lsn ListLevelTable
tbl (ListTable -> ListTable) -> ListTable -> ListTable
forall a b. (a -> b) -> a -> b
$
RTFState -> ListTable
sListOverrideTable RTFState
s }
handleListOverride _ = () -> RTFParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleStylesheet :: PandocMonad m => [Tok] -> RTFParser m ()
handleStylesheet :: [Tok] -> RTFParser m ()
handleStylesheet toks :: [Tok]
toks = do
let styles :: [Style]
styles = (Tok -> Maybe Style) -> [Tok] -> [Style]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tok -> Maybe Style
parseStyle [Tok]
toks
(RTFState -> RTFState) -> RTFParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RTFState -> RTFState) -> RTFParser m ())
-> (RTFState -> RTFState) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \s :: RTFState
s -> RTFState
s{ sStylesheet :: Stylesheet
sStylesheet = [(Int, Style)] -> Stylesheet
forall a. [(Int, a)] -> IntMap a
IntMap.fromList
([(Int, Style)] -> Stylesheet) -> [(Int, Style)] -> Stylesheet
forall a b. (a -> b) -> a -> b
$ [Int] -> [Style] -> [(Int, Style)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Style -> Int) -> [Style] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Style -> Int
styleNum [Style]
styles) [Style]
styles }
parseStyle :: Tok -> Maybe Style
parseStyle :: Tok -> Maybe Style
parseStyle (Tok _ (Grouped toks :: [Tok]
toks)) = do
let (styType :: StyleType
styType, styNum :: Int
styNum, rest :: [Tok]
rest) =
case [Tok]
toks of
Tok _ (ControlWord "s" (Just n :: Int
n)) : ts :: [Tok]
ts -> (StyleType
ParagraphStyle, Int
n, [Tok]
ts)
Tok _ (ControlWord "ds" (Just n :: Int
n)) : ts :: [Tok]
ts -> (StyleType
SectionStyle, Int
n, [Tok]
ts)
Tok _ (ControlWord "cs" (Just n :: Int
n)) : ts :: [Tok]
ts -> (StyleType
CharStyle, Int
n, [Tok]
ts)
Tok _ (ControlWord "ts" (Just n :: Int
n)) : ts :: [Tok]
ts -> (StyleType
TableStyle, Int
n, [Tok]
ts)
_ -> (StyleType
ParagraphStyle, 0, [Tok]
toks)
let styName :: Text
styName = case [Tok] -> Maybe Tok
forall a. [a] -> Maybe a
lastMay [Tok]
rest of
Just (Tok _ (UnformattedText t :: Text
t)) -> (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==';') Text
t
_ -> Text
forall a. Monoid a => a
mempty
let isBasedOn :: Tok -> Bool
isBasedOn (Tok _ (ControlWord "sbasedon" (Just _))) = Bool
True
isBasedOn _ = Bool
False
let styBasedOn :: Maybe Int
styBasedOn = case (Tok -> Bool) -> [Tok] -> Maybe Tok
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Tok -> Bool
isBasedOn [Tok]
toks of
Just (Tok _ (ControlWord "sbasedon" (Just i :: Int
i))) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
_ -> Maybe Int
forall a. Maybe a
Nothing
let isStyleControl :: Tok -> Bool
isStyleControl (Tok _ (ControlWord x :: Text
x _)) =
Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["cs", "s", "ds", "additive", "sbasedon", "snext",
"sautoupd", "shidden", "keycode", "alt", "shift",
"ctrl", "fn"]
isStyleControl _ = Bool
False
let styFormatting :: [Tok]
styFormatting = (Tok -> Bool) -> [Tok] -> [Tok]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> Bool
isStyleControl) ([Tok] -> [Tok]
forall a. [a] -> [a]
initSafe [Tok]
rest)
Style -> Maybe Style
forall (m :: * -> *) a. Monad m => a -> m a
return (Style -> Maybe Style) -> Style -> Maybe Style
forall a b. (a -> b) -> a -> b
$ Style :: Int -> StyleType -> Maybe Int -> Text -> [Tok] -> Style
Style{ styleNum :: Int
styleNum = Int
styNum
, styleType :: StyleType
styleType = StyleType
styType
, styleBasedOn :: Maybe Int
styleBasedOn = Maybe Int
styBasedOn
, styleName :: Text
styleName = Text
styName
, styleFormatting :: [Tok]
styleFormatting = [Tok]
styFormatting
}
parseStyle _ = Maybe Style
forall a. Maybe a
Nothing
hexToWord :: Text -> Word8
hexToWord :: Text -> Word8
hexToWord t :: Text
t = case Reader Word8
forall a. Integral a => Reader a
TR.hexadecimal Text
t of
Left _ -> 0
Right (x :: Word8
x,_) -> Word8
x
handlePict :: PandocMonad m => [Tok] -> RTFParser m ()
handlePict :: [Tok] -> RTFParser m ()
handlePict toks :: [Tok]
toks = do
let pict :: Pict
pict = (Pict -> Tok -> Pict) -> Pict -> [Tok] -> Pict
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Pict -> Tok -> Pict
getPictData Pict
forall a. Default a => a
def [Tok]
toks
let altText :: Text
altText = "image"
let bytes :: ByteString
bytes =
if Pict -> Bool
picBinary Pict
pict
then Pict -> ByteString
picBytes Pict
pict
else [Word8] -> ByteString
BL.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Text -> Word8) -> [Text] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Word8
hexToWord ([Text] -> [Word8]) -> [Text] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf 2 (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Pict -> Text
picData Pict
pict
let (mimetype :: Maybe Text
mimetype, ext :: String
ext) =
case Pict -> Maybe PictType
picType Pict
pict of
Just Emfblip -> (Text -> Maybe Text
forall a. a -> Maybe a
Just "image/x-emf", ".emf")
Just Pngblip -> (Text -> Maybe Text
forall a. a -> Maybe a
Just "image/png", ".png")
Just Jpegblip -> (Text -> Maybe Text
forall a. a -> Maybe a
Just "image/jpeg", ".jpg")
Nothing -> (Maybe Text
forall a. Maybe a
Nothing, "")
case Maybe Text
mimetype of
Just mt :: Text
mt -> do
let pictname :: String
pictname = Digest SHA1State -> String
forall t. Digest t -> String
showDigest (ByteString -> Digest SHA1State
sha1 ByteString
bytes) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ext
String -> Maybe Text -> ByteString -> RTFParser m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia String
pictname (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mt) ByteString
bytes
(Properties -> Properties) -> RTFParser m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup ((Properties -> Properties) -> RTFParser m ())
-> (Properties -> Properties) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \g :: Properties
g -> Properties
g{ gImage :: Maybe Pict
gImage = Pict -> Maybe Pict
forall a. a -> Maybe a
Just Pict
pict{ picName :: Text
picName = String -> Text
T.pack String
pictname,
picBytes :: ByteString
picBytes = ByteString
bytes } }
Text -> RTFParser m ()
forall (m :: * -> *). PandocMonad m => Text -> RTFParser m ()
addText Text
altText
(Properties -> Properties) -> RTFParser m ()
forall (m :: * -> *).
PandocMonad m =>
(Properties -> Properties) -> RTFParser m ()
modifyGroup ((Properties -> Properties) -> RTFParser m ())
-> (Properties -> Properties) -> RTFParser m ()
forall a b. (a -> b) -> a -> b
$ \g :: Properties
g -> Properties
g{ gImage :: Maybe Pict
gImage = Maybe Pict
forall a. Maybe a
Nothing }
_ -> () -> RTFParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
getPictData :: Pict -> Tok -> Pict
getPictData :: Pict -> Tok -> Pict
getPictData pict :: Pict
pict (Tok _ tok' :: TokContents
tok') =
case TokContents
tok' of
ControlWord "emfblip" _-> Pict
pict{ picType :: Maybe PictType
picType = PictType -> Maybe PictType
forall a. a -> Maybe a
Just PictType
Emfblip }
ControlWord "pngblip" _-> Pict
pict{ picType :: Maybe PictType
picType = PictType -> Maybe PictType
forall a. a -> Maybe a
Just PictType
Pngblip }
ControlWord "jpegblip" _-> Pict
pict{ picType :: Maybe PictType
picType = PictType -> Maybe PictType
forall a. a -> Maybe a
Just PictType
Jpegblip }
ControlWord "picw" (Just w :: Int
w) -> Pict
pict{ picWidth :: Maybe Int
picWidth = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w }
ControlWord "pich" (Just h :: Int
h) -> Pict
pict{ picHeight :: Maybe Int
picHeight = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h }
ControlWord "picwgoal" (Just w :: Int
w) -> Pict
pict{ picWidthGoal :: Maybe Int
picWidthGoal = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w }
ControlWord "pichgoal" (Just h :: Int
h) -> Pict
pict{ picHeightGoal :: Maybe Int
picHeightGoal = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h }
BinData d :: ByteString
d | Bool -> Bool
not (ByteString -> Bool
BL.null ByteString
d)
-> Pict
pict{ picBinary :: Bool
picBinary = Bool
True, picBytes :: ByteString
picBytes = Pict -> ByteString
picBytes Pict
pict ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
d }
UnformattedText t :: Text
t -> Pict
pict{ picData :: Text
picData = Text
t }
_ -> Pict
pict
getHyperlink :: Text -> Maybe Text
getHyperlink :: Text -> Maybe Text
getHyperlink t :: Text
t =
case Text -> Text -> Maybe Text
T.stripPrefix "HYPERLINK" (Text -> Text
T.strip Text
t) of
Nothing -> Maybe Text
forall a. Maybe a
Nothing
Just rest :: Text
rest -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
unquote Text
rest
processFontTable :: [Tok] -> FontTable
processFontTable :: [Tok] -> FontTable
processFontTable = (Int, FontTable) -> FontTable
forall a b. (a, b) -> b
snd ((Int, FontTable) -> FontTable)
-> ([Tok] -> (Int, FontTable)) -> [Tok] -> FontTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, FontTable) -> Tok -> (Int, FontTable))
-> (Int, FontTable) -> [Tok] -> (Int, FontTable)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, FontTable) -> Tok -> (Int, FontTable)
go (0, FontTable
forall a. Monoid a => a
mempty)
where
go :: (Int, FontTable) -> Tok -> (Int, FontTable)
go (fontnum :: Int
fontnum, tbl :: FontTable
tbl) (Tok _ tok' :: TokContents
tok') =
case TokContents
tok' of
(ControlWord "f" (Just i :: Int
i)) -> (Int
i, FontTable
tbl)
(ControlWord "fnil" _) -> (Int
fontnum, FontTable
tbl)
(ControlWord "froman" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Roman FontTable
tbl)
(ControlWord "fswiss" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Swiss FontTable
tbl)
(ControlWord "fmodern" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Modern FontTable
tbl)
(ControlWord "fscript" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Script FontTable
tbl)
(ControlWord "fdecor" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Decor FontTable
tbl)
(ControlWord "ftech" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Tech FontTable
tbl)
(ControlWord "fbidi" _) -> (Int
fontnum, Int -> FontFamily -> FontTable -> FontTable
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
fontnum FontFamily
Bidi FontTable
tbl)
(Grouped ts :: [Tok]
ts) -> ((Int, FontTable) -> Tok -> (Int, FontTable))
-> (Int, FontTable) -> [Tok] -> (Int, FontTable)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, FontTable) -> Tok -> (Int, FontTable)
go (Int
fontnum, FontTable
tbl) [Tok]
ts
_ -> (Int
fontnum, FontTable
tbl)
ansiToChar :: Word8 -> Char
ansiToChar :: Word8 -> Char
ansiToChar i :: Word8
i = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$
case Word8
i of
128 -> 8364
130 -> 8218
131 -> 402
132 -> 8222
133 -> 8230
134 -> 8224
135 -> 8225
136 -> 710
137 -> 8240
138 -> 352
139 -> 8249
140 -> 338
142 -> 381
145 -> 8216
146 -> 8217
147 -> 8220
148 -> 8221
149 -> 8226
150 -> 8211
151 -> 8212
152 -> 732
153 -> 8482
154 -> 353
155 -> 8250
156 -> 339
158 -> 382
159 -> 376
173 -> 0xAD
_ -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i
macToChar :: Word8 -> Char
macToChar :: Word8 -> Char
macToChar i :: Word8
i = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$
case Word8
i of
0x80 -> 0xC4
0x81 -> 0xC5
0x82 -> 0xC7
0x83 -> 0xC9
0x84 -> 0xD1
0x85 -> 0xD6
0x86 -> 0xDC
0x87 -> 0xE1
0x88 -> 0xE0
0x89 -> 0xE2
0x8A -> 0xE4
0x8B -> 0xE3
0x8C -> 0xE5
0x8D -> 0xE7
0x8E -> 0xE9
0x8F -> 0xE8
0x90 -> 0xEA
0x91 -> 0xEB
0x92 -> 0xED
0x93 -> 0xEC
0x94 -> 0xEE
0x95 -> 0xEF
0x96 -> 0xF1
0x97 -> 0xF3
0x98 -> 0xF2
0x99 -> 0xF4
0x9A -> 0xF6
0x9B -> 0xF5
0x9C -> 0xFA
0x9D -> 0xF9
0x9E -> 0xFB
0x9F -> 0xFC
0xA0 -> 0xDD
0xA1 -> 0xB0
0xA2 -> 0xA2
0xA3 -> 0xA3
0xA4 -> 0xA7
0xA5 -> 0xD7
0xA6 -> 0xB6
0xA7 -> 0xDF
0xA8 -> 0xAE
0xA9 -> 0xA9
0xAA -> 0xB2
0xAB -> 0xB4
0xAC -> 0xA8
0xAD -> 0xB3
0xAE -> 0xC6
0xAF -> 0xD8
0xB0 -> 0xB9
0xB1 -> 0xB1
0xB2 -> 0xBC
0xB3 -> 0xBD
0xB4 -> 0xA5
0xB5 -> 0xB5
0xBA -> 0xBE
0xBB -> 0xAA
0xBC -> 0xBA
0xBE -> 0xE6
0xBF -> 0xF8
0xC0 -> 0xBF
0xC1 -> 0xA1
0xC2 -> 0xAC
0xC3 -> 0x0141
0xC4 -> 0x0192
0xC5 -> 0x02CB
0xC7 -> 0xAB
0xC8 -> 0xBB
0xC9 -> 0xA6
0xCA -> 0xA0
0xCB -> 0xC0
0xCC -> 0xC3
0xCD -> 0xD5
0xCE -> 0x0152
0xCF -> 0x0153
0xD0 -> 0xAD
0xD4 -> 0x0142
0xD6 -> 0xF7
0xD8 -> 0xFF
0xD9 -> 0x0178
0xDB -> 0xA4
0xDC -> 0xD0
0xDD -> 0xF0
0xDE -> 0xDE
0xDF -> 0xFE
0xE0 -> 0xFD
0xE1 -> 0xB7
0xE5 -> 0xC2
0xE6 -> 0xCA
0xE7 -> 0xC1
0xE8 -> 0xCB
0xE9 -> 0xC8
0xEA -> 0xCD
0xEB -> 0xCE
0xEC -> 0xCF
0xED -> 0xCC
0xEE -> 0xD3
0xEF -> 0xD4
0xF1 -> 0xD2
0xF2 -> 0xDA
0xF3 -> 0xDB
0xF4 -> 0xD9
0xF5 -> 0x0131
0xF6 -> 0x02C6
0xF7 -> 0x02DC
0xF8 -> 0xAF
0xF9 -> 0x02D8
0xFA -> 0x02D9
0xFB -> 0x02DA
0xFC -> 0xB8
0xFD -> 0x02DD
0xFE -> 0x02DB
0xFF -> 0x02C7
_ -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i
pcToChar :: Word8 -> Char
pcToChar :: Word8 -> Char
pcToChar i :: Word8
i = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$
case Word8
i of
0x80 -> 0xc7
0x81 -> 0xfc
0x82 -> 0xe9
0x83 -> 0xe2
0x84 -> 0xe4
0x85 -> 0xe0
0x86 -> 0xe5
0x87 -> 0xe7
0x88 -> 0xea
0x89 -> 0xeb
0x8a -> 0xe8
0x8b -> 0xef
0x8c -> 0xee
0x8d -> 0xec
0x8e -> 0xc4
0x8f -> 0xc5
0x90 -> 0xc9
0x91 -> 0xe6
0x92 -> 0xc6
0x93 -> 0xf4
0x94 -> 0xf6
0x95 -> 0xf2
0x96 -> 0xfb
0x97 -> 0xf9
0x98 -> 0xff
0x99 -> 0xd6
0x9a -> 0xdc
0x9b -> 0xa2
0x9c -> 0xa3
0x9d -> 0xa5
0x9e -> 0x20a7
0x9f -> 0x0192
0xa0 -> 0xe1
0xa1 -> 0xed
0xa2 -> 0xf3
0xa3 -> 0xfa
0xa4 -> 0xf1
0xa5 -> 0xd1
0xa6 -> 0xaa
0xa7 -> 0xba
0xa8 -> 0xbf
0xa9 -> 0x2310
0xaa -> 0xac
0xab -> 0xbd
0xac -> 0xbc
0xad -> 0xa1
0xae -> 0xab
0xaf -> 0xbb
0xb0 -> 0x2591
0xb1 -> 0x2592
0xb2 -> 0x2593
0xb3 -> 0x2502
0xb4 -> 0x2524
0xb5 -> 0x2561
0xb6 -> 0x2562
0xb7 -> 0x2556
0xb8 -> 0x2555
0xb9 -> 0x2563
0xba -> 0x2551
0xbb -> 0x2557
0xbc -> 0x255d
0xbd -> 0x255c
0xbe -> 0x255b
0xbf -> 0x2510
0xc0 -> 0x2514
0xc1 -> 0x2534
0xc2 -> 0x252c
0xc3 -> 0x251c
0xc4 -> 0x2500
0xc5 -> 0x253c
0xc6 -> 0x255e
0xc7 -> 0x255f
0xc8 -> 0x255a
0xc9 -> 0x2554
0xca -> 0x2569
0xcb -> 0x2566
0xcc -> 0x2560
0xcd -> 0x2550
0xce -> 0x256c
0xcf -> 0x2567
0xd0 -> 0x2568
0xd1 -> 0x2564
0xd2 -> 0x2565
0xd3 -> 0x2559
0xd4 -> 0x2558
0xd5 -> 0x2552
0xd6 -> 0x2553
0xd7 -> 0x256b
0xd8 -> 0x256a
0xd9 -> 0x2518
0xda -> 0x250c
0xdb -> 0x2588
0xdc -> 0x2584
0xdd -> 0x258c
0xde -> 0x2590
0xdf -> 0x2580
0xe0 -> 0x03b1
0xe1 -> 0xdf
0xe2 -> 0x0393
0xe3 -> 0x03c0
0xe4 -> 0x03a3
0xe5 -> 0x03c3
0xe6 -> 0xb5
0xe7 -> 0x03c4
0xe8 -> 0x03a6
0xe9 -> 0x0398
0xea -> 0x03a9
0xeb -> 0x03b4
0xec -> 0x221e
0xed -> 0x03c6
0xee -> 0x03b5
0xef -> 0x2229
0xf0 -> 0x2261
0xf1 -> 0xb1
0xf2 -> 0x2265
0xf3 -> 0x2264
0xf4 -> 0x2320
0xf5 -> 0x2321
0xf6 -> 0xf7
0xf7 -> 0x2248
0xf8 -> 0xb0
0xf9 -> 0x2219
0xfa -> 0xb7
0xfb -> 0x221a
0xfc -> 0x207f
0xfd -> 0xb2
0xfe -> 0x25a0
0xff -> 0xa0
_ -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i
pcaToChar :: Word8 -> Char
pcaToChar :: Word8 -> Char
pcaToChar i :: Word8
i = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$
case Word8
i of
0x80 -> 0x00c7
0x81 -> 0x00fc
0x82 -> 0x00e9
0x83 -> 0x00e2
0x84 -> 0x00e4
0x85 -> 0x00e0
0x86 -> 0x00e5
0x87 -> 0x00e7
0x88 -> 0x00ea
0x89 -> 0x00eb
0x8a -> 0x00e8
0x8b -> 0x00ef
0x8c -> 0x00ee
0x8d -> 0x00ec
0x8e -> 0x00c4
0x8f -> 0x00c5
0x90 -> 0x00c9
0x91 -> 0x00e6
0x92 -> 0x00c6
0x93 -> 0x00f4
0x94 -> 0x00f6
0x95 -> 0x00f2
0x96 -> 0x00fb
0x97 -> 0x00f9
0x98 -> 0x00ff
0x99 -> 0x00d6
0x9a -> 0x00dc
0x9b -> 0x00f8
0x9c -> 0x00a3
0x9d -> 0x00d8
0x9e -> 0x00d7
0x9f -> 0x0192
0xa0 -> 0x00e1
0xa1 -> 0x00ed
0xa2 -> 0x00f3
0xa3 -> 0x00fa
0xa4 -> 0x00f1
0xa5 -> 0x00d1
0xa6 -> 0x00aa
0xa7 -> 0x00ba
0xa8 -> 0x00bf
0xa9 -> 0x00ae
0xaa -> 0x00ac
0xab -> 0x00bd
0xac -> 0x00bc
0xad -> 0x00a1
0xae -> 0x00ab
0xaf -> 0x00bb
0xb0 -> 0x2591
0xb1 -> 0x2592
0xb2 -> 0x2593
0xb3 -> 0x2502
0xb4 -> 0x2524
0xb5 -> 0x00c1
0xb6 -> 0x00c2
0xb7 -> 0x00c0
0xb8 -> 0x00a9
0xb9 -> 0x2563
0xba -> 0x2551
0xbb -> 0x2557
0xbc -> 0x255d
0xbd -> 0x00a2
0xbe -> 0x00a5
0xbf -> 0x2510
0xc0 -> 0x2514
0xc1 -> 0x2534
0xc2 -> 0x252c
0xc3 -> 0x251c
0xc4 -> 0x2500
0xc5 -> 0x253c
0xc6 -> 0x00e3
0xc7 -> 0x00c3
0xc8 -> 0x255a
0xc9 -> 0x2554
0xca -> 0x2569
0xcb -> 0x2566
0xcc -> 0x2560
0xcd -> 0x2550
0xce -> 0x256c
0xcf -> 0x00a4
0xd0 -> 0x00f0
0xd1 -> 0x00d0
0xd2 -> 0x00ca
0xd3 -> 0x00cb
0xd4 -> 0x00c8
0xd5 -> 0x0131
0xd6 -> 0x00cd
0xd7 -> 0x00ce
0xd8 -> 0x00cf
0xd9 -> 0x2518
0xda -> 0x250c
0xdb -> 0x2588
0xdc -> 0x2584
0xdd -> 0x00a6
0xde -> 0x00cc
0xdf -> 0x2580
0xe0 -> 0x00d3
0xe1 -> 0x00df
0xe2 -> 0x00d4
0xe3 -> 0x00d2
0xe4 -> 0x00f5
0xe5 -> 0x00d5
0xe6 -> 0x00b5
0xe7 -> 0x00fe
0xe8 -> 0x00de
0xe9 -> 0x00da
0xea -> 0x00db
0xeb -> 0x00d9
0xec -> 0x00fd
0xed -> 0x00dd
0xee -> 0x00af
0xef -> 0x00b4
0xf0 -> 0x00ad
0xf1 -> 0x00b1
0xf2 -> 0x2017
0xf3 -> 0x00be
0xf4 -> 0x00b6
0xf5 -> 0x00a7
0xf6 -> 0x00f7
0xf7 -> 0x00b8
0xf8 -> 0x00b0
0xf9 -> 0x00a8
0xfa -> 0x00b7
0xfb -> 0x00b9
0xfc -> 0x00b3
0xfd -> 0x00b2
0xfe -> 0x25a0
0xff -> 0x00a0
_ -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i