{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.Ms ( writeMs ) where
import Prelude
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, fromMaybe)
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, 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 opts :: WriterOptions
opts document :: 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 opts :: WriterOptions
opts (Pandoc meta :: Meta
meta blocks :: [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 case WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts of
Nothing -> Doc Text
forall a. Monoid a => a
mempty
Just sty :: Style
sty -> Style -> Doc Text
styleToMs Style
sty
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 "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 "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 "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 "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 "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 "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 "author-meta" (Text -> [Text] -> Text
T.intercalate "; " [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 "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
Nothing -> Doc Text
main
Just tpl :: 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 opts :: 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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '@' 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 opts :: WriterOptions
opts s :: Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
Nothing -> ""
Just (c :: Char
c, cs :: Text
cs)
| Char -> Bool
isLower Char
c -> let (lowers :: Text
lowers,rest :: Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isLower Text
s
in "\\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
<>
"\\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 (uppers :: Text
uppers,rest :: 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 _ Null = Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToMs opts :: WriterOptions
opts (Div (ident :: Text
ident,_,_) bs :: [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 ".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))
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 opts :: WriterOptions
opts (Plain inlines :: [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 opts :: WriterOptions
opts (Para [Image attr :: Attr
attr alt :: [Inline]
alt (src :: Text
src,_tit :: 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
== ".ps" Bool -> Bool -> Bool
|| String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ".eps") = do
let (mbW :: Maybe Double
mbW,mbH :: 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 -> Attr -> Maybe Dimension
dimension Direction
Width Attr
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 -> Attr -> Maybe Dimension
dimension Direction
Height Attr
attr)
let sizeAttrs :: Doc Text
sizeAttrs = case (Maybe Double
mbW, Maybe Double
mbH) of
(Just wp :: Double
wp, 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
<> "p"))
(Just wp :: Double
wp, Just hp :: 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
<> "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)))
_ -> 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 ".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 ".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 ".ce 0"
blockToMs opts :: WriterOptions
opts (Para inlines :: [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 ".LP" else ".PP") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToMs _ b :: Block
b@(RawBlock f :: Format
f str :: Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "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 _ 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 ".HLINE"
blockToMs opts :: WriterOptions
opts (Header level :: Int
level (ident :: Text
ident,classes :: [Text]
classes,_) inlines :: [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
$ \st :: 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
$ \st :: WriterState
st -> WriterState
st{ stInHeader :: Bool
stInHeader = Bool
False }
let (heading :: Text
heading, secnum :: Text
secnum) = if WriterOptions -> Bool
writerNumberSections WriterOptions
opts Bool -> Bool -> Bool
&&
"unnumbered" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes
then (".NH", "\\*[SN]")
else (".SH", "")
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 ".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 ".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
<> " ") 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 ""
else " ") 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 ".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 "\\") 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 " -- "
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 ".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 "\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 "\\~\\~")
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 ".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
$ \st :: 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 opts :: WriterOptions
opts (CodeBlock attr :: Attr
attr str :: Text
str) = do
Doc Text
hlCode <- WriterOptions -> Attr -> Text -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Text -> MS m (Doc Text)
highlightCode WriterOptions
opts Attr
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 ".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 ".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 "\\f[C]" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc 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 "\\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 ".fi"
blockToMs opts :: WriterOptions
opts (LineBlock ls :: [[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 opts :: WriterOptions
opts (BlockQuote blocks :: [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 ".RS" 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 ".RE"
blockToMs opts :: WriterOptions
opts (Table caption :: [Inline]
caption alignments :: [Alignment]
alignments widths :: [Double]
widths headers :: [[Block]]
headers rows :: [[[Block]]]
rows) =
let aligncode :: Alignment -> p
aligncode AlignLeft = "l"
aligncode AlignRight = "r"
aligncode AlignCenter = "c"
aligncode AlignDefault = "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
== 0) [Double]
widths
then Text -> [Text]
forall a. a -> [a]
repeat ""
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 "w(%0.1fn)" (Double -> String) -> (Double -> Double) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 (\align :: Alignment
align width :: 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
<> "."
[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 cols :: [Doc a]
cols = a -> Doc a
forall a. HasChars a => a -> Doc a
literal "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 "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 "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 '_'
[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 (\row :: [[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 ".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 ".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 "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 ".TE"
blockToMs opts :: WriterOptions
opts (BulletList items :: [[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 opts :: WriterOptions
opts (OrderedList attribs :: ListAttributes
attribs items :: [[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 = 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 (\(num :: Text
num, item :: [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 opts :: WriterOptions
opts (DefinitionList items :: [([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 _ [] = Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
bulletListItemToMs opts :: WriterOptions
opts (Para first :: [Inline]
first:rest :: [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 opts :: WriterOptions
opts (Plain first :: [Inline]
first:rest :: [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 ".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 ".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 ".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 opts :: WriterOptions
opts (first :: Block
first:rest :: [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 "\\[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 ".RE"
orderedListItemToMs :: PandocMonad m
=> WriterOptions
-> Text
-> Int
-> [Block]
-> MS m (Doc Text)
orderedListItemToMs :: WriterOptions -> Text -> Int -> [Block] -> MS m (Doc Text)
orderedListItemToMs _ _ _ [] = Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
orderedListItemToMs opts :: WriterOptions
opts num :: Text
num indent :: Int
indent (Para first :: [Inline]
first:rest :: [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 opts :: WriterOptions
opts num :: Text
num indent :: Int
indent (first :: Block
first:rest :: [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
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
- 1) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "s") Text
num
let first'' :: Doc Text
first'' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (".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
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 ".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 ".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 opts :: WriterOptions
opts (label :: [Inline]
label, defs :: [[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 '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
$ \blocks :: [Block]
blocks -> do
let (first :: Block
first, rest :: [Block]
rest) = case [Block]
blocks of
(Para x :: [Inline]
x:y :: [Block]
y) -> ([Inline] -> Block
Plain [Inline]
x,[Block]
y)
(x :: Block
x:y :: [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 (\item :: 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 ".RS" 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 ".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 ".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. 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 opts :: WriterOptions
opts blocks :: [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 opts :: WriterOptions
opts lst :: [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' opts :: WriterOptions
opts lst :: [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 opts :: WriterOptions
opts (Span _ ils :: [Inline]
ils) = WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
ils
inlineToMs opts :: WriterOptions
opts (Emph lst :: [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 'I' (WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst)
inlineToMs opts :: WriterOptions
opts (Strong lst :: [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 'B' (WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst)
inlineToMs opts :: WriterOptions
opts (Strikeout lst :: [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 "\\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 "\\m[]"
inlineToMs opts :: WriterOptions
opts (Superscript lst :: [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 "\\*{" 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 "\\*}"
inlineToMs opts :: WriterOptions
opts (Subscript lst :: [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 "\\*<" 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 "\\*>"
inlineToMs opts :: WriterOptions
opts (SmallCaps lst :: [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
$ \st :: 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
$ \st :: 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 opts :: WriterOptions
opts (Quoted SingleQuote lst :: [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 '`' 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 '\''
inlineToMs opts :: WriterOptions
opts (Quoted DoubleQuote lst :: [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 "\\[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 "\\[rq]"
inlineToMs opts :: WriterOptions
opts (Cite _ lst :: [Inline]
lst) =
WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
inlineToMs opts :: WriterOptions
opts (Code attr :: Attr
attr str :: Text
str) = do
Doc Text
hlCode <- WriterOptions -> Attr -> Text -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Text -> MS m (Doc Text)
highlightCode WriterOptions
opts Attr
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 'C' (Doc Text -> MS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
hlCode)
inlineToMs opts :: WriterOptions
opts (Str str :: Text
str) = do
let shim :: Doc a
shim = case Text -> Maybe (Char, Text)
T.uncons Text
str of
Just ('.',_) -> Text -> Doc a
forall a. Text -> Doc a
afterBreak "\\&"
_ -> 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 opts :: WriterOptions
opts (Math InlineMath str :: 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
$ \st :: 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 il :: Inline
il -> WriterOptions -> Inline -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts Inline
il
Right r :: 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 "@" 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 "@"
inlineToMs opts :: WriterOptions
opts (Math DisplayMath str :: 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 il :: 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 ".RS" 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 ".RE"
Right r :: 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 ".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 ".EN" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToMs _ il :: Inline
il@(RawInline f :: Format
f str :: Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "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 _ 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 ".br" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToMs opts :: WriterOptions
opts 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
WrapAuto -> Doc Text
forall a. Doc a
space
WrapNone -> Doc Text
forall a. Doc a
space
WrapPreserve -> Doc Text
forall a. Doc a
cr
inlineToMs opts :: WriterOptions
opts 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 opts :: WriterOptions
opts (Link _ txt :: [Inline]
txt (Text -> Maybe (Char, Text)
T.uncons -> Just ('#',ident :: Text
ident), _)) = 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 "\\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 ".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 " -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 "\\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 "\\") 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 " -- " 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 "\\&"
inlineToMs opts :: WriterOptions
opts (Link _ txt :: [Inline]
txt (src :: Text
src, _)) = 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 "\\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 ".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 " -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 "\\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 "\\") 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 " -- " 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 "\\&"
inlineToMs opts :: WriterOptions
opts (Image _ alternate :: [Inline]
alternate (_, _)) =
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 '[' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "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 ']'
inlineToMs _ (Note contents :: [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
$ \st :: 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 "\\**"
handleNotes :: PandocMonad m => WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes :: WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes opts :: WriterOptions
opts fallback :: 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
$ \st :: 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 opts :: WriterOptions
opts bs :: [Block]
bs = do
let bs' :: [Block]
bs' = case [Block]
bs of
(Para ils :: [Inline]
ils : rest :: [Block]
rest) -> [Inline] -> Block
Plain [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
_ -> [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 ".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 ".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
$ \st :: 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
$ \st :: WriterState
st -> WriterState
st{ stFirstPara :: Bool
stFirstPara = Bool
False }
breakToSpace :: Inline -> Inline
breakToSpace :: Inline -> Inline
breakToSpace SoftBreak = Inline
Space
breakToSpace LineBreak = Inline
Space
breakToSpace x :: Inline
x = Inline
x
styleToMs :: Style -> Doc Text
styleToMs :: Style -> Doc Text
styleToMs sty :: 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 c :: Color
c = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (".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
<> " 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 ts :: TokenStyle
ts = [TokenStyle -> Maybe Color
tokenColor TokenStyle
ts, TokenStyle -> Maybe Color
tokenBackground TokenStyle
ts]
hexColor :: Color -> Text
hexColor :: Color -> Text
hexColor (RGB r :: Word8
r g :: Word8
g b :: 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 "%02x%02x%02x" Word8
r Word8
g Word8
b
toMacro :: Style -> TokenType -> Doc Text
toMacro :: Style -> TokenType -> Doc Text
toMacro sty :: Style
sty toktype :: 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 ".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 " " 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 "\\\\$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 "\\\\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 c :: 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
$ "\\\\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
<> "]"
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
$ "\\\\f[C" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ['B' | Bool
tokBold] String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
['I' | Bool
tokItalic] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "]"
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 "\\\\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 -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (TokenStyle -> Bool
tokenBold (TokenStyle -> Bool) -> Maybe TokenStyle -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TokenStyle
tokSty)
tokItalic :: Bool
tokItalic = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (TokenStyle -> Bool
tokenItalic (TokenStyle -> Bool) -> Maybe TokenStyle -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TokenStyle
tokSty)
msFormatter :: WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
msFormatter :: WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
msFormatter opts :: WriterOptions
opts _fmtopts :: FormatOptions
_fmtopts =
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ([SourceLine] -> [Doc Text]) -> [SourceLine] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceLine -> Doc Text) -> [SourceLine] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map SourceLine -> Doc Text
fmtLine
where fmtLine :: SourceLine -> Doc Text
fmtLine = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> (SourceLine -> [Doc Text]) -> SourceLine -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenType, Text) -> Doc Text) -> SourceLine -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (TokenType, Text) -> Doc Text
forall a. Show a => (a, Text) -> Doc Text
fmtToken
fmtToken :: (a, Text) -> Doc Text
fmtToken (toktype :: a
toktype, tok :: Text
tok) = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "\\*" 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
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (a -> Text
forall a. Show a => a -> Text
tshow a
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 " \""
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
tok) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "\"")
highlightCode :: PandocMonad m => WriterOptions -> Attr -> Text -> MS m (Doc Text)
highlightCode :: WriterOptions -> Attr -> Text -> MS m (Doc Text)
highlightCode opts :: WriterOptions
opts attr :: Attr
attr str :: Text
str =
case SyntaxMap
-> (FormatOptions -> [SourceLine] -> Doc Text)
-> Attr
-> Text
-> Either Text (Doc Text)
forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts) (WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
msFormatter WriterOptions
opts) Attr
attr Text
str of
Left msg :: 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 h :: Doc Text
h -> do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: 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
(\c :: Char
c -> case Char -> Maybe Char
toAsciiChar Char
c of
Nothing -> "_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
<> "_"
Just '/' -> "_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
<> "_"
Just c' :: Char
c' -> Char -> Text
T.singleton Char
c')