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