{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Writers.RTF ( writeRTF
) where
import Control.Monad.Except (catchError, throwError)
import Control.Monad
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)
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)
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
writeRTF :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeRTF :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeRTF WriterOptions
options Pandoc
doc = do
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
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
.
(Block -> m Text) -> [Block] -> 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 -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> 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
. [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 Int
0 Alignment
AlignDefault [Block]
blocks
Text
toc <- Int -> Alignment -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> m Text
blocksToRTF Int
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 Text
"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 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
(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'
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
" ?"
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
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
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)
rtfParSpaced :: Int
-> Int
-> Int
-> Alignment
-> Text
-> Text
rtfParSpaced :: Int -> Int -> Int -> Alignment -> Text -> Text
rtfParSpaced Int
spaceAfter Int
indent Int
firstLineIndent Alignment
alignment Text
content =
let alignString :: Text
alignString = case Alignment
alignment of
Alignment
AlignLeft -> Text
"\\ql "
Alignment
AlignRight -> Text
"\\qr "
Alignment
AlignCenter -> Text
"\\qc "
Alignment
AlignDefault -> Text
"\\ql "
in 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 \\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"
rtfPar :: Int
-> Int
-> Alignment
-> Text
-> Text
rtfPar :: Int -> Int -> Alignment -> Text -> Text
rtfPar = Int -> Int -> Int -> Alignment -> Text -> Text
rtfParSpaced Int
180
rtfCompact :: Int
-> Int
-> Alignment
-> Text
-> Text
rtfCompact :: Int -> Int -> Alignment -> Text -> Text
rtfCompact = Int -> Int -> Int -> Alignment -> Text -> Text
rtfParSpaced Int
0
indentIncrement :: Int
indentIncrement :: Int
indentIncrement = Int
720
listIncrement :: Int
listIncrement :: Int
listIncrement = Int
360
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 "
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]
-> m Text
blocksToRTF :: forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> m Text
blocksToRTF Int
indent Alignment
align = ([Text] -> Text) -> m [Text] -> m Text
forall a b. (a -> b) -> m a -> m b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Alignment -> Block -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> m Text
blockToRTF Int
indent Alignment
align)
blockToRTF :: PandocMonad m
=> Int
-> Alignment
-> Block
-> m Text
blockToRTF :: forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> m Text
blockToRTF Int
indent Alignment
alignment (Div Attr
_ [Block]
bs) =
Int -> Alignment -> [Block] -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> m Text
blocksToRTF Int
indent Alignment
alignment [Block]
bs
blockToRTF Int
indent Alignment
alignment (Plain [Inline]
lst) =
Int -> Int -> Alignment -> Text -> Text
rtfCompact Int
indent Int
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 Int
indent Alignment
alignment (Para [Inline]
lst) =
Int -> Int -> Alignment -> Text -> Text
rtfPar Int
indent Int
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 Int
indent Alignment
alignment (LineBlock [[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 Int
indent Alignment
alignment (BlockQuote [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 Int
indent Alignment
_ (CodeBlock Attr
_ Text
str) =
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
$ Int -> Int -> Alignment -> Text -> Text
rtfPar Int
indent Int
0 Alignment
AlignLeft (Text
"\\f1 " 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 -> m Text
forall a. a -> m a
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 a. a -> 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) -> 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 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) -> 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 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) -> 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 Int
indent Alignment
_ Block
HorizontalRule = 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
$
Int -> Int -> Alignment -> Text -> 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] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
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
$ Int -> Int -> Alignment -> Text -> Text
rtfPar Int
indent Int
0 Alignment
alignment (Text -> Text) -> Text -> 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 \\fs" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int
40 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)) 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] -> 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
then Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 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
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 Int
0 Alignment
alignment Text
caption'
blockToRTF Int
indent Alignment
alignment (Figure Attr
attr Caption
capt [Block]
body) =
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
$ Attr -> Caption -> [Block] -> Block
figureDiv Attr
attr Caption
capt [Block]
body
tableRowToRTF :: PandocMonad m
=> Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> m Text
tableRowToRTF :: forall (m :: * -> *).
PandocMonad m =>
Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> 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
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) -> 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. HasCallStack => [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 (\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 -> 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
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 :: forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> [Block] -> m Text
tableItemToRTF Int
indent Alignment
alignment [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 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
"{" 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"
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
listItemToRTF :: PandocMonad m
=> Alignment
-> Int
-> Text
-> [Block]
-> m Text
listItemToRTF :: forall (m :: * -> *).
PandocMonad m =>
Alignment -> Int -> Text -> [Block] -> m Text
listItemToRTF Alignment
alignment Int
indent Text
marker [] = 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
$
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
<> 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 ")
listItemToRTF Alignment
alignment Int
indent Text
marker (Block
listFirst:[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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> m Text
f [Block]
listRest
let listMarker :: Text
listMarker = 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"
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
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 -> Text
insertListMarker Text
first Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text]
rest
definitionListItemToRTF :: PandocMonad m
=> Alignment
-> Int
-> ([Inline],[[Block]])
-> m Text
definitionListItemToRTF :: forall (m :: * -> *).
PandocMonad m =>
Alignment -> Int -> ([Inline], [[Block]]) -> m Text
definitionListItemToRTF Alignment
alignment Int
indent ([Inline]
label, [[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 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
labelText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
itemsText
inlinesToRTF :: PandocMonad m
=> [Inline]
-> m Text
inlinesToRTF :: forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Inline -> m Text
forall (m :: * -> *). PandocMonad m => Inline -> m Text
inlineToRTF [Inline]
lst
inlineToRTF :: PandocMonad m
=> Inline
-> m Text
inlineToRTF :: forall (m :: * -> *). PandocMonad m => Inline -> m Text
inlineToRTF (Span Attr
_ [Inline]
lst) = [Inline] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
inlineToRTF (Emph [Inline]
lst) = do
Text
contents <- [Inline] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
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
"{\\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] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
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
"{\\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] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
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
"{\\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] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
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
"{\\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] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
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
"{\\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] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
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
"{\\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] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
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
"{\\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] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
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
"\\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] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
lst
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
"\\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) = 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
"{\\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
<> Text
"}"
inlineToRTF (Str Text
str) = 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 -> Text
stringToRTF Text
str
inlineToRTF (Math MathType
t 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 a b. m a -> (a -> m b) -> m b
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 [Citation]
_ [Inline]
lst) = [Inline] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> 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 -> m Text
forall a. a -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
inlineToRTF Inline
LineBreak = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\line "
inlineToRTF Inline
SoftBreak = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
inlineToRTF Inline
Space = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
inlineToRTF (Link Attr
_ [Inline]
text (Text
src, Text
_)) = do
Text
contents <- [Inline] -> m Text
forall (m :: * -> *). PandocMonad m => [Inline] -> m Text
inlinesToRTF [Inline]
text
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
"{\\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 -> 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
"{\\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) -> 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Alignment -> Block -> m Text
forall (m :: * -> *).
PandocMonad m =>
Int -> Alignment -> Block -> m Text
blockToRTF Int
0 Alignment
AlignDefault) [Block]
contents
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
"{\\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
"}"