{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings   #-}
{- |
   Module      : Text.Pandoc.Writers.RTF
   Copyright   : Copyright (C) 2006-2019 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 Prelude
import Control.Monad.Except (catchError, throwError)
import Control.Monad
import qualified Data.ByteString as B
import Data.Char (chr, isDigit, ord)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Class (PandocMonad, report)
import qualified Text.Pandoc.Class 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)

-- | 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 :: WriterOptions -> Inline -> m Inline
rtfEmbedImage opts :: WriterOptions
opts x :: Inline
x@(Image attr :: Attr
attr _ (src :: Text
src,_)) = m Inline -> (PandocError -> m Inline) -> m Inline
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
           (imgdata :: ByteString
imgdata, Just mime :: Text
mime)
             | Text
mime Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "image/jpeg" Bool -> Bool -> Bool
|| Text
mime Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "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 "%02x") ([Word8] -> [Text]) -> [Word8] -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
imgdata
             Text
filetype <-
                case Text
mime of
                     "image/jpeg" -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return "\\jpegblip"
                     "image/png"  -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return "\\pngblip"
                     _            -> PandocError -> m Text
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
$
                                         "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 msg :: 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 (m :: * -> *) a. Monad m => a -> m a
return ""
                     Right sz :: ImageSize
sz -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ "\\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
<>
                                "\\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
<>
                                "\\picwgoal" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
xpt Double -> Double -> Double
forall a. Num a => a -> a -> a
* 20) :: Integer)
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\\pichgoal" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
ypt Double -> Double -> Double
forall a. Num a => a -> a -> a
* 20) :: Integer)
                        -- twip = 1/1440in = 1/20pt
                        where (xpx :: Integer
xpx, ypx :: Integer
ypx) = ImageSize -> (Integer, Integer)
sizeInPixels ImageSize
sz
                              (xpt :: Double
xpt, ypt :: Double
ypt) = WriterOptions -> Attr -> ImageSize -> (Double, Double)
desiredSizeInPoints WriterOptions
opts Attr
attr ImageSize
sz
             let raw :: Text
raw = "{\\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
<> "\\bin " 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
<> "}"
             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 "image contained no data"
                  Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
                else Inline -> m Inline
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 "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 "image is not a jpeg or png"
               Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
           (_, 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 (m :: * -> *) a. Monad m => a -> m a
return Inline
x)
  (\e :: 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 (m :: * -> *) a. Monad m => a -> m a
return Inline
x)
rtfEmbedImage _ x :: Inline
x = Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x

-- | Convert Pandoc to a string in rich text format.
writeRTF :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeRTF :: WriterOptions -> Pandoc -> m Text
writeRTF options :: WriterOptions
options doc :: Pandoc
doc = do
  -- handle images
  Pandoc meta :: Meta
meta@(Meta metamap :: Map Text MetaValue
metamap) blocks :: [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
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 (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 ils :: [Inline]
ils]) = [Inline] -> MetaValue
MetaInlines [Inline]
ils
      toPlain x :: 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 "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 "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 "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 (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
.
                (Block -> m Text) -> [Block] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Alignment -> Block -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> m Text
blockToRTF 0 Alignment
AlignDefault))
              ((Text -> Doc Text) -> m Text -> m (Doc Text)
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
. [Inline] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF)
              Meta
meta'
  Text
body <- Int -> Alignment -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> m Text
blocksToRTF 0 Alignment
AlignDefault [Block]
blocks
  Text
toc <- Int -> Alignment -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> m Text
blocksToRTF 0 Alignment
AlignDefault [WriterOptions -> [Block] -> Block
toTableOfContents WriterOptions
options [Block]
blocks]
  let context :: Context Text
context = Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "body" Text
body
              (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 "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 "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 "toc" Text
toc
                   else Context Text -> Context Text
forall a. a -> a
id) Context Text
metadata
  Text -> m Text
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 tpl :: 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
       Nothing  -> case Text -> Maybe (Text, Char)
T.unsnoc Text
body of
                        Just (_,'\n') -> Text
body
                        _             -> Text
body Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton '\n'

-- | 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
$ \c :: Char
c ->
  if Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
- 0x10000
                   (q :: Int
q, r :: Int
r) = Int
x Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 0x400
                   upper :: Int
upper = Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 0xd800
                   lower :: Int
lower = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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 x :: Char
x = Bool -> Bool
not (   (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
<= 0xd7ff)
                       Bool -> Bool -> Bool
|| (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
<= 0xffff) )
    enc :: Char -> Text
enc x :: Char
x = "\\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
<> "?"

-- | Escape special characters.
escapeSpecial :: Text -> Text
escapeSpecial :: Text -> Text
escapeSpecial = [(Char, Text)] -> Text -> Text
escapeStringUsing ([(Char, Text)] -> Text -> Text) -> [(Char, Text)] -> Text -> Text
forall a b. (a -> b) -> a -> b
$
  [ ('\t',"\\tab ")
  , ('\8216',"\\u8216'")
  , ('\8217',"\\u8217'")
  , ('\8220',"\\u8220\"")
  , ('\8221',"\\u8221\"")
  , ('\8211',"\\u8211-")
  , ('\8212',"\\u8212-")
  ] [(Char, Text)] -> [(Char, Text)] -> [(Char, Text)]
forall a. Semigroup a => a -> a -> a
<> String -> [(Char, Text)]
backslashEscapes "{\\}"

-- | 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 str :: Text
str = Text -> [Text] -> Text
T.intercalate "\\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 :: 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
             -> Text
rtfParSpaced :: Int -> Int -> Int -> Alignment -> Text -> Text
rtfParSpaced spaceAfter :: Int
spaceAfter indent :: Int
indent firstLineIndent :: Int
firstLineIndent alignment :: Alignment
alignment content :: Text
content =
  let alignString :: Text
alignString = case Alignment
alignment of
                           AlignLeft    -> "\\ql "
                           AlignRight   -> "\\qr "
                           AlignCenter  -> "\\qc "
                           AlignDefault -> "\\ql "
  in  "{\\pard " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
alignString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      "\\f0 \\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
<> " \\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
<>
      " \\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
forall a. Semigroup a => a -> a -> a
<> Text
content Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\\par}\n"

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

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

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

listIncrement :: Int
listIncrement :: Int
listIncrement = 360

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

-- | Returns appropriate (list of) ordered list markers for indent level.
orderedMarkers :: Int -> ListAttributes -> [Text]
orderedMarkers :: Int -> ListAttributes -> [Text]
orderedMarkers indent :: Int
indent (start :: Int
start, style :: ListNumberStyle
style, delim :: 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` 720 of
              0 -> ListAttributes -> [Text]
orderedListMarkers (Int
start, ListNumberStyle
Decimal, ListNumberDelim
Period)
              _ -> 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]
            -> m Text
blocksToRTF :: Int -> Alignment -> [Block] -> m Text
blocksToRTF indent :: Int
indent align :: Alignment
align = ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
T.concat (m [Text] -> m Text) -> ([Block] -> m [Text]) -> [Block] -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> m Text) -> [Block] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Alignment -> Block -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> 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
           -> m Text
blockToRTF :: Int -> Alignment -> Block -> m Text
blockToRTF _ _ Null = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""
blockToRTF indent :: Int
indent alignment :: Alignment
alignment (Div _ bs :: [Block]
bs) =
  Int -> Alignment -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> m Text
blocksToRTF Int
indent Alignment
alignment [Block]
bs
blockToRTF indent :: Int
indent alignment :: Alignment
alignment (Plain lst :: [Inline]
lst) =
  Int -> Int -> Alignment -> Text -> Text
rtfCompact Int
indent 0 Alignment
alignment (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
blockToRTF indent :: Int
indent alignment :: Alignment
alignment (Para lst :: [Inline]
lst) =
  Int -> Int -> Alignment -> Text -> Text
rtfPar Int
indent 0 Alignment
alignment (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
blockToRTF indent :: Int
indent alignment :: Alignment
alignment (LineBlock lns :: [[Inline]]
lns) =
  Int -> Alignment -> Block -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> m Text
blockToRTF Int
indent Alignment
alignment (Block -> m Text) -> Block -> m Text
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToRTF indent :: Int
indent alignment :: Alignment
alignment (BlockQuote lst :: [Block]
lst) =
  Int -> Alignment -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> m Text
blocksToRTF (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentIncrement) Alignment
alignment [Block]
lst
blockToRTF indent :: Int
indent _ (CodeBlock _ str :: Text
str) =
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Alignment -> Text -> Text
rtfPar Int
indent 0 Alignment
AlignLeft ("\\f1 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
codeStringToRTF Text
str)
blockToRTF _ _ b :: Block
b@(RawBlock f :: Format
f str :: Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "rtf" = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
  | Bool
otherwise         = do
      LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""
blockToRTF indent :: Int
indent alignment :: Alignment
alignment (BulletList lst :: [[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) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ([Block] -> m Text) -> [[Block]] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Alignment -> Int -> Text -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Alignment -> Int -> Text -> [Block] -> m Text
listItemToRTF Alignment
alignment Int
indent (Int -> Text
bulletMarker Int
indent)) [[Block]]
lst
blockToRTF indent :: Int
indent alignment :: Alignment
alignment (OrderedList attribs :: ListAttributes
attribs lst :: [[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) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
   (Text -> [Block] -> m Text) -> [Text] -> [[Block]] -> m [Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Alignment -> Int -> Text -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Alignment -> Int -> Text -> [Block] -> m Text
listItemToRTF Alignment
alignment Int
indent) (Int -> ListAttributes -> [Text]
orderedMarkers Int
indent ListAttributes
attribs) [[Block]]
lst
blockToRTF indent :: Int
indent alignment :: Alignment
alignment (DefinitionList lst :: [([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) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (([Inline], [[Block]]) -> m Text)
-> [([Inline], [[Block]])] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Alignment -> Int -> ([Inline], [[Block]]) -> m Text
forall (m :: * -> *).
PandocMonad m =>
Alignment -> Int -> ([Inline], [[Block]]) -> m Text
definitionListItemToRTF Alignment
alignment Int
indent) [([Inline], [[Block]])]
lst
blockToRTF indent :: Int
indent _ HorizontalRule = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$
  Int -> Int -> Alignment -> Text -> Text
rtfPar Int
indent 0 Alignment
AlignCenter "\\emdash\\emdash\\emdash\\emdash\\emdash"
blockToRTF indent :: Int
indent alignment :: Alignment
alignment (Header level :: Int
level _ lst :: [Inline]
lst) = do
  Text
contents <- [Inline] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Alignment -> Text -> Text
rtfPar Int
indent 0 Alignment
alignment (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
             "\\b \\fs" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (40 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
blockToRTF indent :: Int
indent alignment :: Alignment
alignment (Table caption :: [Inline]
caption aligns :: [Alignment]
aligns sizes :: [Double]
sizes headers :: [[Block]]
headers rows :: [[[Block]]]
rows) = do
  Text
caption' <- [Inline] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
                then Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""
                else Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> m Text
tableRowToRTF Bool
True Int
indent [Alignment]
aligns [Double]
sizes [[Block]]
headers
  Text
rows' <- [Text] -> Text
T.concat ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Block]] -> m Text) -> [[[Block]]] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> m Text
tableRowToRTF Bool
False Int
indent [Alignment]
aligns [Double]
sizes) [[[Block]]]
rows
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text
header' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rows' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Alignment -> Text -> Text
rtfPar Int
indent 0 Alignment
alignment Text
caption'

tableRowToRTF :: PandocMonad m
              => Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> m Text
tableRowToRTF :: Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> m Text
tableRowToRTF header :: Bool
header indent :: Int
indent aligns :: [Alignment]
aligns sizes' :: [Double]
sizes' cols :: [[Block]]
cols = do
  let totalTwips :: Double
totalTwips = 6 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 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
== 0) [Double]
sizes'
                 then Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate ([[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
cols) (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 (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
cols))
                 else [Double]
sizes'
  Text
columns <- [Text] -> Text
T.concat ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
     (Alignment -> [Block] -> m Text)
-> [Alignment] -> [[Block]] -> m [Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Int -> Alignment -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> m Text
tableItemToRTF Int
indent) [Alignment]
aligns [[Block]]
cols
  let rightEdges :: [Integer]
rightEdges = [Integer] -> [Integer]
forall a. [a] -> [a]
tail ([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 (\sofar :: Integer
sofar new :: Double
new -> Integer
sofar Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
new Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
totalTwips))
                                (0 :: Integer) [Double]
sizes
  let cellDefs :: [Text]
cellDefs = (Integer -> Text) -> [Integer] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\edge :: Integer
edge -> (if Bool
header
                                   then "\\clbrdrb\\brdrs"
                                   else "") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\\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 = "{\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
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              "\\trkeep\\intbl\n{\n"
  let end :: Text
end = "}\n\\intbl\\row}\n"
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> 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] -> m Text
tableItemToRTF :: Int -> Alignment -> [Block] -> m Text
tableItemToRTF indent :: Int
indent alignment :: Alignment
alignment item :: [Block]
item = do
  Text
contents <- Int -> Alignment -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> m Text
blocksToRTF Int
indent Alignment
alignment [Block]
item
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ "{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text -> Text
T.replace "\\pard" "\\pard\\intbl" Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\\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 str :: 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
<> "\\sa180\\par}\n") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix "\\par}\n" Text
str

-- | Convert list item (list of blocks) to RTF.
listItemToRTF :: PandocMonad m
              => Alignment  -- ^ alignment
              -> Int        -- ^ indent level
              -> Text     -- ^ list start marker
              -> [Block]    -- ^ list item (list of blocks)
              -> m Text
listItemToRTF :: Alignment -> Int -> Text -> [Block] -> m Text
listItemToRTF alignment :: Alignment
alignment indent :: Int
indent marker :: Text
marker [] = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$
  Int -> Int -> Alignment -> Text -> 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
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\\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
<> "\\tab ")
listItemToRTF alignment :: Alignment
alignment indent :: Int
indent marker :: Text
marker (listFirst :: Block
listFirst:listRest :: [Block]
listRest) = do
  let f :: Block -> m Text
f = Int -> Alignment -> Block -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> m Text
blockToRTF (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
listIncrement) Alignment
alignment
  Text
first <- Block -> m Text
f Block
listFirst
  [Text]
rest <- (Block -> m Text) -> [Block] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> m Text
f [Block]
listRest
  let listMarker :: Text
listMarker = "\\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
forall a. Semigroup a => a -> a -> a
<> Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                   "\\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
<> "\\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 t :: 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 3 Text
suff of
        Just suff' :: 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'
        Nothing    -> Text
t
        where
          (pref :: Text
pref, suff :: Text
suff) = Text -> Text -> (Text, Text)
T.breakOn "\\fi" Text
t
          optionDash :: Text -> Text
optionDash x :: Text
x = case Text -> Maybe (Char, Text)
T.uncons Text
x of
            Just ('-', xs :: Text
xs) -> Text
xs
            _              -> Text
x
          popDigit :: Text -> Maybe Text
popDigit x :: Text
x
            | Just (d :: Char
d, xs :: 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 -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> 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

-- | 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)
                        -> m Text
definitionListItemToRTF :: Alignment -> Int -> ([Inline], [[Block]]) -> m Text
definitionListItemToRTF alignment :: Alignment
alignment indent :: Int
indent (label :: [Inline]
label, defs :: [[Block]]
defs) = do
  Text
labelText <- Int -> Alignment -> Block -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> m Text
blockToRTF Int
indent Alignment
alignment ([Inline] -> Block
Plain [Inline]
label)
  Text
itemsText <- Int -> Alignment -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> 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 -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> 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
             -> m Text
inlinesToRTF :: [Inline] -> m Text
inlinesToRTF lst :: [Inline]
lst = [Text] -> Text
T.concat ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> m Text) -> [Inline] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> m Text
forall (m :: * -> *). PandocMonad m => Inline -> m Text
inlineToRTF [Inline]
lst

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