{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings   #-}
{- |
   Module      : Text.Pandoc.Writers.RTF
   Copyright   : Copyright (C) 2006-2024 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Conversion of 'Pandoc' documents to RTF (rich text format).
-}
module Text.Pandoc.Writers.RTF ( writeRTF
                               ) where
import Control.Monad.Except (catchError, throwError)
import Control.Monad
import Control.Monad.Reader (ReaderT, runReaderT, asks)
import Control.Monad.State.Strict (State, runState, get, put)
import qualified Data.ByteString as B
import Data.Char (chr, isDigit, ord, isAlphaNum)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import qualified Text.Pandoc.Class.PandocMonad as P
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.DocLayout (render, literal)
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Printf (printf)
import Text.Read (readMaybe)
import Text.DocTemplates (lookupContext)

-- | Convert Image inlines into a raw RTF embedded image, read from a file,
-- or a MediaBag, or the internet.
-- If file not found or filetype not jpeg or png, leave the inline unchanged.
rtfEmbedImage :: PandocMonad m => WriterOptions -> Inline -> m Inline
rtfEmbedImage :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> m Inline
rtfEmbedImage WriterOptions
opts x :: Inline
x@(Image Attr
attr [Inline]
_ (Text
src,Text
_)) = m Inline -> (PandocError -> m Inline) -> m Inline
forall a. m a -> (PandocError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
  (do (ByteString, Maybe Text)
result <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
P.fetchItem Text
src
      case (ByteString, Maybe Text)
result of
           (ByteString
imgdata, Just Text
mime)
             | Text
mime' <- (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
';') Text
mime
             , Text
mime' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"image/jpeg" Bool -> Bool -> Bool
|| Text
mime' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"image/png" -> do
             let bytes :: [Text]
bytes = (Word8 -> Text) -> [Word8] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (Word8 -> String) -> Word8 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x") ([Word8] -> [Text]) -> [Word8] -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
imgdata
             Text
filetype <-
                case Text
mime' of
                     Text
"image/jpeg" -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\jpegblip"
                     Text
"image/png"  -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\pngblip"
                     Text
_            -> PandocError -> m Text
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Text) -> PandocError -> m Text
forall a b. (a -> b) -> a -> b
$
                                         Text -> PandocError
PandocShouldNeverHappenError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$
                                         Text
"Unknown file type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mime
             Text
sizeSpec <-
                case WriterOptions -> ByteString -> Either Text ImageSize
imageSize WriterOptions
opts ByteString
imgdata of
                     Left Text
msg -> do
                       LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotDetermineImageSize Text
src Text
msg
                       Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
                     Right ImageSize
sz -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text
"\\picw" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow Integer
xpx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                Text
"\\pich" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow Integer
ypx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                Text
"\\picwgoal" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
xpt Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
20) :: Integer)
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\pichgoal" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
ypt Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
20) :: Integer)
                        -- twip = 1/1440in = 1/20pt
                        where (Integer
xpx, Integer
ypx) = ImageSize -> (Integer, Integer)
sizeInPixels ImageSize
sz
                              (Double
xpt, Double
ypt) = WriterOptions -> Attr -> ImageSize -> (Double, Double)
desiredSizeInPoints WriterOptions
opts Attr
attr ImageSize
sz
             let raw :: Text
raw = Text
"{\\pict" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filetype Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sizeSpec Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                        [Text] -> Text
T.concat [Text]
bytes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
             if ByteString -> Bool
B.null ByteString
imgdata
                then do
                  LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
src Text
"image contained no data"
                  Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
                else Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"rtf") Text
raw
             | Bool
otherwise -> do
               LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
src Text
"image is not a jpeg or png"
               Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
           (ByteString
_, Maybe Text
Nothing) -> do
             LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotDetermineMimeType Text
src
             Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x)
  (\PandocError
e -> do
     LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
src (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ PandocError -> Text
forall a. Show a => a -> Text
tshow PandocError
e
     Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x)
rtfEmbedImage WriterOptions
_ Inline
x = Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x

-- | Configuration for the RTF writer.
newtype WriterConfig = WriterConfig
  { WriterConfig -> Int
fontSize :: Int  -- ^ base font size in half points
  }

defaultWriterConfig :: WriterConfig
defaultWriterConfig :: WriterConfig
defaultWriterConfig = WriterConfig { fontSize :: Int
fontSize = Int
12 }

-- | Convert Pandoc to a string in rich text format.
writeRTF :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeRTF :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeRTF WriterOptions
options Pandoc
doc = do
  -- handle images
  Pandoc meta :: Meta
meta@(Meta Map Text MetaValue
metamap) [Block]
blocks <- (Inline -> m Inline) -> Pandoc -> m Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> Pandoc -> m Pandoc
walkM (WriterOptions -> Inline -> m Inline
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> m Inline
rtfEmbedImage WriterOptions
options) Pandoc
doc
  let spacer :: Bool
spacer = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ([Inline] -> Bool) -> [[Inline]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[Inline]] -> Bool) -> [[Inline]] -> Bool
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta [Inline] -> [[Inline]] -> [[Inline]]
forall a. a -> [a] -> [a]
: Meta -> [Inline]
docDate Meta
meta [Inline] -> [[Inline]] -> [[Inline]]
forall a. a -> [a] -> [a]
: Meta -> [[Inline]]
docAuthors Meta
meta
  let toPlain :: MetaValue -> MetaValue
toPlain (MetaBlocks [Para [Inline]
ils]) = [Inline] -> MetaValue
MetaInlines [Inline]
ils
      toPlain MetaValue
x                       = MetaValue
x
  -- adjust title, author, date so we don't get para inside para
  let meta' :: Meta
meta'  = Map Text MetaValue -> Meta
Meta (Map Text MetaValue -> Meta) -> Map Text MetaValue -> Meta
forall a b. (a -> b) -> a -> b
$ (MetaValue -> MetaValue)
-> Text -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust MetaValue -> MetaValue
toPlain Text
"title"
                    (Map Text MetaValue -> Map Text MetaValue)
-> (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetaValue -> MetaValue)
-> Text -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust MetaValue -> MetaValue
toPlain Text
"author"
                    (Map Text MetaValue -> Map Text MetaValue)
-> (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue
-> Map Text MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetaValue -> MetaValue)
-> Text -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust MetaValue -> MetaValue
toPlain Text
"date"
                    (Map Text MetaValue -> Map Text MetaValue)
-> Map Text MetaValue -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$ Map Text MetaValue
metamap
  Context Text
metadata <- WriterOptions
-> ([Block] -> m (Doc Text))
-> ([Inline] -> m (Doc Text))
-> Meta
-> m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
options
              (([Text] -> Doc Text) -> m [Text] -> m (Doc Text)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> ([Text] -> Text) -> [Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat) (m [Text] -> m (Doc Text))
-> ([Block] -> m [Text]) -> [Block] -> m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (ReaderT WriterConfig m [Text] -> WriterConfig -> m [Text])
-> WriterConfig -> ReaderT WriterConfig m [Text] -> m [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT WriterConfig m [Text] -> WriterConfig -> m [Text]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT WriterConfig
defaultWriterConfig (ReaderT WriterConfig m [Text] -> m [Text])
-> ([Block] -> ReaderT WriterConfig m [Text])
-> [Block]
-> m [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (Block -> ReaderT WriterConfig m Text)
-> [Block] -> ReaderT WriterConfig m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Alignment -> Block -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> ReaderT WriterConfig m Text
blockToRTF Int
0 Alignment
AlignDefault))
              ((Text -> Doc Text) -> m Text -> m (Doc Text)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (m Text -> m (Doc Text))
-> ([Inline] -> m Text) -> [Inline] -> m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT WriterConfig m Text -> WriterConfig -> m Text)
-> WriterConfig -> ReaderT WriterConfig m Text -> m Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT WriterConfig m Text -> WriterConfig -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT WriterConfig
defaultWriterConfig (ReaderT WriterConfig m Text -> m Text)
-> ([Inline] -> ReaderT WriterConfig m Text) -> [Inline] -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF)
              Meta
meta'
  let config :: WriterConfig
config = WriterConfig
defaultWriterConfig{
                   fontSize = maybe 24 (floor . (* (2.0 :: Double)))
                               $ lookupContext "fontsize" metadata >>=
                                 T.stripSuffix "pt" >>= readMaybe . T.unpack }
  -- Tag list blocks with a list id and level so that the rendered RTF
  -- carries proper \ls/\ilvl references and a \listtable, which lets
  -- lists (including multi-paragraph list items) round-trip.
  let ([Block]
blocks', [ListInfo]
listDefs) = [Block] -> ([Block], [ListInfo])
prepareLists [Block]
blocks
  Text
body <- ReaderT WriterConfig m Text -> WriterConfig -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
blocksToRTF Int
0 Alignment
AlignDefault [Block]
blocks') WriterConfig
config
  Text
toc <- ReaderT WriterConfig m Text -> WriterConfig -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
blocksToRTF Int
0 Alignment
AlignDefault [WriterOptions -> [Block] -> Block
toTableOfContents WriterOptions
options [Block]
blocks])
           WriterConfig
config
  let context :: Context Text
context = Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Text
body
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (Context Text -> Context Text)
-> (Text -> Context Text -> Context Text)
-> Maybe Text
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"listtable") ([ListInfo] -> Maybe Text
listTableRTF [ListInfo]
listDefs)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"spacer" Bool
spacer
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (if WriterOptions -> Bool
writerTableOfContents WriterOptions
options
                    then Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"table-of-contents" Text
toc
                         -- for backwards compatibility,
                         -- we populate toc with the contents
                         -- of the toc rather than a boolean:
                         (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" Text
toc
                    else Context Text -> Context Text
forall a. a -> a
id) Context Text
metadata
  Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
options of
       Just Template Text
tpl -> Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
       Maybe (Template Text)
Nothing  -> case Text -> Maybe (Text, Char)
T.unsnoc Text
body of
                        Just (Text
_,Char
'\n') -> Text
body
                        Maybe (Text, Char)
_             -> Text
body Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
'\n'

-- | Information about a list needed to build the RTF list table:
-- a unique id (used both as @\\listid@ and @\\ls@), the list level
-- (@\\ilvl@) at which the list occurs, and its kind (bullet, or ordered
-- with the given attributes).
data ListInfo = ListInfo Int Int (Either () ListAttributes)

-- | Walk the document and tag every list with a unique id and its
-- nesting level, returning the tagged blocks together with the
-- information needed to build the list table.  Tagged lists are wrapped
-- in a @Div@ with the @__rtflist@ class and @ls@/@lvl@ attributes,
-- which 'blockToRTF' recognizes.
prepareLists :: [Block] -> ([Block], [ListInfo])
prepareLists :: [Block] -> ([Block], [ListInfo])
prepareLists [Block]
bs =
  let ([Block]
bs', (Int
_, [ListInfo]
defs)) = State (Int, [ListInfo]) [Block]
-> (Int, [ListInfo]) -> ([Block], (Int, [ListInfo]))
forall s a. State s a -> s -> (a, s)
runState ((Block -> StateT (Int, [ListInfo]) Identity Block)
-> [Block] -> State (Int, [ListInfo]) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Block -> StateT (Int, [ListInfo]) Identity Block
goBlock Int
0) [Block]
bs) (Int
1, [])
  in  ([Block]
bs', [ListInfo] -> [ListInfo]
forall a. [a] -> [a]
reverse [ListInfo]
defs)
 where
  tag :: Int -> Either () ListAttributes -> [[Block]]
      -> ([[Block]] -> Block) -> State (Int, [ListInfo]) Block
  tag :: Int
-> Either () ListAttributes
-> [[Block]]
-> ([[Block]] -> Block)
-> StateT (Int, [ListInfo]) Identity Block
tag Int
level Either () ListAttributes
kind [[Block]]
items [[Block]] -> Block
ctor = do
    (Int
n, [ListInfo]
defs) <- StateT (Int, [ListInfo]) Identity (Int, [ListInfo])
forall s (m :: * -> *). MonadState s m => m s
get
    (Int, [ListInfo]) -> StateT (Int, [ListInfo]) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int -> Int -> Either () ListAttributes -> ListInfo
ListInfo Int
n Int
level Either () ListAttributes
kind ListInfo -> [ListInfo] -> [ListInfo]
forall a. a -> [a] -> [a]
: [ListInfo]
defs)
    [[Block]]
items' <- ([Block] -> State (Int, [ListInfo]) [Block])
-> [[Block]] -> StateT (Int, [ListInfo]) Identity [[Block]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Block -> StateT (Int, [ListInfo]) Identity Block)
-> [Block] -> State (Int, [ListInfo]) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Block -> StateT (Int, [ListInfo]) Identity Block
goBlock (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))) [[Block]]
items
    Block -> StateT (Int, [ListInfo]) Identity Block
forall a. a -> StateT (Int, [ListInfo]) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> StateT (Int, [ListInfo]) Identity Block)
-> Block -> StateT (Int, [ListInfo]) Identity Block
forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
Div (Text
"", [Text
"__rtflist"], [(Text
"ls", Int -> Text
forall a. Show a => a -> Text
tshow Int
n), (Text
"lvl", Int -> Text
forall a. Show a => a -> Text
tshow Int
level)])
                 [[[Block]] -> Block
ctor [[Block]]
items']
  goBlock :: Int -> Block -> State (Int, [ListInfo]) Block
  goBlock :: Int -> Block -> StateT (Int, [ListInfo]) Identity Block
goBlock Int
level (BulletList [[Block]]
items) = Int
-> Either () ListAttributes
-> [[Block]]
-> ([[Block]] -> Block)
-> StateT (Int, [ListInfo]) Identity Block
tag Int
level (() -> Either () ListAttributes
forall a b. a -> Either a b
Left ()) [[Block]]
items [[Block]] -> Block
BulletList
  goBlock Int
level (OrderedList ListAttributes
attrs [[Block]]
items) =
    Int
-> Either () ListAttributes
-> [[Block]]
-> ([[Block]] -> Block)
-> StateT (Int, [ListInfo]) Identity Block
tag Int
level (ListAttributes -> Either () ListAttributes
forall a b. b -> Either a b
Right ListAttributes
attrs) [[Block]]
items (ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
attrs)
  goBlock Int
level (BlockQuote [Block]
bs') = [Block] -> Block
BlockQuote ([Block] -> Block)
-> State (Int, [ListInfo]) [Block]
-> StateT (Int, [ListInfo]) Identity Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT (Int, [ListInfo]) Identity Block)
-> [Block] -> State (Int, [ListInfo]) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Block -> StateT (Int, [ListInfo]) Identity Block
goBlock Int
level) [Block]
bs'
  goBlock Int
level (Div Attr
attr [Block]
bs') = Attr -> [Block] -> Block
Div Attr
attr ([Block] -> Block)
-> State (Int, [ListInfo]) [Block]
-> StateT (Int, [ListInfo]) Identity Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT (Int, [ListInfo]) Identity Block)
-> [Block] -> State (Int, [ListInfo]) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Block -> StateT (Int, [ListInfo]) Identity Block
goBlock Int
level) [Block]
bs'
  goBlock Int
level (Figure Attr
attr Caption
capt [Block]
bs') =
    Attr -> Caption -> [Block] -> Block
Figure Attr
attr Caption
capt ([Block] -> Block)
-> State (Int, [ListInfo]) [Block]
-> StateT (Int, [ListInfo]) Identity Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT (Int, [ListInfo]) Identity Block)
-> [Block] -> State (Int, [ListInfo]) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Block -> StateT (Int, [ListInfo]) Identity Block
goBlock Int
level) [Block]
bs'
  goBlock Int
_ Block
b = Block -> StateT (Int, [ListInfo]) Identity Block
forall a. a -> StateT (Int, [ListInfo]) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Block
b

-- | RTF @\\levelnfc@ number-format code for an ordered-list style.
listNfc :: ListNumberStyle -> Int
listNfc :: ListNumberStyle -> Int
listNfc ListNumberStyle
UpperRoman = Int
1
listNfc ListNumberStyle
LowerRoman = Int
2
listNfc ListNumberStyle
UpperAlpha = Int
3
listNfc ListNumberStyle
LowerAlpha = Int
4
listNfc ListNumberStyle
_          = Int
0 -- Decimal, DefaultStyle, Example

-- | Build the @\\listtable@ and @\\listoverridetable@ for the collected
-- lists, or 'Nothing' if the document contains no lists.
listTableRTF :: [ListInfo] -> Maybe Text
listTableRTF :: [ListInfo] -> Maybe Text
listTableRTF [] = Maybe Text
forall a. Maybe a
Nothing
listTableRTF [ListInfo]
infos = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
  Text
"{\\*\\listtable" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat ((ListInfo -> Text) -> [ListInfo] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ListInfo -> Text
listEntry [ListInfo]
infos) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
  Text
"{\\*\\listoverridetable" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat ((ListInfo -> Text) -> [ListInfo] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ListInfo -> Text
overrideEntry [ListInfo]
infos) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}\n"
 where
  listEntry :: ListInfo -> Text
listEntry (ListInfo Int
lid Int
level Either () ListAttributes
kind) =
    Text
"{\\list\\listtemplateid" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
lid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    [Text] -> Text
T.concat [ Int -> Either () ListAttributes -> Text
forall {a} {c}.
(Show a, Num a) =>
a -> Either () (Int, ListNumberStyle, c) -> Text
levelEntry Int
i Either () ListAttributes
kind | Int
i <- [Int
0..Int
level] ] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    Text
"{\\listname ;}\\listid" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
lid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}\n"
  levelEntry :: a -> Either () (Int, ListNumberStyle, c) -> Text
levelEntry a
i Either () (Int, ListNumberStyle, c)
kind =
    let (Int
nfc, Int
start) = case Either () (Int, ListNumberStyle, c)
kind of
                         Left ()           -> (Int
23 :: Int, Int
1 :: Int)
                         Right (Int
s, ListNumberStyle
sty, c
_) -> (ListNumberStyle -> Int
listNfc ListNumberStyle
sty, Int
s)
        li :: a
li = (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> a -> a
forall a. Num a => a -> a -> a
* a
360
    in Text
"{\\listlevel\\levelnfc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
nfc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\levelnfcn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
nfc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       Text
"\\leveljc0\\leveljcn0\\levelfollow0\\levelstartat" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       Text
"\\levelindent0{\\leveltext\\'01\\u8226 ?;}{\\levelnumbers;}\\fi-360\\li" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
       a -> Text
forall a. Show a => a -> Text
tshow a
li Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\lin" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
li Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" }"
  overrideEntry :: ListInfo -> Text
overrideEntry (ListInfo Int
lid Int
_ Either () ListAttributes
_) =
    Text
"{\\listoverride\\listid" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
lid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    Text
"\\listoverridecount0\\ls" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
lid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

-- | Convert unicode characters (> 127) into rich text format representation.
handleUnicode :: Text -> Text
handleUnicode :: Text -> Text
handleUnicode = (Char -> Text) -> Text -> Text
T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
c ->
  if Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
127
     then if Char -> Bool
surrogate Char
c
          then let x :: Int
x = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
                   (Int
q, Int
r) = Int
x Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
0x400
                   upper :: Int
upper = Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xd800
                   lower :: Int
lower = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xDC00
               in Char -> Text
enc (Int -> Char
chr Int
upper) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
enc (Int -> Char
chr Int
lower)
          else Char -> Text
enc Char
c
     else Char -> Text
T.singleton Char
c
  where
    surrogate :: Char -> Bool
surrogate Char
x = Bool -> Bool
not (   (Int
0x0000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Int
ord Char
x Bool -> Bool -> Bool
&& Char -> Int
ord Char
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xd7ff)
                       Bool -> Bool -> Bool
|| (Int
0xe000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Int
ord Char
x Bool -> Bool -> Bool
&& Char -> Int
ord Char
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff) )
    enc :: Char -> Text
enc Char
x = Text
"\\u" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Char -> Int
ord Char
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ?"

-- | Escape special characters.
escapeSpecial :: Text -> Text
escapeSpecial :: Text -> Text
escapeSpecial Text
t
  | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlphaNum Text
t = Text
t
  | Bool
otherwise          = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escChar Text
t
 where
  escChar :: Char -> Text
escChar Char
'\t' = Text
"\\tab "
  escChar Char
'\8216' = Text
"\\u8216'"
  escChar Char
'\8217' = Text
"\\u8217'"
  escChar Char
'\8220' = Text
"\\u8220\""
  escChar Char
'\8221' = Text
"\\u8221\""
  escChar Char
'\8211' = Text
"\\u8211-"
  escChar Char
'\8212' = Text
"\\u8212-"
  escChar Char
'{'     = Text
"\\{"
  escChar Char
'}'     = Text
"\\}"
  escChar Char
'\\'    = Text
"\\\\"
  escChar Char
c       = Char -> Text
T.singleton Char
c

-- | Escape strings as needed for rich text format.
stringToRTF :: Text -> Text
stringToRTF :: Text -> Text
stringToRTF = Text -> Text
handleUnicode (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeSpecial

-- | Escape things as needed for code block in RTF.
codeStringToRTF :: Text -> Text
codeStringToRTF :: Text -> Text
codeStringToRTF Text
str = Text -> [Text] -> Text
T.intercalate Text
"\\line\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines (Text -> Text
stringToRTF Text
str)

-- | Make a paragraph with first-line indent, block indent, and space after.
rtfParSpaced :: PandocMonad m
             => Int       -- ^ space after (in twips)
             -> Int       -- ^ block indent (in twips)
             -> Int       -- ^ first line indent (relative to block) (in twips)
             -> Alignment -- ^ alignment
             -> Text    -- ^ string with content
             -> ReaderT WriterConfig m Text
rtfParSpaced :: forall (m :: * -> *).
PandocMonad m =>
Int
-> Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfParSpaced Int
spaceAfter Int
indent Int
firstLineIndent Alignment
alignment Text
content = do
  Int
fontsize <- (WriterConfig -> Int) -> ReaderT WriterConfig m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterConfig -> Int
fontSize
  let alignString :: Text
alignString = case Alignment
alignment of
                           Alignment
AlignLeft    -> Text
"\\ql "
                           Alignment
AlignRight   -> Text
"\\qr "
                           Alignment
AlignCenter  -> Text
"\\qc "
                           Alignment
AlignDefault -> Text
"\\ql "
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\pard " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
alignString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
"\\f0 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
renderFontSize Int
fontsize Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
" \\sa" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
spaceAfter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \\li" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
indent) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      Text
" \\fi" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
firstLineIndent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
content Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\par}\n"

-- | Default paragraph.
rtfPar :: PandocMonad m
       => Int       -- ^ block indent (in twips)
       -> Int       -- ^ first line indent (relative to block) (in twips)
       -> Alignment -- ^ alignment
       -> Text    -- ^ string with content
       -> ReaderT WriterConfig m Text
rtfPar :: forall (m :: * -> *).
PandocMonad m =>
Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfPar = Int
-> Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int
-> Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfParSpaced Int
180

-- | Compact paragraph (e.g. for compact list items).
rtfCompact :: PandocMonad m
           => Int       -- ^ block indent (in twips)
           -> Int       -- ^ first line indent (relative to block) (in twips)
           -> Alignment -- ^ alignment
           -> Text    -- ^ string with content
           -> ReaderT WriterConfig m Text
rtfCompact :: forall (m :: * -> *).
PandocMonad m =>
Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfCompact = Int
-> Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int
-> Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfParSpaced Int
0

-- number of twips to indent
indentIncrement :: Int
indentIncrement :: Int
indentIncrement = Int
720

listIncrement :: Int
listIncrement :: Int
listIncrement = Int
360

-- | Returns appropriate bullet list marker for indent level.
bulletMarker :: Int -> Text
bulletMarker :: Int -> Text
bulletMarker Int
indent = case Int
indent Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
720 of
                             Int
0 -> Text
"\\bullet "
                             Int
_ -> Text
"\\endash "

-- | Returns appropriate (list of) ordered list markers for indent level.
orderedMarkers :: Int -> ListAttributes -> [Text]
orderedMarkers :: Int -> ListAttributes -> [Text]
orderedMarkers Int
indent (Int
start, ListNumberStyle
style, ListNumberDelim
delim) =
  if ListNumberStyle
style ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
DefaultStyle Bool -> Bool -> Bool
&& ListNumberDelim
delim ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
DefaultDelim
     then case Int
indent Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
720 of
              Int
0 -> ListAttributes -> [Text]
orderedListMarkers (Int
start, ListNumberStyle
Decimal, ListNumberDelim
Period)
              Int
_ -> ListAttributes -> [Text]
orderedListMarkers (Int
start, ListNumberStyle
LowerAlpha, ListNumberDelim
Period)
     else ListAttributes -> [Text]
orderedListMarkers (Int
start, ListNumberStyle
style, ListNumberDelim
delim)

blocksToRTF :: PandocMonad m
            => Int
            -> Alignment
            -> [Block]
            -> ReaderT WriterConfig m Text
blocksToRTF :: forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
blocksToRTF Int
indent Alignment
align = ([Text] -> Text)
-> ReaderT WriterConfig m [Text] -> ReaderT WriterConfig m Text
forall a b.
(a -> b) -> ReaderT WriterConfig m a -> ReaderT WriterConfig m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
T.concat (ReaderT WriterConfig m [Text] -> ReaderT WriterConfig m Text)
-> ([Block] -> ReaderT WriterConfig m [Text])
-> [Block]
-> ReaderT WriterConfig m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> ReaderT WriterConfig m Text)
-> [Block] -> ReaderT WriterConfig m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Alignment -> Block -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> ReaderT WriterConfig m Text
blockToRTF Int
indent Alignment
align)

-- | Convert Pandoc block element to RTF.
blockToRTF :: PandocMonad m
           => Int       -- ^ indent level
           -> Alignment -- ^ alignment
           -> Block     -- ^ block to convert
           -> ReaderT WriterConfig m Text
blockToRTF :: forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> ReaderT WriterConfig m Text
blockToRTF Int
indent Alignment
alignment (Div (Text
_, [Text]
classes, [(Text, Text)]
kvs) [Block
blk])
  | Text
"__rtflist" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  , Just Int
ls <- Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"ls" [(Text, Text)]
kvs Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
readInt
  , Just Int
level <- Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lvl" [(Text, Text)]
kvs Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
readInt =
  case Block
blk of
    BulletList [[Block]]
lst -> Text -> Text
spaceAtEnd (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text)
-> ReaderT WriterConfig m [Text] -> ReaderT WriterConfig m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ([Block] -> ReaderT WriterConfig m Text)
-> [[Block]] -> ReaderT WriterConfig m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Alignment
-> Int
-> Maybe (Int, Int)
-> Text
-> [Block]
-> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Alignment
-> Int
-> Maybe (Int, Int)
-> Text
-> [Block]
-> ReaderT WriterConfig m Text
listItemToRTF Alignment
alignment Int
indent ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
ls, Int
level))
              (Int -> Text
bulletMarker Int
indent)) [[Block]]
lst
    OrderedList ListAttributes
attribs [[Block]]
lst -> Text -> Text
spaceAtEnd (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text)
-> ReaderT WriterConfig m [Text] -> ReaderT WriterConfig m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (Text -> [Block] -> ReaderT WriterConfig m Text)
-> [Text] -> [[Block]] -> ReaderT WriterConfig m [Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Alignment
-> Int
-> Maybe (Int, Int)
-> Text
-> [Block]
-> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Alignment
-> Int
-> Maybe (Int, Int)
-> Text
-> [Block]
-> ReaderT WriterConfig m Text
listItemToRTF Alignment
alignment Int
indent ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
ls, Int
level)))
               (Int -> ListAttributes -> [Text]
orderedMarkers Int
indent ListAttributes
attribs) [[Block]]
lst
    Block
_ -> Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
blocksToRTF Int
indent Alignment
alignment [Block
blk]
blockToRTF Int
indent Alignment
alignment (Div Attr
_ [Block]
bs) =
  Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
blocksToRTF Int
indent Alignment
alignment [Block]
bs
blockToRTF Int
indent Alignment
alignment (Plain [Inline]
lst) =
  [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst ReaderT WriterConfig m Text
-> (Text -> ReaderT WriterConfig m Text)
-> ReaderT WriterConfig m Text
forall a b.
ReaderT WriterConfig m a
-> (a -> ReaderT WriterConfig m b) -> ReaderT WriterConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfCompact Int
indent Int
0 Alignment
alignment
blockToRTF Int
indent Alignment
alignment (Para [Inline]
lst) =
  [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst ReaderT WriterConfig m Text
-> (Text -> ReaderT WriterConfig m Text)
-> ReaderT WriterConfig m Text
forall a b.
ReaderT WriterConfig m a
-> (a -> ReaderT WriterConfig m b) -> ReaderT WriterConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfPar Int
indent Int
0 Alignment
alignment
blockToRTF Int
indent Alignment
alignment (LineBlock [[Inline]]
lns) =
  Int -> Alignment -> Block -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> ReaderT WriterConfig m Text
blockToRTF Int
indent Alignment
alignment (Block -> ReaderT WriterConfig m Text)
-> Block -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToRTF Int
indent Alignment
alignment (BlockQuote [Block]
lst) =
  Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
blocksToRTF (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentIncrement) Alignment
alignment [Block]
lst
blockToRTF Int
indent Alignment
_ (CodeBlock Attr
_ Text
str) = do
  Int
fontsize <- (WriterConfig -> Int) -> ReaderT WriterConfig m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterConfig -> Int
fontSize
  Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfPar Int
indent Int
0 Alignment
AlignLeft
         (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"\\f1 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
renderFontSize Int
fontsize Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
codeStringToRTF Text
str
blockToRTF Int
_ Alignment
_ b :: Block
b@(RawBlock Format
f Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"rtf" = Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
  | Bool
otherwise         = do
      LogMessage -> ReaderT WriterConfig m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT WriterConfig m ())
-> LogMessage -> ReaderT WriterConfig m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
blockToRTF Int
indent Alignment
alignment (BulletList [[Block]]
lst) = Text -> Text
spaceAtEnd (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text)
-> ReaderT WriterConfig m [Text] -> ReaderT WriterConfig m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ([Block] -> ReaderT WriterConfig m Text)
-> [[Block]] -> ReaderT WriterConfig m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Alignment
-> Int
-> Maybe (Int, Int)
-> Text
-> [Block]
-> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Alignment
-> Int
-> Maybe (Int, Int)
-> Text
-> [Block]
-> ReaderT WriterConfig m Text
listItemToRTF Alignment
alignment Int
indent Maybe (Int, Int)
forall a. Maybe a
Nothing (Int -> Text
bulletMarker Int
indent)) [[Block]]
lst
blockToRTF Int
indent Alignment
alignment (OrderedList ListAttributes
attribs [[Block]]
lst) =
  Text -> Text
spaceAtEnd (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text)
-> ReaderT WriterConfig m [Text] -> ReaderT WriterConfig m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
   (Text -> [Block] -> ReaderT WriterConfig m Text)
-> [Text] -> [[Block]] -> ReaderT WriterConfig m [Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Alignment
-> Int
-> Maybe (Int, Int)
-> Text
-> [Block]
-> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Alignment
-> Int
-> Maybe (Int, Int)
-> Text
-> [Block]
-> ReaderT WriterConfig m Text
listItemToRTF Alignment
alignment Int
indent Maybe (Int, Int)
forall a. Maybe a
Nothing)
            (Int -> ListAttributes -> [Text]
orderedMarkers Int
indent ListAttributes
attribs) [[Block]]
lst
blockToRTF Int
indent Alignment
alignment (DefinitionList [([Inline], [[Block]])]
lst) = Text -> Text
spaceAtEnd (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text)
-> ReaderT WriterConfig m [Text] -> ReaderT WriterConfig m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (([Inline], [[Block]]) -> ReaderT WriterConfig m Text)
-> [([Inline], [[Block]])] -> ReaderT WriterConfig m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Alignment
-> Int -> ([Inline], [[Block]]) -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Alignment
-> Int -> ([Inline], [[Block]]) -> ReaderT WriterConfig m Text
definitionListItemToRTF Alignment
alignment Int
indent) [([Inline], [[Block]])]
lst
blockToRTF Int
indent Alignment
_ Block
HorizontalRule =
  Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfPar Int
indent Int
0 Alignment
AlignCenter Text
"\\emdash\\emdash\\emdash\\emdash\\emdash"
blockToRTF Int
indent Alignment
alignment (Header Int
level Attr
_ [Inline]
lst) = do
  Text
contents <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
  Int
fontsize <- (WriterConfig -> Int) -> ReaderT WriterConfig m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterConfig -> Int
fontSize
  Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfPar Int
indent Int
0 Alignment
alignment (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$
             Text
"\\outlinelevel" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
             Text
" \\b " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
renderFontSize (Int
fontsize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
level) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
             Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
blockToRTF Int
indent Alignment
alignment (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
  let ([Inline]
caption, [Alignment]
aligns, [Double]
sizes, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
  Text
caption' <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
caption
  Text
header' <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
                then Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
                else Bool
-> Int
-> [Alignment]
-> [Double]
-> [[Block]]
-> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Bool
-> Int
-> [Alignment]
-> [Double]
-> [[Block]]
-> ReaderT WriterConfig m Text
tableRowToRTF Bool
True Int
indent [Alignment]
aligns [Double]
sizes [[Block]]
headers
  Text
rows' <- [Text] -> Text
T.concat ([Text] -> Text)
-> ReaderT WriterConfig m [Text] -> ReaderT WriterConfig m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Block]] -> ReaderT WriterConfig m Text)
-> [[[Block]]] -> ReaderT WriterConfig m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Bool
-> Int
-> [Alignment]
-> [Double]
-> [[Block]]
-> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Bool
-> Int
-> [Alignment]
-> [Double]
-> [[Block]]
-> ReaderT WriterConfig m Text
tableRowToRTF Bool
False Int
indent [Alignment]
aligns [Double]
sizes) [[[Block]]]
rows
  ((Text
header' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rows') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> ReaderT WriterConfig m Text -> ReaderT WriterConfig m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfPar Int
indent Int
0 Alignment
alignment Text
caption'
blockToRTF Int
indent Alignment
alignment (Figure Attr
attr Caption
capt [Block]
body) =
  Int -> Alignment -> Block -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> ReaderT WriterConfig m Text
blockToRTF Int
indent Alignment
alignment (Block -> ReaderT WriterConfig m Text)
-> Block -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> [Block] -> Block
figureDiv Attr
attr Caption
capt [Block]
body

tableRowToRTF :: PandocMonad m
              => Bool -> Int -> [Alignment] -> [Double] -> [[Block]]
              -> ReaderT WriterConfig m Text
tableRowToRTF :: forall (m :: * -> *).
PandocMonad m =>
Bool
-> Int
-> [Alignment]
-> [Double]
-> [[Block]]
-> ReaderT WriterConfig m Text
tableRowToRTF Bool
header Int
indent [Alignment]
aligns [Double]
sizes' [[Block]]
cols = do
  let totalTwips :: Double
totalTwips = Double
6 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1440 -- 6 inches
  let sizes :: [Double]
sizes = if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
sizes'
                 then Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate ([[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
cols) (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
cols))
                 else [Double]
sizes'
  Text
columns <- [Text] -> Text
T.concat ([Text] -> Text)
-> ReaderT WriterConfig m [Text] -> ReaderT WriterConfig m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
     (Alignment -> [Block] -> ReaderT WriterConfig m Text)
-> [Alignment] -> [[Block]] -> ReaderT WriterConfig m [Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
tableItemToRTF Int
indent) [Alignment]
aligns [[Block]]
cols
  let rightEdges :: [Integer]
rightEdges = Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
drop Int
1 ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$
                    (Integer -> Double -> Integer) -> Integer -> [Double] -> [Integer]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Integer
sofar Double
new -> Integer
sofar Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
new Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
totalTwips))
                          (Integer
0 :: Integer) [Double]
sizes
  let cellDefs :: [Text]
cellDefs = (Integer -> Text) -> [Integer] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
edge -> (if Bool
header
                                   then Text
"\\clbrdrb\\brdrs"
                                   else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\cellx" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow Integer
edge)
                     [Integer]
rightEdges
  let start :: Text
start = Text
"{\n\\trowd \\trgaph120\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text]
cellDefs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              Text
"\\trkeep\\intbl\n{\n"
  let end :: Text
end = Text
"}\n\\intbl\\row}\n"
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
columns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
end

tableItemToRTF :: PandocMonad m
               => Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
tableItemToRTF :: forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
tableItemToRTF Int
indent Alignment
alignment [Block]
item = do
  Text
contents <- Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
blocksToRTF Int
indent Alignment
alignment [Block]
item
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\\pard" Text
"\\pard\\intbl" Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\cell}\n"

-- | Ensure that there's the same amount of space after compact
-- lists as after regular lists.
spaceAtEnd :: Text -> Text
spaceAtEnd :: Text -> Text
spaceAtEnd Text
str = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
str (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\sa180\\par}\n") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix Text
"\\par}\n" Text
str

-- | Parse a decimal integer stored in a tag attribute.
readInt :: Text -> Maybe Int
readInt :: Text -> Maybe Int
readInt = Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead

-- | Inject an @\\ls@/@\\ilvl@ reference into an already-rendered list
-- paragraph (used for continuation paragraphs of a multi-paragraph list
-- item, which carry the list reference but no @\\listtext@ marker).  The
-- reference is inserted right before the @\\fi@ first-line-indent control
-- word, where the reader expects to find the paragraph's list properties.
addListRef :: Int -> Int -> Text -> Text
addListRef :: Int -> Int -> Text -> Text
addListRef Int
ls Int
level Text
t =
  let ref :: Text
ref = Text
"\\ls" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
ls Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\ilvl" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
level
      (Text
pref, Text
suff) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"\\fi" Text
t
  in if Text -> Bool
T.null Text
suff then Text
t else Text
pref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suff

-- | Convert list item (list of blocks) to RTF.
listItemToRTF :: PandocMonad m
              => Alignment        -- ^ alignment
              -> Int              -- ^ indent level
              -> Maybe (Int, Int) -- ^ list reference (@\\ls@, @\\ilvl@), if
                                  -- the list is part of the list table
              -> Text             -- ^ list start marker
              -> [Block]          -- ^ list item (list of blocks)
              -> ReaderT WriterConfig m Text
listItemToRTF :: forall (m :: * -> *).
PandocMonad m =>
Alignment
-> Int
-> Maybe (Int, Int)
-> Text
-> [Block]
-> ReaderT WriterConfig m Text
listItemToRTF Alignment
alignment Int
indent Maybe (Int, Int)
mbref Text
marker [] =
  Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Int -> Alignment -> Text -> ReaderT WriterConfig m Text
rtfCompact (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
listIncrement) (Int -> Int
forall a. Num a => a -> a
negate Int
listIncrement) Alignment
alignment (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$
    case Maybe (Int, Int)
mbref of
      Maybe (Int, Int)
Nothing -> Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\tx" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
listIncrement Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\tab "
      Just (Int
ls, Int
level) ->
        Text
"\\ls" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
ls Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\ilvl" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
level Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"\\tx" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
listIncrement Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" {\\listtext\\tab " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\tab}"
listItemToRTF Alignment
alignment Int
indent Maybe (Int, Int)
mbref Text
marker (Block
listFirst:[Block]
listRest) = do
  let f :: Block -> ReaderT WriterConfig m Text
f = Int -> Alignment -> Block -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> ReaderT WriterConfig m Text
blockToRTF (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
listIncrement) Alignment
alignment
  Text
first <- Block -> ReaderT WriterConfig m Text
f Block
listFirst
  -- Continuation paragraphs carry the same \ls/\ilvl reference but no
  -- \listtext marker, so the reader merges them into the current item.
  -- Nested lists are tagged Divs that already carry their own reference,
  -- so they are left untouched.
  [Text]
rest <- [Block]
-> (Block -> ReaderT WriterConfig m Text)
-> ReaderT WriterConfig m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Block]
listRest ((Block -> ReaderT WriterConfig m Text)
 -> ReaderT WriterConfig m [Text])
-> (Block -> ReaderT WriterConfig m Text)
-> ReaderT WriterConfig m [Text]
forall a b. (a -> b) -> a -> b
$ \Block
b -> do
            Text
t <- Block -> ReaderT WriterConfig m Text
f Block
b
            Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ case Maybe (Int, Int)
mbref of
              Just (Int
ls, Int
level) | Bool -> Bool
not (Block -> Bool
isTaggedList Block
b) -> Int -> Int -> Text -> Text
addListRef Int
ls Int
level Text
t
              Maybe (Int, Int)
_ -> Text
t
  let listMarker :: Text
listMarker = case Maybe (Int, Int)
mbref of
        Maybe (Int, Int)
Nothing ->
          Text
"\\fi" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Int
forall a. Num a => a -> a
negate Int
listIncrement) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
"\\tx" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
listIncrement Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\tab"
        Just (Int
ls, Int
level) ->
          Text
"\\fi" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Int
forall a. Num a => a -> a
negate Int
listIncrement) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
"\\ls" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
ls Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\ilvl" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
level Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
"\\tx" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
listIncrement Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
" {\\listtext\\tab " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\tab}"
  -- Find the first occurrence of \\fi or \\fi-, then replace it and the following
  -- digits with the list marker.
  let insertListMarker :: Text -> Text
insertListMarker Text
t = case Text -> Maybe Text
popDigit (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
optionDash (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
3 Text
suff of
        Just Text
suff' -> Text
pref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
listMarker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isDigit Text
suff'
        Maybe Text
Nothing    -> Text
t
        where
          (Text
pref, Text
suff) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"\\fi" Text
t
          optionDash :: Text -> Text
optionDash Text
x = case Text -> Maybe (Char, Text)
T.uncons Text
x of
            Just (Char
'-', Text
xs) -> Text
xs
            Maybe (Char, Text)
_              -> Text
x
          popDigit :: Text -> Maybe Text
popDigit Text
x
            | Just (Char
d, Text
xs) <- Text -> Maybe (Char, Text)
T.uncons Text
x
            , Char -> Bool
isDigit Char
d = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
xs
            | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing
   -- insert the list marker into the (processed) first block
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
insertListMarker Text
first Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text]
rest

-- | Is this a list block tagged by 'prepareLists' (and hence already
-- carrying its own @\\ls@/@\\ilvl@ reference)?
isTaggedList :: Block -> Bool
isTaggedList :: Block -> Bool
isTaggedList (Div (Text
_, [Text]
classes, [(Text, Text)]
_) [Block]
_) = Text
"__rtflist" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
isTaggedList Block
_ = Bool
False

-- | Convert definition list item (label, list of blocks) to RTF.
definitionListItemToRTF :: PandocMonad m
                        => Alignment          -- ^ alignment
                        -> Int                -- ^ indent level
                        -> ([Inline],[[Block]]) -- ^ list item (list of blocks)
                        -> ReaderT WriterConfig m Text
definitionListItemToRTF :: forall (m :: * -> *).
PandocMonad m =>
Alignment
-> Int -> ([Inline], [[Block]]) -> ReaderT WriterConfig m Text
definitionListItemToRTF Alignment
alignment Int
indent ([Inline]
label, [[Block]]
defs) = do
  Text
labelText <- Int -> Alignment -> Block -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> ReaderT WriterConfig m Text
blockToRTF Int
indent Alignment
alignment ([Inline] -> Block
Plain [Inline]
label)
  Text
itemsText <- Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> ReaderT WriterConfig m Text
blocksToRTF (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
listIncrement) Alignment
alignment ([[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Block]]
defs)
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
labelText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
itemsText

-- | Convert list of inline items to RTF.
inlinesToRTF :: PandocMonad m
             => [Inline]   -- ^ list of inlines to convert
             -> ReaderT WriterConfig m Text
inlinesToRTF :: forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst = [Text] -> Text
T.concat ([Text] -> Text)
-> ReaderT WriterConfig m [Text] -> ReaderT WriterConfig m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> ReaderT WriterConfig m Text)
-> [Inline] -> ReaderT WriterConfig m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Inline -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Inline -> ReaderT WriterConfig m Text
inlineToRTF [Inline]
lst

-- | Convert inline item to RTF.
inlineToRTF :: PandocMonad m
            => Inline         -- ^ inline to convert
            -> ReaderT WriterConfig m Text
inlineToRTF :: forall (m :: * -> *).
PandocMonad m =>
Inline -> ReaderT WriterConfig m Text
inlineToRTF (Span Attr
_ [Inline]
lst) = [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
inlineToRTF (Emph [Inline]
lst) = do
  Text
contents <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\i " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
inlineToRTF (Underline [Inline]
lst) = do
  Text
contents <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\ul " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
inlineToRTF (Strong [Inline]
lst) = do
  Text
contents <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\b " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
inlineToRTF (Strikeout [Inline]
lst) = do
  Text
contents <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\strike " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
inlineToRTF (Superscript [Inline]
lst) = do
  Text
contents <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\super " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
inlineToRTF (Subscript [Inline]
lst) = do
  Text
contents <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\sub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
inlineToRTF (SmallCaps [Inline]
lst) = do
  Text
contents <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\scaps " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
inlineToRTF (Quoted QuoteType
SingleQuote [Inline]
lst) = do
  Text
contents <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"\\u8216'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\u8217'"
inlineToRTF (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Text
contents <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"\\u8220\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\u8221\""
inlineToRTF (Code Attr
_ Text
str) = do
  Int
fontsize <- (WriterConfig -> Int) -> ReaderT WriterConfig m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterConfig -> Int
fontSize
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\f1 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
renderFontSize Int
fontsize Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
codeStringToRTF Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
inlineToRTF (Str Text
str) = Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
stringToRTF Text
str
inlineToRTF (Math MathType
t Text
str) = MathType -> Text -> ReaderT WriterConfig m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
str ReaderT WriterConfig m [Inline]
-> ([Inline] -> ReaderT WriterConfig m Text)
-> ReaderT WriterConfig m Text
forall a b.
ReaderT WriterConfig m a
-> (a -> ReaderT WriterConfig m b) -> ReaderT WriterConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF
inlineToRTF (Cite [Citation]
_ [Inline]
lst) = [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
lst
inlineToRTF il :: Inline
il@(RawInline Format
f Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"rtf" = Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
  | Bool
otherwise         = do
      LogMessage -> ReaderT WriterConfig m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT WriterConfig m ())
-> LogMessage -> ReaderT WriterConfig m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
inlineToRTF Inline
LineBreak = Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\line "
inlineToRTF Inline
SoftBreak = Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
inlineToRTF Inline
Space = Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
inlineToRTF (Link Attr
_ [Inline]
text (Text
src, Text
_)) = do
  Text
contents <- [Inline] -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> ReaderT WriterConfig m Text
inlinesToRTF [Inline]
text
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\field{\\*\\fldinst{HYPERLINK \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
codeStringToRTF Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    Text
"\"}}{\\fldrslt{\\ul\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n}}}\n"
inlineToRTF (Image Attr
_ [Inline]
_ (Text
source, Text
_)) =
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\cf1 [image: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
source Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]\\cf0}"
inlineToRTF (Note [Block]
contents) = do
  Text
body <- [Text] -> Text
T.concat ([Text] -> Text)
-> ReaderT WriterConfig m [Text] -> ReaderT WriterConfig m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> ReaderT WriterConfig m Text)
-> [Block] -> ReaderT WriterConfig m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Alignment -> Block -> ReaderT WriterConfig m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> ReaderT WriterConfig m Text
blockToRTF Int
0 Alignment
AlignDefault) [Block]
contents
  Text -> ReaderT WriterConfig m Text
forall a. a -> ReaderT WriterConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterConfig m Text)
-> Text -> ReaderT WriterConfig m Text
forall a b. (a -> b) -> a -> b
$ Text
"{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    Text
body Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

renderFontSize :: Int -> Text
renderFontSize :: Int -> Text
renderFontSize Int
halfPoints = Text
"\\fs" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
halfPoints