{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.Ms ( writeMs ) where
import Control.Monad.State.Strict
import Data.Char (isLower, isUpper, ord)
import Data.List (intercalate, intersperse)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (escapeURIString, isAllowedInURI)
import Skylighting
import System.FilePath (takeExtension)
import Text.Pandoc.Asciify (toAsciiChar)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Writers.Roff
import Text.Printf (printf)
import Text.TeXMath (writeEqn)
writeMs :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMs :: WriterOptions -> Pandoc -> m Text
writeMs WriterOptions
opts Pandoc
document =
StateT WriterState m Text -> WriterState -> m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterOptions -> Pandoc -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> MS m Text
pandocToMs WriterOptions
opts Pandoc
document) WriterState
defaultWriterState
pandocToMs :: PandocMonad m => WriterOptions -> Pandoc -> MS m Text
pandocToMs :: WriterOptions -> Pandoc -> MS m Text
pandocToMs WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else Maybe Int
forall a. Maybe a
Nothing
Context Text
metadata <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState 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
opts
(WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts)
((Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts)
Meta
meta
Doc Text
main <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
blocks
Bool
hasInlineMath <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHasInlineMath
let titleMeta :: Text
titleMeta = (WriterOptions -> Text -> Text
escapeStr WriterOptions
opts (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify) ([Inline] -> Text) -> [Inline] -> Text
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta
let authorsMeta :: [Text]
authorsMeta = ([Inline] -> Text) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (WriterOptions -> Text -> Text
escapeStr WriterOptions
opts (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify) ([[Inline]] -> [Text]) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
Bool
hasHighlighting <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHighlighting
let highlightingMacros :: Doc Text
highlightingMacros = if Bool
hasHighlighting
then Doc Text -> (Style -> Doc Text) -> Maybe Style -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
forall a. Monoid a => a
mempty Style -> Doc Text
styleToMs (Maybe Style -> Doc Text) -> Maybe Style -> Doc Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts
else Doc Text
forall a. Monoid a => a
mempty
let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
(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
"has-inline-math" Bool
hasInlineMath
(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
"hyphenate" Bool
True
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"pandoc-version" Text
pandocVersion
(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
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
opts)
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"title-meta" Text
titleMeta
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"author-meta" (Text -> [Text] -> Text
T.intercalate Text
"; " [Text]
authorsMeta)
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"highlighting-macros" Doc Text
highlightingMacros Context Text
metadata
Text -> MS m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MS m Text) -> Text -> MS m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Maybe (Template Text)
Nothing -> Doc Text
main
Just Template Text
tpl -> 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
escapeStr :: WriterOptions -> Text -> Text
escapeStr :: WriterOptions -> Text -> Text
escapeStr WriterOptions
opts =
EscapeMode -> Text -> Text
escapeString (if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts then EscapeMode
AsciiOnly else EscapeMode
AllowUTF8)
escapeUri :: Text -> Text
escapeUri :: Text -> Text
escapeUri = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
escapeURIString (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'@' Bool -> Bool -> Bool
&& Char -> Bool
isAllowedInURI Char
c) (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
toSmallCaps :: WriterOptions -> Text -> Text
toSmallCaps :: WriterOptions -> Text -> Text
toSmallCaps WriterOptions
opts Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
Maybe (Char, Text)
Nothing -> Text
""
Just (Char
c, Text
cs)
| Char -> Bool
isLower Char
c -> let (Text
lowers,Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isLower Text
s
in Text
"\\s-2" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Text -> Text
escapeStr WriterOptions
opts (Text -> Text
T.toUpper Text
lowers) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\\s0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Text -> Text
toSmallCaps WriterOptions
opts Text
rest
| Char -> Bool
isUpper Char
c -> let (Text
uppers,Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isUpper Text
s
in WriterOptions -> Text -> Text
escapeStr WriterOptions
opts Text
uppers Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Text -> Text
toSmallCaps WriterOptions
opts Text
rest
| Bool
otherwise -> WriterOptions -> Text -> Text
escapeStr WriterOptions
opts (Char -> Text
T.singleton Char
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Text -> Text
toSmallCaps WriterOptions
opts Text
cs
blockToMs :: PandocMonad m
=> WriterOptions
-> Block
-> MS m (Doc Text)
blockToMs :: WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
_ Block
Null = Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToMs WriterOptions
opts (Div (Text
ident,[Text]
cls,[(Text, Text)]
kvs) [Block]
bs) = do
let anchor :: Doc Text
anchor = if Text -> Bool
T.null Text
ident
then Doc Text
forall a. Doc a
empty
else Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".pdfhref M "
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
toAscii Text
ident))
case [Text]
cls of
[Text]
_ | Text
"csl-entry" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls ->
(Doc Text
".CSLENTRY" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$) (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> MS m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
True WriterOptions
opts) [Block]
bs
| Text
"csl-bib-body" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls -> do
Doc Text
res <- WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
bs
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
anchor Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
".nr PI 3n" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
".de CSLENTRY" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
(case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"entry-spacing" [(Text, Text)]
kvs Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead of
Just Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
0 :: Int) -> Doc Text
".sp"
Maybe Int
_ -> Doc Text
forall a. Monoid a => a
mempty) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
".." Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
".de CSLP" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
(if Text
"hanging-indent" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls
then Doc Text
".XP"
else Doc Text
".LP") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
".." Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
res
[Text]
_ -> do
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
Doc Text
res <- WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
bs
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
anchor Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
res
blockToMs WriterOptions
opts (Plain [Inline]
inlines) =
([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (StateT WriterState m [Doc Text] -> MS m (Doc Text))
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ([Inline] -> MS m (Doc Text))
-> [[Inline]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts) ([[Inline]] -> StateT WriterState m [Doc Text])
-> [[Inline]] -> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]]
splitSentences [Inline]
inlines
blockToMs WriterOptions
opts (Para [Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text
src,Text
_tit)])
| let ext :: String
ext = String -> String
takeExtension (Text -> String
T.unpack Text
src) in (String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".ps" Bool -> Bool -> Bool
|| String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".eps") = do
let (Maybe Double
mbW,Maybe Double
mbH) = (WriterOptions -> Dimension -> Double
inPoints WriterOptions
opts (Dimension -> Double) -> Maybe Dimension -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Width (Text, [Text], [(Text, Text)])
attr,
WriterOptions -> Dimension -> Double
inPoints WriterOptions
opts (Dimension -> Double) -> Maybe Dimension -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Height (Text, [Text], [(Text, Text)])
attr)
let sizeAttrs :: Doc Text
sizeAttrs = case (Maybe Double
mbW, Maybe Double
mbH) of
(Just Double
wp, Maybe Double
Nothing) -> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes
(Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
wp :: Int) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"p"))
(Just Double
wp, Just Double
hp) -> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes
(Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
wp :: Int) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"p")) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
hp :: Int)))
(Maybe Double, Maybe Double)
_ -> Doc Text
forall a. Doc a
empty
Doc Text
capt <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts [Inline]
alt
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".PSPIC -C " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
escapeStr WriterOptions
opts Text
src)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text
sizeAttrs) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".ce 1000" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".ce 0"
blockToMs WriterOptions
opts (Para [Inline]
inlines) = do
Bool
firstPara <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stFirstPara
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
resetFirstPara
Doc Text
contents <- ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (StateT WriterState m [Doc Text] -> MS m (Doc Text))
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ([Inline] -> MS m (Doc Text))
-> [[Inline]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts) ([[Inline]] -> StateT WriterState m [Doc Text])
-> [[Inline]] -> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$
[Inline] -> [[Inline]]
splitSentences [Inline]
inlines
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (if Bool
firstPara then Text
".LP" else Text
".PP") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToMs WriterOptions
_ b :: Block
b@(RawBlock Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"ms" = Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
| Bool
otherwise = do
LogMessage -> MS m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> MS m ()) -> LogMessage -> MS m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToMs WriterOptions
_ Block
HorizontalRule = do
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
resetFirstPara
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".HLINE"
blockToMs WriterOptions
opts (Header Int
level (Text
ident,[Text]
classes,[(Text, Text)]
_) [Inline]
inlines) = do
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
(WriterState -> WriterState) -> MS m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> MS m ())
-> (WriterState -> WriterState) -> MS m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stInHeader :: Bool
stInHeader = Bool
True }
Doc Text
contents <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts ([Inline] -> MS m (Doc Text)) -> [Inline] -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
breakToSpace [Inline]
inlines
(WriterState -> WriterState) -> MS m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> MS m ())
-> (WriterState -> WriterState) -> MS m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stInHeader :: Bool
stInHeader = Bool
False }
let (Text
heading, Text
secnum) = if WriterOptions -> Bool
writerNumberSections WriterOptions
opts Bool -> Bool -> Bool
&&
Text
"unnumbered" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes
then (Text
".NH", Text
"\\*[SN]")
else (Text
".SH", Text
"")
let anchor :: Doc Text
anchor = if Text -> Bool
T.null Text
ident
then Doc Text
forall a. Doc a
empty
else Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".pdfhref M "
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
toAscii Text
ident))
let bookmark :: Doc Text
bookmark = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".pdfhref O " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow Int
level Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
secnum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null Text
secnum
then Text
""
else Text
" ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
WriterOptions -> Text -> Text
escapeStr WriterOptions
opts ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
inlines))
let backlink :: Doc Text
backlink = Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".pdfhref L -D " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
toAscii Text
ident)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" -- "
let tocEntry :: Doc Text
tocEntry = if WriterOptions -> Bool
writerTableOfContents WriterOptions
opts Bool -> Bool -> Bool
&&
Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= WriterOptions -> Int
writerTOCDepth WriterOptions
opts
then Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".XS"
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
backlink Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (
Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
level Text
"\t") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
(if Text -> Bool
T.null Text
secnum
then Doc Text
forall a. Doc a
empty
else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
secnum Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\~\\~")
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents))
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".XE"
else Doc Text
forall a. Doc a
empty
(WriterState -> WriterState) -> MS m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> MS m ())
-> (WriterState -> WriterState) -> MS m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stFirstPara :: Bool
stFirstPara = Bool
True }
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
heading Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow Int
level)) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
bookmark Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
anchor Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
tocEntry
blockToMs WriterOptions
opts (CodeBlock (Text, [Text], [(Text, Text)])
attr Text
str) = do
Doc Text
hlCode <- WriterOptions
-> (Text, [Text], [(Text, Text)]) -> Text -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> (Text, [Text], [(Text, Text)]) -> Text -> MS m (Doc Text)
highlightCode WriterOptions
opts (Text, [Text], [(Text, Text)])
attr Text
str
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".IP" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".nf" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\f[C]" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
((case Text -> Maybe (Char, Text)
T.uncons Text
str of
Just (Char
'.',Text
_) -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\&"
Maybe (Char, Text)
_ -> Doc Text
forall a. Monoid a => a
mempty) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
hlCode) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\f[]" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".fi"
blockToMs WriterOptions
opts (LineBlock [[Inline]]
ls) = do
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts (Block -> MS m (Doc Text)) -> Block -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
ls
blockToMs WriterOptions
opts (BlockQuote [Block]
blocks) = do
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
Doc Text
contents <- WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
blocks
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".QS" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".QE"
blockToMs WriterOptions
opts (Table (Text, [Text], [(Text, Text)])
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =
let ([Inline]
caption, [Alignment]
alignments, [Double]
widths, [[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
aligncode :: Alignment -> p
aligncode Alignment
AlignLeft = p
"l"
aligncode Alignment
AlignRight = p
"r"
aligncode Alignment
AlignCenter = p
"c"
aligncode Alignment
AlignDefault = p
"l"
in do
Doc Text
caption' <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts [Inline]
caption
let iwidths :: [Text]
iwidths = 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]
widths
then Text -> [Text]
forall a. a -> [a]
repeat Text
""
else (Double -> Text) -> [Double] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"w(%0.1fn)" (Double -> String) -> (Double -> Double) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
70 Double -> Double -> Double
forall a. Num a => a -> a -> a
*)) [Double]
widths
let coldescriptions :: Doc Text
coldescriptions = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
((Alignment -> Text -> Text) -> [Alignment] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Alignment
align Text
width -> Alignment -> Text
forall p. IsString p => Alignment -> p
aligncode Alignment
align Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
width)
[Alignment]
alignments [Text]
iwidths) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
[Doc Text]
colheadings <- ([Block] -> MS m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts) [[Block]]
headers
let makeRow :: [Doc a] -> Doc a
makeRow [Doc a]
cols = a -> Doc a
forall a. HasChars a => a -> Doc a
literal a
"T{" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$
[Doc a] -> Doc a
forall a. [Doc a] -> Doc a
vcat (Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse (a -> Doc a
forall a. HasChars a => a -> Doc a
literal a
"T}\tT{") [Doc a]
cols) Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$
a -> Doc a
forall a. HasChars a => a -> Doc a
literal a
"T}"
let colheadings' :: Doc Text
colheadings' = 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 Doc Text
forall a. Doc a
empty
else [Doc Text] -> Doc Text
forall a. HasChars a => [Doc a] -> Doc a
makeRow [Doc Text]
colheadings Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'_'
[Doc Text]
body <- ([[Block]] -> MS m (Doc Text))
-> [[[Block]]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[[Block]]
row -> do
[Doc Text]
cols <- ([Block] -> MS m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts) [[Block]]
row
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. HasChars a => [Doc a] -> Doc a
makeRow [Doc Text]
cols) [[[Block]]]
rows
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".PP" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".TS" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"delim(@@) tab(\t);" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
coldescriptions Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
colheadings' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".TE"
blockToMs WriterOptions
opts (BulletList [[Block]]
items) = do
[Doc Text]
contents <- ([Block] -> MS m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
bulletListItemToMs WriterOptions
opts) [[Block]]
items
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents)
blockToMs WriterOptions
opts (OrderedList ListAttributes
attribs [[Block]]
items) = do
let markers :: [Text]
markers = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
items) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ListAttributes -> [Text]
orderedListMarkers ListAttributes
attribs
let indent :: Int
indent = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
markers)
[Doc Text]
contents <- ((Text, [Block]) -> MS m (Doc Text))
-> [(Text, [Block])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Text
num, [Block]
item) -> WriterOptions -> Text -> Int -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Int -> [Block] -> MS m (Doc Text)
orderedListItemToMs WriterOptions
opts Text
num Int
indent [Block]
item) ([(Text, [Block])] -> StateT WriterState m [Doc Text])
-> [(Text, [Block])] -> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$
[Text] -> [[Block]] -> [(Text, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
markers [[Block]]
items
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents)
blockToMs WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
[Doc Text]
contents <- (([Inline], [[Block]]) -> MS m (Doc Text))
-> [([Inline], [[Block]])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> ([Inline], [[Block]]) -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> MS m (Doc Text)
definitionListItemToMs WriterOptions
opts) [([Inline], [[Block]])]
items
MS m ()
forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents)
bulletListItemToMs :: PandocMonad m => WriterOptions -> [Block] -> MS m (Doc Text)
bulletListItemToMs :: WriterOptions -> [Block] -> MS m (Doc Text)
bulletListItemToMs WriterOptions
_ [] = Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
bulletListItemToMs WriterOptions
opts (Para [Inline]
first:[Block]
rest) =
WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
bulletListItemToMs WriterOptions
opts ([Inline] -> Block
Plain [Inline]
firstBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
rest)
bulletListItemToMs WriterOptions
opts (Plain [Inline]
first:[Block]
rest) = do
Doc Text
first' <- WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts ([Inline] -> Block
Plain [Inline]
first)
Doc Text
rest' <- WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
rest
let first'' :: Doc Text
first'' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".IP \\[bu] 3" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
first'
let rest'' :: Doc Text
rest'' = if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
rest
then Doc Text
forall a. Doc a
empty
else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".RS 3" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
rest' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".RE"
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
first'' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
rest'')
bulletListItemToMs WriterOptions
opts (Block
first:[Block]
rest) = do
Doc Text
first' <- WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts Block
first
Doc Text
rest' <- WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
rest
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\[bu] .RS 3" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
first' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
rest' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".RE"
orderedListItemToMs :: PandocMonad m
=> WriterOptions
-> Text
-> Int
-> [Block]
-> MS m (Doc Text)
orderedListItemToMs :: WriterOptions -> Text -> Int -> [Block] -> MS m (Doc Text)
orderedListItemToMs WriterOptions
_ Text
_ Int
_ [] = Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
orderedListItemToMs WriterOptions
opts Text
num Int
indent (Para [Inline]
first:[Block]
rest) =
WriterOptions -> Text -> Int -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Int -> [Block] -> MS m (Doc Text)
orderedListItemToMs WriterOptions
opts Text
num Int
indent ([Inline] -> Block
Plain [Inline]
firstBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
rest)
orderedListItemToMs WriterOptions
opts Text
num Int
indent (Block
first:[Block]
rest) = do
Doc Text
first' <- WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts Block
first
Doc Text
rest' <- WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
rest
let num' :: Text
num' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text -> String
forall r. PrintfType r => String -> r
printf (String
"%" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"s") Text
num
let first'' :: Doc Text
first'' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
".IP \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
num' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
indent) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
first'
let rest'' :: Doc Text
rest'' = if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
rest
then Doc Text
forall a. Doc a
empty
else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".RS " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow Int
indent) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
rest' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".RE"
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
first'' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
rest''
definitionListItemToMs :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
-> MS m (Doc Text)
definitionListItemToMs :: WriterOptions -> ([Inline], [[Block]]) -> MS m (Doc Text)
definitionListItemToMs WriterOptions
opts ([Inline]
label, [[Block]]
defs) = do
Doc Text
labelText <- Char -> MS m (Doc Text) -> MS m (Doc Text)
forall a (m :: * -> *).
(HasChars a, IsString a, PandocMonad m) =>
Char -> MS m (Doc a) -> MS m (Doc a)
withFontFeature Char
'B' (MS m (Doc Text) -> MS m (Doc Text))
-> MS m (Doc Text) -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$
WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts ([Inline] -> MS m (Doc Text)) -> [Inline] -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
breakToSpace [Inline]
label
Doc Text
contents <- if [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
defs
then Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
else ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (StateT WriterState m [Doc Text] -> MS m (Doc Text))
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Block]]
-> ([Block] -> MS m (Doc Text)) -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Block]]
defs (([Block] -> MS m (Doc Text)) -> StateT WriterState m [Doc Text])
-> ([Block] -> MS m (Doc Text)) -> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ \[Block]
blocks -> do
let (Block
first, [Block]
rest) = case [Block]
blocks of
(Para [Inline]
x:[Block]
y) -> ([Inline] -> Block
Plain [Inline]
x,[Block]
y)
(Block
x:[Block]
y) -> (Block
x,[Block]
y)
[] -> ([Inline] -> Block
Plain [], [])
Doc Text
rest' <- ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (StateT WriterState m [Doc Text] -> MS m (Doc Text))
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$
(Block -> MS m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Block
item -> WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts Block
item) [Block]
rest
Doc Text
first' <- WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts Block
first
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
first' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".RS 3" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
rest' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".RE"
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".IP " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes Doc Text
labelText Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" 3") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
contents
blockListToMs :: PandocMonad m
=> WriterOptions
-> [Block]
-> MS m (Doc Text)
blockListToMs :: WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
blocks =
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> MS m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts) [Block]
blocks
inlineListToMs :: PandocMonad m => WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs :: WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> MS m (Doc Text))
-> [Inline] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Inline -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts) [Inline]
lst
inlineListToMs' :: PandocMonad m => WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' :: WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts [Inline]
lst = do
Doc Text
x <- [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> MS m (Doc Text))
-> [Inline] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Inline -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts) [Inline]
lst
Doc Text
y <- WriterOptions -> Doc Text -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes WriterOptions
opts Doc Text
forall a. Doc a
empty
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
y
inlineToMs :: PandocMonad m => WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs :: WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts (Span (Text, [Text], [(Text, Text)])
_ [Inline]
ils) = WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
ils
inlineToMs WriterOptions
opts (Emph [Inline]
lst) =
Char -> MS m (Doc Text) -> MS m (Doc Text)
forall a (m :: * -> *).
(HasChars a, IsString a, PandocMonad m) =>
Char -> MS m (Doc a) -> MS m (Doc a)
withFontFeature Char
'I' (WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst)
inlineToMs WriterOptions
opts (Underline [Inline]
lst) =
WriterOptions -> Inline -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts ([Inline] -> Inline
Emph [Inline]
lst)
inlineToMs WriterOptions
opts (Strong [Inline]
lst) =
Char -> MS m (Doc Text) -> MS m (Doc Text)
forall a (m :: * -> *).
(HasChars a, IsString a, PandocMonad m) =>
Char -> MS m (Doc a) -> MS m (Doc a)
withFontFeature Char
'B' (WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst)
inlineToMs WriterOptions
opts (Strikeout [Inline]
lst) = do
Doc Text
contents <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\m[strikecolor]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\m[]"
inlineToMs WriterOptions
opts (Superscript [Inline]
lst) = do
Doc Text
contents <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\*{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\*}"
inlineToMs WriterOptions
opts (Subscript [Inline]
lst) = do
Doc Text
contents <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\*<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\*>"
inlineToMs WriterOptions
opts (SmallCaps [Inline]
lst) = do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stSmallCaps :: Bool
stSmallCaps = Bool -> Bool
not (WriterState -> Bool
stSmallCaps WriterState
st) }
Doc Text
res <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stSmallCaps :: Bool
stSmallCaps = Bool -> Bool
not (WriterState -> Bool
stSmallCaps WriterState
st) }
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
res
inlineToMs WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = do
Doc Text
contents <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'`' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'\''
inlineToMs WriterOptions
opts (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
Doc Text
contents <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\[lq]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\[rq]"
inlineToMs WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
inlineToMs WriterOptions
opts (Code (Text, [Text], [(Text, Text)])
attr Text
str) = do
Doc Text
hlCode <- WriterOptions
-> (Text, [Text], [(Text, Text)]) -> Text -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> (Text, [Text], [(Text, Text)]) -> Text -> MS m (Doc Text)
highlightCode WriterOptions
opts (Text, [Text], [(Text, Text)])
attr Text
str
Char -> MS m (Doc Text) -> MS m (Doc Text)
forall a (m :: * -> *).
(HasChars a, IsString a, PandocMonad m) =>
Char -> MS m (Doc a) -> MS m (Doc a)
withFontFeature Char
'C' (Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
hlCode)
inlineToMs WriterOptions
opts (Str Text
str) = do
let shim :: Doc a
shim = case Text -> Maybe (Char, Text)
T.uncons Text
str of
Just (Char
'.',Text
_) -> Text -> Doc a
forall a. Text -> Doc a
afterBreak Text
"\\&"
Maybe (Char, Text)
_ -> Doc a
forall a. Doc a
empty
Bool
smallcaps <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stSmallCaps
if Bool
smallcaps
then Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
shim Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
toSmallCaps WriterOptions
opts Text
str)
else Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
shim Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
escapeStr WriterOptions
opts Text
str)
inlineToMs WriterOptions
opts (Math MathType
InlineMath Text
str) = do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasInlineMath :: Bool
stHasInlineMath = Bool
True }
Either Inline Text
res <- (DisplayType -> [Exp] -> Text)
-> MathType -> Text -> StateT WriterState m (Either Inline Text)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Text
writeEqn MathType
InlineMath Text
str
case Either Inline Text
res of
Left Inline
il -> WriterOptions -> Inline -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts Inline
il
Right Text
r -> Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"@" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
r Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"@"
inlineToMs WriterOptions
opts (Math MathType
DisplayMath Text
str) = do
Either Inline Text
res <- (DisplayType -> [Exp] -> Text)
-> MathType -> Text -> StateT WriterState m (Either Inline Text)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Text
writeEqn MathType
InlineMath Text
str
case Either Inline Text
res of
Left Inline
il -> do
Doc Text
contents <- WriterOptions -> Inline -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts Inline
il
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".RS 3" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".RE"
Right Text
r -> Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$
Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".EQ" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
r Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".EN" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToMs WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"ms" = Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
| Bool
otherwise = do
LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToMs WriterOptions
_ Inline
LineBreak = Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".br" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToMs WriterOptions
opts Inline
SoftBreak =
WriterOptions -> Doc Text -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes WriterOptions
opts (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$
case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
WrapOption
WrapAuto -> Doc Text
forall a. Doc a
space
WrapOption
WrapNone -> Doc Text
forall a. Doc a
space
WrapOption
WrapPreserve -> Doc Text
forall a. Doc a
cr
inlineToMs WriterOptions
opts Inline
Space = WriterOptions -> Doc Text -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes WriterOptions
opts Doc Text
forall a. Doc a
space
inlineToMs WriterOptions
opts (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'#',Text
ident), Text
_)) = do
Doc Text
contents <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts ([Inline] -> MS m (Doc Text)) -> [Inline] -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
breakToSpace [Inline]
txt
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\c" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".pdfhref L -D " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
toAscii Text
ident)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" -A " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\c") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" -- " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
contents) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\&"
inlineToMs WriterOptions
opts (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text
src, Text
_)) = do
Doc Text
contents <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts ([Inline] -> MS m (Doc Text)) -> [Inline] -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
breakToSpace [Inline]
txt
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\c" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".pdfhref W -D " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeUri Text
src)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" -A " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\c") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" -- " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
contents) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\&"
inlineToMs WriterOptions
opts (Image (Text, [Text], [(Text, Text)])
_ [Inline]
alternate (Text
_, Text
_)) =
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'[' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"IMAGE: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
escapeStr WriterOptions
opts ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
alternate))
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
']'
inlineToMs WriterOptions
_ (Note [Block]
contents) = do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stNotes :: [[Block]]
stNotes = [Block]
contents [Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
: WriterState -> [[Block]]
stNotes WriterState
st }
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\**"
cslEntryToMs :: PandocMonad m
=> Bool
-> WriterOptions
-> Block
-> MS m (Doc Text)
cslEntryToMs :: Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
atStart WriterOptions
opts (Para [Inline]
xs) =
case [Inline]
xs of
(Span (Text
"",[Text
"csl-left-margin"],[]) [Inline]
lils :
rest :: [Inline]
rest@(Span (Text
"",[Text
"csl-right-inline"],[]) [Inline]
_ : [Inline]
_))
-> do Doc Text
lils' <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts [Inline]
lils
((Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".IP " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
lils') Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" 5") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$)
(Doc Text -> Doc Text) -> MS m (Doc Text) -> MS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
False WriterOptions
opts ([Inline] -> Block
Para [Inline]
rest)
(Span (Text
"",[Text
"csl-block"],[]) [Inline]
ils : [Inline]
rest)
-> ((Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".LP") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$)
(Doc Text -> Doc Text) -> MS m (Doc Text) -> MS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
False WriterOptions
opts ([Inline] -> Block
Para ([Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
rest))
(Span (Text
"",[Text
"csl-left-margin"],[]) [Inline]
ils : [Inline]
rest)
-> ((Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".LP") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$)
(Doc Text -> Doc Text) -> MS m (Doc Text) -> MS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
False WriterOptions
opts ([Inline] -> Block
Para ([Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
rest))
(Span (Text
"",[Text
"csl-indented"],[]) [Inline]
ils : [Inline]
rest)
-> ((Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".LP") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$)
(Doc Text -> Doc Text) -> MS m (Doc Text) -> MS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
False WriterOptions
opts ([Inline] -> Block
Para ([Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
rest))
[Inline]
_ | Bool
atStart
-> (Doc Text
".CSLP" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$) (Doc Text -> Doc Text) -> MS m (Doc Text) -> MS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
False WriterOptions
opts ([Inline] -> Block
Para [Inline]
xs)
| Bool
otherwise
-> case [Inline]
xs of
[] -> Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
(Inline
x:[Inline]
rest) -> Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
(<>) (Doc Text -> Doc Text -> Doc Text)
-> MS m (Doc Text) -> StateT WriterState m (Doc Text -> Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Inline -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts Inline
x
StateT WriterState m (Doc Text -> Doc Text)
-> MS m (Doc Text) -> MS m (Doc Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
False WriterOptions
opts ([Inline] -> Block
Para [Inline]
rest)
cslEntryToMs Bool
_ WriterOptions
opts Block
x = WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts Block
x
handleNotes :: PandocMonad m => WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes :: WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes WriterOptions
opts Doc Text
fallback = do
[[Block]]
notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
if [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
notes
then Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
fallback
else do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stNotes :: [[Block]]
stNotes = [] }
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> MS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> MS m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
handleNote WriterOptions
opts) [[Block]]
notes
handleNote :: PandocMonad m => WriterOptions -> Note -> MS m (Doc Text)
handleNote :: WriterOptions -> [Block] -> MS m (Doc Text)
handleNote WriterOptions
opts [Block]
bs = do
let bs' :: [Block]
bs' = case [Block]
bs of
(Para [Inline]
ils : [Block]
rest) -> [Inline] -> Block
Plain [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
[Block]
_ -> [Block]
bs
Doc Text
contents <- WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
bs'
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".FS" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".FE" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
setFirstPara :: PandocMonad m => MS m ()
setFirstPara :: MS m ()
setFirstPara = (WriterState -> WriterState) -> MS m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> MS m ())
-> (WriterState -> WriterState) -> MS m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stFirstPara :: Bool
stFirstPara = Bool
True }
resetFirstPara :: PandocMonad m => MS m ()
resetFirstPara :: MS m ()
resetFirstPara = (WriterState -> WriterState) -> MS m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> MS m ())
-> (WriterState -> WriterState) -> MS m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stFirstPara :: Bool
stFirstPara = Bool
False }
breakToSpace :: Inline -> Inline
breakToSpace :: Inline -> Inline
breakToSpace Inline
SoftBreak = Inline
Space
breakToSpace Inline
LineBreak = Inline
Space
breakToSpace Inline
x = Inline
x
styleToMs :: Style -> Doc Text
styleToMs :: Style -> Doc Text
styleToMs Style
sty = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text]
colordefs [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. Semigroup a => a -> a -> a
<> (TokenType -> Doc Text) -> [TokenType] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Style -> TokenType -> Doc Text
toMacro Style
sty) [TokenType]
alltoktypes
where alltoktypes :: [TokenType]
alltoktypes = TokenType -> TokenType -> [TokenType]
forall a. Enum a => a -> a -> [a]
enumFromTo TokenType
KeywordTok TokenType
NormalTok
colordefs :: [Doc Text]
colordefs = (Color -> Doc Text) -> [Color] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Color -> Doc Text
toColorDef [Color]
allcolors
toColorDef :: Color -> Doc Text
toColorDef Color
c = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
".defcolor " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Color -> Text
hexColor Color
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" rgb #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text
hexColor Color
c)
allcolors :: [Color]
allcolors = [Maybe Color] -> [Color]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Color] -> [Color]) -> [Maybe Color] -> [Color]
forall a b. (a -> b) -> a -> b
$ [Maybe Color] -> [Maybe Color]
forall a. Ord a => [a] -> [a]
ordNub ([Maybe Color] -> [Maybe Color]) -> [Maybe Color] -> [Maybe Color]
forall a b. (a -> b) -> a -> b
$
[Style -> Maybe Color
defaultColor Style
sty, Style -> Maybe Color
backgroundColor Style
sty,
Style -> Maybe Color
lineNumberColor Style
sty, Style -> Maybe Color
lineNumberBackgroundColor Style
sty] [Maybe Color] -> [Maybe Color] -> [Maybe Color]
forall a. Semigroup a => a -> a -> a
<>
((TokenType, TokenStyle) -> [Maybe Color])
-> [(TokenType, TokenStyle)] -> [Maybe Color]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TokenStyle -> [Maybe Color]
colorsForToken(TokenStyle -> [Maybe Color])
-> ((TokenType, TokenStyle) -> TokenStyle)
-> (TokenType, TokenStyle)
-> [Maybe Color]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokenType, TokenStyle) -> TokenStyle
forall a b. (a, b) -> b
snd) (Map TokenType TokenStyle -> [(TokenType, TokenStyle)]
forall k a. Map k a -> [(k, a)]
Map.toList (Style -> Map TokenType TokenStyle
tokenStyles Style
sty))
colorsForToken :: TokenStyle -> [Maybe Color]
colorsForToken TokenStyle
ts = [TokenStyle -> Maybe Color
tokenColor TokenStyle
ts, TokenStyle -> Maybe Color
tokenBackground TokenStyle
ts]
hexColor :: Color -> Text
hexColor :: Color -> Text
hexColor (RGB Word8
r Word8
g Word8
b) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Word8 -> Word8 -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x%02x%02x" Word8
r Word8
g Word8
b
toMacro :: Style -> TokenType -> Doc Text
toMacro :: Style -> TokenType -> Doc Text
toMacro Style
sty TokenType
toktype =
Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".ds " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (TokenType -> Text
forall a. Show a => a -> Text
tshow TokenType
toktype) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text
forall a. Doc a
setbg Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
setcolor Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
setfont Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\\\$1" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text
resetfont Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
resetcolor Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
resetbg)
where setcolor :: Doc Text
setcolor = Doc Text -> (Color -> Doc Text) -> Maybe Color -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
forall a. Doc a
empty Color -> Doc Text
fgcol Maybe Color
tokCol
resetcolor :: Doc Text
resetcolor = Doc Text -> (Color -> Doc Text) -> Maybe Color -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
forall a. Doc a
empty (Doc Text -> Color -> Doc Text
forall a b. a -> b -> a
const (Doc Text -> Color -> Doc Text) -> Doc Text -> Color -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\\\m[]") Maybe Color
tokCol
setbg :: Doc a
setbg = Doc a
forall a. Doc a
empty
resetbg :: Doc a
resetbg = Doc a
forall a. Doc a
empty
fgcol :: Color -> Doc Text
fgcol Color
c = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"\\\\m[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text
hexColor Color
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
setfont :: Doc Text
setfont = if Bool
tokBold Bool -> Bool -> Bool
|| Bool
tokItalic
then Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"\\\\f[C" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'B' | Bool
tokBold] String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
[Char
'I' | Bool
tokItalic] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]"
else Doc Text
forall a. Doc a
empty
resetfont :: Doc Text
resetfont = if Bool
tokBold Bool -> Bool -> Bool
|| Bool
tokItalic
then Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\\\f[C]"
else Doc Text
forall a. Doc a
empty
tokSty :: Maybe TokenStyle
tokSty = TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TokenType
toktype (Style -> Map TokenType TokenStyle
tokenStyles Style
sty)
tokCol :: Maybe Color
tokCol = (Maybe TokenStyle
tokSty Maybe TokenStyle -> (TokenStyle -> Maybe Color) -> Maybe Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TokenStyle -> Maybe Color
tokenColor) Maybe Color -> Maybe Color -> Maybe Color
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Style -> Maybe Color
defaultColor Style
sty
tokBold :: Bool
tokBold = Bool -> (TokenStyle -> Bool) -> Maybe TokenStyle -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False TokenStyle -> Bool
tokenBold Maybe TokenStyle
tokSty
tokItalic :: Bool
tokItalic = Bool -> (TokenStyle -> Bool) -> Maybe TokenStyle -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False TokenStyle -> Bool
tokenItalic Maybe TokenStyle
tokSty
msFormatter :: WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
msFormatter :: WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
msFormatter WriterOptions
opts FormatOptions
_fmtopts =
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text)
-> ([SourceLine] -> Text) -> [SourceLine] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text)
-> ([SourceLine] -> [Text]) -> [SourceLine] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceLine -> Text) -> [SourceLine] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SourceLine -> Text
fmtLine
where
fmtLine :: SourceLine -> Text
fmtLine = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (SourceLine -> [Text]) -> SourceLine -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenType, Text) -> Text) -> SourceLine -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (TokenType, Text) -> Text
forall a. Show a => (a, Text) -> Text
fmtToken
fmtToken :: (a, Text) -> Text
fmtToken (a
toktype, Text
tok) =
Text
"\\*[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
toktype Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Text -> Text
escapeStr WriterOptions
opts Text
tok Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"]"
highlightCode :: PandocMonad m => WriterOptions -> Attr -> Text -> MS m (Doc Text)
highlightCode :: WriterOptions
-> (Text, [Text], [(Text, Text)]) -> Text -> MS m (Doc Text)
highlightCode WriterOptions
opts (Text, [Text], [(Text, Text)])
attr Text
str =
case SyntaxMap
-> (FormatOptions -> [SourceLine] -> Doc Text)
-> (Text, [Text], [(Text, Text)])
-> Text
-> Either Text (Doc Text)
forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> (Text, [Text], [(Text, Text)])
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts) (WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
msFormatter WriterOptions
opts) (Text, [Text], [(Text, Text)])
attr Text
str of
Left Text
msg -> do
Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> MS m (Doc Text)) -> Doc Text -> MS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
escapeStr WriterOptions
opts Text
str)
Right Doc Text
h -> do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stHighlighting :: Bool
stHighlighting = Bool
True })
Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
h
toAscii :: Text -> Text
toAscii :: Text -> Text
toAscii = (Char -> Text) -> Text -> Text
T.concatMap
(\Char
c -> case Char -> Maybe Char
toAsciiChar Char
c of
Maybe Char
Nothing -> 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
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
Just Char
'/' -> 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
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
Just Char
c' -> Char -> Text
T.singleton Char
c')