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

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

Conversion of 'Pandoc' documents to roff ms format.

TODO:

[ ] use base URL to construct absolute URLs from relative ones for external
    links
[ ] is there a better way to do strikeout?
[ ] tight/loose list distinction
-}

module Text.Pandoc.Writers.Ms ( writeMs ) where
import Control.Monad.State.Strict
    ( gets, modify, evalStateT )
import Control.Monad ( MonadPlus(mplus), liftM, unless, forM )
import Data.Containers.ListUtils (nubOrd)
import Data.Char (isAscii, isLower, isUpper, ord)
import Data.List (intercalate, intersperse)
import Data.List.NonEmpty (nonEmpty)
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)
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString as B

-- | Convert Pandoc to Ms.
writeMs :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMs :: forall (m :: * -> *).
PandocMonad m =>
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

-- | Return roff ms representation of document.
pandocToMs :: PandocMonad m => WriterOptions -> Pandoc -> MS m Text
pandocToMs :: forall (m :: * -> *).
PandocMonad m =>
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
  Doc Text
title <- Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (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
<$> WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts (Text -> Meta -> [Inline]
lookupMetaInlines Text
"title" Meta
meta)
  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 a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
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 -> 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 -> 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
resetField Text
"title" Doc Text
title Context Text
metadata
  Text -> MS m Text
forall a. a -> StateT WriterState m a
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)

-- In PDFs we need to escape parentheses and backslash.
-- In PDF we need to encode as UTF-16 BE.
escapePDFString :: Text -> Text
escapePDFString :: Text -> Text
escapePDFString Text
t
  | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
t =
    HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"(" Text
"\\(" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
")" Text
"\\)" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
t
  | Bool
otherwise = (Text
"\\376\\377" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  -- add bom
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> String -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
encodeChar (String -> [Text]) -> (Text -> String) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Text -> String
T.unpack (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
t
 where
  encodeChar :: Char -> Text
encodeChar Char
c =
    if Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'(' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')'
       then Text
"\\000" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c
       else [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Text) -> [Word8] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Text
forall {t}. PrintfArg t => t -> Text
toOctal ([Word8] -> [Text]) -> (Text -> [Word8]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack (ByteString -> [Word8]) -> (Text -> ByteString) -> Text -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf16BE (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
  toOctal :: t -> Text
toOctal t
n = Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> t -> String
forall r. PrintfType r => String -> r
printf String
"%03o" t
n)

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

-- We split inline lists into sentences, and print one sentence per
-- line.  roff treats the line-ending period differently.
-- See http://code.google.com/p/pandoc/issues/detail?id=148.

blockToMs :: PandocMonad m
          => WriterOptions -- ^ Options
          -> Block         -- ^ Block element
          -> MS m (Doc Text)
blockToMs :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
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 a. Eq a => a -> [a] -> 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. Eq a => a -> [a] -> 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 a. a -> StateT WriterState m a
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
$$
                -- so that XP paragraphs are indented:
                Doc Text
".nr PI 3n" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                -- space between entries
                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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
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 a. Eq a => a -> [a] -> 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 a. a -> StateT WriterState m a
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
splitSentences (Doc Text -> Doc Text) -> MS m (Doc Text) -> MS m (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)
inlineListToMs' WriterOptions
opts [Inline]
inlines
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 <- WriterOptions -> [Inline] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts [Inline]
inlines
  Doc Text -> MS m (Doc Text)
forall a. a -> StateT WriterState m a
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 -> Doc Text
splitSentences 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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 = 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 = 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
<>
                                      Text -> Text
escapePDFString ([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 = True }
  Doc Text -> MS m (Doc Text)
forall a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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  -- use .LP, see #5588
  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 a. a -> StateT WriterState m a
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 -> a
aligncode Alignment
AlignLeft    = a
"l"
      aligncode Alignment
AlignRight   = a
"r"
      aligncode Alignment
AlignCenter  = a
"c"
      aligncode Alignment
AlignDefault = a
"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 isSimple :: Bool
isSimple = (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
  let totalWidth :: Double
totalWidth = Double
70
  -- 78n default width - 8n indent = 70n
  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 -> Double -> Text) -> [Alignment] -> [Double] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Alignment
align Double
width -> Alignment -> Text
forall {a}. IsString a => Alignment -> a
aligncode Alignment
align Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                    if Double
width Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
                                       then Text
""
                                       else String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
                                              String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"w(%0.1fn)"
                                              (Double
totalWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
width))
                        [Alignment]
alignments [Double]
widths) 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. [a] -> 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\[[Block]]
row -> do
                         [Doc Text]
cols <- (([Block], Double) -> MS m (Doc Text))
-> [([Block], Double)] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\([Block]
cell, Double
w) ->
                                   (if Bool
isSimple
                                       then Doc Text -> Doc Text
forall a. a -> a
id
                                       else (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
".nr LL " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                              String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%0.1fn"
                                                (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
totalWidth))) 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
<$>
                                   WriterOptions -> [Block] -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
cell) ([[Block]] -> [Double] -> [([Block], Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Block]]
row [Double]
widths)
                         Doc Text -> MS m (Doc Text)
forall a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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
".na" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ -- we don't want justification in table cells
           (if Bool
isSimple
               then Doc Text
""
               else Doc Text
".nr LLold \\n[LL]") 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" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           (if Bool
isSimple
               then Doc Text
""
               else Doc Text
".nr LL \\n[LLold]") 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
".ad"
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> StateT WriterState m a
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 a. [a] -> 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 -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ((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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> StateT WriterState m a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> StateT WriterState m a
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 (Figure (Text, [Text], [(Text, Text)])
figattr (Caption Maybe [Inline]
_ [Block]
caption) [Block]
body) =
  case [Block]
body of
    [Plain [ Image (Text, [Text], [(Text, Text)])
attr [Inline]
_alt (Text
src, Text
_tit) ]] -> do
       let ext :: String
ext = String -> String
takeExtension (Text -> String
T.unpack Text
src)
       let sizeAttrs :: Doc Text
sizeAttrs = WriterOptions -> (Text, [Text], [(Text, Text)]) -> Doc Text
getSizeAttrs WriterOptions
opts (Text, [Text], [(Text, Text)])
attr
       Doc Text
capt <- WriterOptions -> Block -> MS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts ((Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text, [Text], [(Text, Text)])
figattr [Block]
caption)
       let captlines :: Int
captlines = Doc Text -> Int
forall a. HasChars a => Doc a -> Int
height Doc Text
capt
       let cmd :: Text
cmd = case String
ext of
                   String
".ps" -> Text
".PSPIC"
                   String
".eps" -> Text
".PSPIC"
                   String
".pdf" -> Text
".PDFPIC"
                   String
_ -> Text
"\\\" .IMAGE"
       Doc Text -> MS m (Doc Text)
forall a. a -> StateT WriterState m a
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
cmd Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc 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
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
captlines) 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
".sp 1"
    [Block]
_ -> 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
$ (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text, [Text], [(Text, Text)])
figattr [Block]
body

-- | Convert bullet list item (list of blocks) to ms.
bulletListItemToMs :: PandocMonad m => WriterOptions -> [Block] -> MS m (Doc Text)
bulletListItemToMs :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
bulletListItemToMs WriterOptions
_ [] = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
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] -> StateT WriterState 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 -> StateT WriterState 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] -> StateT WriterState 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 a. [a] -> 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 -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
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 -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts Block
first
  Doc Text
rest' <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
rest
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState 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"

-- | Convert ordered list item (a list of blocks) to ms.
orderedListItemToMs :: PandocMonad m
                    => WriterOptions -- ^ options
                    -> Text   -- ^ order marker for list item
                    -> Int      -- ^ number of spaces to indent
                    -> [Block]  -- ^ list item (list of blocks)
                    -> MS m (Doc Text)
orderedListItemToMs :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Int -> [Block] -> MS m (Doc Text)
orderedListItemToMs WriterOptions
_ Text
_ Int
_ [] = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
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] -> StateT WriterState 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 -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts Block
first
  Doc Text
rest' <- WriterOptions -> [Block] -> StateT WriterState 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 a. [a] -> 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 -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState 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''

-- | Convert definition list item (label, list of blocks) to ms.
definitionListItemToMs :: PandocMonad m
                       => WriterOptions
                       -> ([Inline],[[Block]])
                       -> MS m (Doc Text)
definitionListItemToMs :: forall (m :: * -> *).
PandocMonad m =>
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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
defs
                 then Doc Text -> MS m (Doc Text)
forall a. a -> StateT WriterState m a
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 [], [])
                                               -- should not happen
                        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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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

-- | Convert list of Pandoc block elements to ms.
blockListToMs :: PandocMonad m
              => WriterOptions -- ^ Options
              -> [Block]       -- ^ List of block elements
              -> MS m (Doc Text)
blockListToMs :: forall (m :: * -> *).
PandocMonad m =>
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]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT WriterState 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts) [Block]
blocks

-- | Convert list of Pandoc inline elements to ms.
inlineListToMs :: PandocMonad m => WriterOptions -> [Inline] -> MS m (Doc Text)
-- if list starts with ., insert a zero-width character \& so it
-- won't be interpreted as markup if it falls at the beginning of a line.
inlineListToMs :: forall (m :: * -> *).
PandocMonad m =>
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]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> StateT WriterState 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts) [Inline]
lst

-- This version to be used when there is no further inline content;
-- forces a note at the end.
inlineListToMs' :: PandocMonad m => WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' :: forall (m :: * -> *).
PandocMonad m =>
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> StateT WriterState m a
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

-- | Convert Pandoc inline element to ms.
inlineToMs :: PandocMonad m => WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs :: forall (m :: * -> *).
PandocMonad m =>
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
  -- we use grey color instead of strikeout, which seems quite
  -- hard to do in roff for arbitrary bits of text
  Doc Text -> MS m (Doc Text)
forall a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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
  -- see https://lists.gnu.org/archive/html/groff/2015-01/msg00016.html
  (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 = not (stSmallCaps 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 = not (stSmallCaps st) }
  Doc Text -> MS m (Doc Text)
forall a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 = 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 a. a -> StateT WriterState m a
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
DisplayMath 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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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
  -- internal link
  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 a. a -> StateT WriterState m a
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
  -- external link
  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 a. a -> StateT WriterState m a
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)])
attr [Inline]
alternate (Text
src, Text
_)) = do
  let desc :: Doc Text
desc = 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
']'
  let sizeAttrs :: Doc Text
sizeAttrs = WriterOptions -> (Text, [Text], [(Text, Text)]) -> Doc Text
getSizeAttrs WriterOptions
opts (Text, [Text], [(Text, Text)])
attr
  let ext :: String
ext = String -> String
takeExtension (Text -> String
T.unpack Text
src)
  let cmd :: Text
cmd = case String
ext of
             String
".ps" -> Text
".PSPIC"
             String
".eps" -> Text
".PSPIC"
             String
".pdf" -> Text
".PDFPIC"
             String
_ -> Text
""
  Doc Text -> MS m (Doc Text)
forall a. a -> StateT WriterState m a
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
<> Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap
    (if Text -> Bool
T.null Text
cmd
        then Doc Text
desc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc 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
src) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sizeAttrs
        else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
cmd Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc 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
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. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
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 = contents : stNotes st }
  Doc Text -> MS m (Doc Text)
forall a. a -> StateT WriterState m a
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 :: forall (m :: * -> *).
PandocMonad m =>
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 a. a -> StateT WriterState m a
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 a b.
StateT WriterState m (a -> b)
-> StateT WriterState m a -> StateT WriterState m b
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 :: forall (m :: * -> *).
PandocMonad m =>
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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
notes
     then Doc Text -> MS m (Doc Text)
forall a. a -> StateT WriterState m a
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 = [] }
       [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
handleNote WriterOptions
opts [Block]
bs = do
  -- don't start with Paragraph or we'll get a spurious blank
  -- line after the note ref:
  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 a. a -> StateT WriterState m a
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 :: forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara = (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{ stFirstPara = True }

resetFirstPara :: PandocMonad m => MS m ()
resetFirstPara :: forall (m :: * -> *). PandocMonad m => MS m ()
resetFirstPara = (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{ stFirstPara = False }

breakToSpace :: Inline -> Inline
breakToSpace :: Inline -> Inline
breakToSpace Inline
SoftBreak = Inline
Space
breakToSpace Inline
LineBreak = Inline
Space
breakToSpace Inline
x         = Inline
x

-- Highlighting

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]
nubOrd ([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 -- maybe empty bgcol tokBg
        resetbg :: Doc a
resetbg = Doc a
forall a. Doc a
empty -- maybe empty (const $ text "\\\\M[]") tokBg
        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
"]"
        -- bgcol c = literal $ "\\\\M[" <> hexColor c <> "]"
        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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TokenStyle -> Maybe Color
tokenColor) Maybe Color -> Maybe Color -> Maybe Color
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Style -> Maybe Color
defaultColor Style
sty
        -- tokBg  = (tokSty >>= tokenBackground) `mplus` backgroundColor 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
        -- tokUnderline = fromMaybe False (tokSty >>= tokUnderline)
        -- lnColor = lineNumberColor sty
        -- lnBkgColor = lineNumberBackgroundColor sty

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 :: forall (m :: * -> *).
PandocMonad m =>
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 a. a -> StateT WriterState m a
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 = True })
           Doc Text -> MS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
h

-- This is used for PDF anchors.
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
"_" -- see #4515
              Just Char
c' -> Char -> Text
T.singleton Char
c')

getSizeAttrs :: WriterOptions -> Attr -> Doc Text
getSizeAttrs :: WriterOptions -> (Text, [Text], [(Text, Text)]) -> Doc Text
getSizeAttrs WriterOptions
opts (Text, [Text], [(Text, Text)])
attr =
  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 b. Integral b => Double -> b
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 b. Integral b => Double -> b
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 b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
hp :: Int) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"p"))
     (Maybe Double, Maybe Double)
_ -> Doc Text
forall a. Doc a
empty
 where
  mbW :: Maybe Double
mbW = 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
  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 -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Height (Text, [Text], [(Text, Text)])
attr