{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Writers.Ms
   Copyright   : Copyright (C) 2007-2023 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 =
  forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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 forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else forall a. Maybe a
Nothing
  Doc Text
title <- forall a. Doc a -> Doc a
chomp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts (Text -> Meta -> [Inline]
lookupMetaInlines Text
"title" Meta
meta)
  Context Text
metadata <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
              (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts)
              (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Doc a -> Doc a
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts)
              Meta
meta
  Doc Text
main <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
blocks
  Bool
hasInlineMath <- 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Walkable Inline a => a -> Text
stringify) forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta
  let authorsMeta :: [Text]
authorsMeta = forall a b. (a -> b) -> [a] -> [b]
map (WriterOptions -> Text -> Text
escapeStr WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Walkable Inline a => a -> Text
stringify) forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
  Bool
hasHighlighting <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHighlighting
  let highlightingMacros :: Doc Text
highlightingMacros = if Bool
hasHighlighting
                              then forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Style -> Doc Text
styleToMs forall a b. (a -> b) -> a -> b
$ WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts
                              else forall a. Monoid a => a
mempty

  let context :: Context Text
context = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"has-inline-math" Bool
hasInlineMath
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"hyphenate" Bool
True
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
opts)
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"title-meta" Text
titleMeta
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"author-meta" (Text -> [Text] -> Text
T.intercalate Text
"; " [Text]
authorsMeta)
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"highlighting-macros" Doc Text
highlightingMacros
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"title" Doc Text
title Context Text
metadata
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth 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 -> 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 =
    Text -> Text -> Text -> Text
T.replace Text
"(" Text
"\\(" forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Text -> Text -> Text -> Text
T.replace Text
")" Text
"\\)" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\" forall a b. (a -> b) -> a -> b
$ Text
t
  | Bool
otherwise = (Text
"\\376\\377" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
.  -- add bom
    forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
encodeChar forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Text -> String
T.unpack 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 forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'(' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
')'
       then Text
"\\000" forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c
       else forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {t}. PrintfArg t => t -> Text
toOctal forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf16BE forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
  toOctal :: t -> Text
toOctal t
n = Text
"\\" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
"%03o" t
n)

escapeUri :: Text -> Text
escapeUri :: Text -> Text
escapeUri = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
escapeURIString (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'@' Bool -> Bool -> Bool
&& Char -> Bool
isAllowedInURI Char
c) 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" forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Text -> Text
escapeStr WriterOptions
opts (Text -> Text
T.toUpper Text
lowers) forall a. Semigroup a => a -> a -> a
<>
                       Text
"\\s0" 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 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) 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 forall a. Doc a
empty
                  else forall a. IsString a => Doc a -> Doc a
nowrap forall a b. (a -> b) -> a -> b
$
                         forall a. HasChars a => a -> Doc a
literal Text
".pdfhref M "
                         forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. HasChars a => a -> Doc a
literal (Text -> Text
toAscii Text
ident))
  case [Text]
cls of
    [Text]
_ | Text
"csl-entry" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls ->
       (Doc Text
".CSLENTRY" forall a. Doc a -> Doc a -> Doc a
$$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
True WriterOptions
opts) [Block]
bs
      | Text
"csl-bib-body" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls -> do
       Doc Text
res <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
bs
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
anchor forall a. Doc a -> Doc a -> Doc a
$$
                -- so that XP paragraphs are indented:
                Doc Text
".nr PI 3n" forall a. Doc a -> Doc a -> Doc a
$$
                -- space between entries
                Doc Text
".de CSLENTRY" forall a. Doc a -> Doc a -> Doc a
$$
                (case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"entry-spacing" [(Text, Text)]
kvs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead of
                   Just Int
n | Int
n forall a. Ord a => a -> a -> Bool
> (Int
0 :: Int) -> Doc Text
".sp"
                   Maybe Int
_ -> forall a. Monoid a => a
mempty) forall a. Doc a -> Doc a -> Doc a
$$
                Doc Text
".." forall a. Doc a -> Doc a -> Doc a
$$
                Doc Text
".de CSLP" forall a. Doc a -> Doc a -> Doc a
$$
                (if Text
"hanging-indent" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls
                    then Doc Text
".XP"
                    else Doc Text
".LP") forall a. Doc a -> Doc a -> Doc a
$$
                Doc Text
".." forall a. Doc a -> Doc a -> Doc a
$$
                Doc Text
res
    [Text]
_ -> do
       forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
       Doc Text
res <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
bs
       forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
anchor forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
res
blockToMs WriterOptions
opts (Plain [Inline]
inlines) =
  Doc Text -> Doc Text
splitSentences forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts [Inline]
inlines
blockToMs WriterOptions
opts (Para [Inline]
inlines) = do
  Bool
firstPara <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stFirstPara
  forall (m :: * -> *). PandocMonad m => MS m ()
resetFirstPara
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts [Inline]
inlines
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal (if Bool
firstPara then Text
".LP" else Text
".PP") 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 forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"ms" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise        = do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToMs WriterOptions
_ Block
HorizontalRule = do
  forall (m :: * -> *). PandocMonad m => MS m ()
resetFirstPara
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
  forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stInHeader :: Bool
stInHeader = Bool
True }
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
breakToSpace [Inline]
inlines
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stInHeader :: Bool
stInHeader = Bool
False }
  let (Text
heading, Text
secnum) = if WriterOptions -> Bool
writerNumberSections WriterOptions
opts Bool -> Bool -> Bool
&&
                              Text
"unnumbered" 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 forall a. Doc a
empty
                  else forall a. IsString a => Doc a -> Doc a
nowrap forall a b. (a -> b) -> a -> b
$
                         forall a. HasChars a => a -> Doc a
literal Text
".pdfhref M "
                         forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. HasChars a => a -> Doc a
literal (Text -> Text
toAscii Text
ident))
  let bookmark :: Doc Text
bookmark = forall a. HasChars a => a -> Doc a
literal Text
".pdfhref O " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow Int
level forall a. Semigroup a => a -> a -> a
<> Text
" ") forall a. Semigroup a => a -> a -> a
<>
                      forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text
secnum forall a. Semigroup a => a -> a -> a
<>
                                      (if Text -> Bool
T.null Text
secnum
                                          then Text
""
                                          else Text
"  ") forall a. Semigroup a => a -> a -> a
<>
                                      Text -> Text
escapePDFString (forall a. Walkable Inline a => a -> Text
stringify [Inline]
inlines))
  let backlink :: Doc Text
backlink = forall a. IsString a => Doc a -> Doc a
nowrap (forall a. HasChars a => a -> Doc a
literal Text
".pdfhref L -D " forall a. Semigroup a => a -> a -> a
<>
       forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. HasChars a => a -> Doc a
literal (Text -> Text
toAscii Text
ident)) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"\\") forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<>
       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 forall a. Ord a => a -> a -> Bool
<= WriterOptions -> Int
writerTOCDepth WriterOptions
opts
                    then forall a. HasChars a => a -> Doc a
literal Text
".XS"
                         forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
backlink forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
doubleQuotes (
                            forall a. IsString a => Doc a -> Doc a
nowrap (forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
level Text
"\t") forall a. Semigroup a => a -> a -> a
<>
                             (if Text -> Bool
T.null Text
secnum
                                 then forall a. Doc a
empty
                                 else forall a. HasChars a => a -> Doc a
literal Text
secnum forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"\\~\\~")
                              forall a. Semigroup a => a -> a -> a
<> Doc Text
contents))
                         forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
".XE"
                    else forall a. Doc a
empty
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stFirstPara :: Bool
stFirstPara = Bool
True }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a. HasChars a => a -> Doc a
literal Text
heading forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow Int
level)) forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
bookmark forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
anchor 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 <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> (Text, [Text], [(Text, Text)]) -> Text -> MS m (Doc Text)
highlightCode WriterOptions
opts (Text, [Text], [(Text, Text)])
attr Text
str
  forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    forall a. HasChars a => a -> Doc a
literal Text
".IP" forall a. Doc a -> Doc a -> Doc a
$$
    forall a. HasChars a => a -> Doc a
literal Text
".nf" forall a. Doc a -> Doc a -> Doc a
$$
    forall a. HasChars a => a -> Doc a
literal Text
"\\f[C]" forall a. Doc a -> Doc a -> Doc a
$$
    ((case Text -> Maybe (Char, Text)
T.uncons Text
str of
      Just (Char
'.',Text
_) -> forall a. HasChars a => a -> Doc a
literal Text
"\\&"
      Maybe (Char, Text)
_            -> forall a. Monoid a => a
mempty) forall a. Semigroup a => a -> a -> a
<> Doc Text
hlCode) forall a. Doc a -> Doc a -> Doc a
$$
    forall a. HasChars a => a -> Doc a
literal Text
"\\f[]" forall a. Doc a -> Doc a -> Doc a
$$
    forall a. HasChars a => a -> Doc a
literal Text
".fi"
blockToMs WriterOptions
opts (LineBlock [[Inline]]
ls) = do
  forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara  -- use .LP, see #5588
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
ls
blockToMs WriterOptions
opts (BlockQuote [Block]
blocks) = do
  forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
blocks
  forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
".QS" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ 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' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts [Inline]
caption
  let isSimple :: Bool
isSimple = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (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 = forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                        (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Alignment
align Double
width -> forall {a}. IsString a => Alignment -> a
aligncode Alignment
align forall a. Semigroup a => a -> a -> a
<>
                                    if Double
width forall a. Eq a => a -> a -> Bool
== Double
0
                                       then Text
""
                                       else String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
                                              forall r. PrintfType r => String -> r
printf String
"w(%0.1fn)"
                                              (Double
totalWidth forall a. Num a => a -> a -> a
* Double
width))
                        [Alignment]
alignments [Double]
widths) forall a. Semigroup a => a -> a -> a
<> Text
"."
  [Doc Text]
colheadings <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 = forall a. HasChars a => a -> Doc a
literal a
"T{" forall a. Doc a -> Doc a -> Doc a
$$
                     forall a. [Doc a] -> Doc a
vcat (forall a. a -> [a] -> [a]
intersperse (forall a. HasChars a => a -> Doc a
literal a
"T}\tT{") [Doc a]
cols) forall a. Doc a -> Doc a -> Doc a
$$
                     forall a. HasChars a => a -> Doc a
literal a
"T}"
  let colheadings' :: Doc Text
colheadings' = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
                        then forall a. Doc a
empty
                        else forall {a}. HasChars a => [Doc a] -> Doc a
makeRow [Doc Text]
colheadings forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => Char -> Doc a
char Char
'_'
  [Doc Text]
body <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[[Block]]
row -> do
                         [Doc Text]
cols <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\([Block]
cell, Double
w) ->
                                   (if Bool
isSimple
                                       then forall a. a -> a
id
                                       else (forall a. HasChars a => a -> Doc a
literal (Text
".nr LL " forall a. Semigroup a => a -> a -> a
<>
                                              String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
"%0.1fn"
                                                (Double
w forall a. Num a => a -> a -> a
* Double
totalWidth))) forall a. Doc a -> Doc a -> Doc a
$$)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                   forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
cell) (forall a b. [a] -> [b] -> [(a, b)]
zip [[Block]]
row [Double]
widths)
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {a}. HasChars a => [Doc a] -> Doc a
makeRow [Doc Text]
cols) [[[Block]]]
rows
  forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
".PP" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption' forall a. Doc a -> Doc a -> Doc a
$$
           forall a. HasChars a => a -> Doc a
literal Text
".na" 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]") forall a. Doc a -> Doc a -> Doc a
$$
           forall a. HasChars a => a -> Doc a
literal Text
".TS" forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
"delim(@@) tab(\t);" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
coldescriptions forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
colheadings' forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
vcat [Doc Text]
body forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
".TE" forall a. Doc a -> Doc a -> Doc a
$$
           (if Bool
isSimple
               then Doc Text
""
               else Doc Text
".nr LL \\n[LLold]") forall a. Doc a -> Doc a -> Doc a
$$
           forall a. HasChars a => a -> Doc a
literal Text
".ad"
blockToMs WriterOptions
opts (BulletList [[Block]]
items) = do
  [Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
bulletListItemToMs WriterOptions
opts) [[Block]]
items
  forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents)
blockToMs WriterOptions
opts (OrderedList ListAttributes
attribs [[Block]]
items) = do
  let markers :: [Text]
markers = forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
items) forall a b. (a -> b) -> a -> b
$ ListAttributes -> [Text]
orderedListMarkers ListAttributes
attribs
  let indent :: Int
indent = Int
2 forall a. Num a => a -> a -> a
+ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
markers))
  [Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Text
num, [Block]
item) -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Int -> [Block] -> MS m (Doc Text)
orderedListItemToMs WriterOptions
opts Text
num Int
indent [Block]
item) forall a b. (a -> b) -> a -> b
$
              forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
markers [[Block]]
items
  forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents)
blockToMs WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
  [Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> MS m (Doc Text)
definitionListItemToMs WriterOptions
opts) [([Inline], [[Block]])]
items
  forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara
  forall (m :: * -> *) a. Monad m => a -> m a
return (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) ]]
     | let ext :: String
ext = String -> String
takeExtension (Text -> String
T.unpack Text
src)
        in (String
ext forall a. Eq a => a -> a -> Bool
== String
".ps" Bool -> Bool -> Bool
|| String
ext forall a. Eq a => a -> a -> Bool
== String
".eps")
      -> do
         let (Maybe Double
mbW,Maybe Double
mbH) = (WriterOptions -> Dimension -> Double
inPoints WriterOptions
opts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Width (Text, [Text], [(Text, Text)])
attr,
                          WriterOptions -> Dimension -> Double
inPoints WriterOptions
opts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Height (Text, [Text], [(Text, Text)])
attr)
         let sizeAttrs :: Doc Text
sizeAttrs = case (Maybe Double
mbW, Maybe Double
mbH) of
                              (Just Double
wp, Maybe Double
Nothing) -> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
doubleQuotes
                                     (forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow (forall a b. (RealFrac a, Integral b) => a -> b
floor Double
wp :: Int) forall a. Semigroup a => a -> a -> a
<> Text
"p"))
                              (Just Double
wp, Just Double
hp) -> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
doubleQuotes
                                     (forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow (forall a b. (RealFrac a, Integral b) => a -> b
floor Double
wp :: Int) forall a. Semigroup a => a -> a -> a
<> Text
"p"))
                                     forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<>
                                     forall a. HasChars a => Doc a -> Doc a
doubleQuotes
                                      (forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow (forall a b. (RealFrac a, Integral b) => a -> b
floor Double
hp :: Int)))
                              (Maybe Double, Maybe Double)
_ -> forall a. Doc a
empty
         Doc Text
capt <- 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 = forall a. HasChars a => Doc a -> Int
height Doc Text
capt
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Doc a -> Doc a
nowrap (forall a. HasChars a => a -> Doc a
literal Text
".PSPIC " forall a. Semigroup a => a -> a -> a
<>
                    forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
escapeStr WriterOptions
opts Text
src)) forall a. Semigroup a => a -> a -> a
<>
                    Doc Text
sizeAttrs) forall a. Doc a -> Doc a -> Doc a
$$
                  forall a. HasChars a => a -> Doc a
literal (Text
".ce " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
captlines) forall a. Doc a -> Doc a -> Doc a
$$
                  Doc Text
capt forall a. Doc a -> Doc a -> Doc a
$$
                  forall a. HasChars a => a -> Doc a
literal Text
".sp 1"
    [Block]
_ -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts 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
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
bulletListItemToMs WriterOptions
opts (Para [Inline]
first:[Block]
rest) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
bulletListItemToMs WriterOptions
opts ([Inline] -> Block
Plain [Inline]
firstforall a. a -> [a] -> [a]
:[Block]
rest)
bulletListItemToMs WriterOptions
opts (Plain [Inline]
first:[Block]
rest) = do
  Doc Text
first' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts ([Inline] -> Block
Plain [Inline]
first)
  Doc Text
rest' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
rest
  let first'' :: Doc Text
first'' = forall a. HasChars a => a -> Doc a
literal Text
".IP \\[bu] 3" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
first'
  let rest'' :: Doc Text
rest''  = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
rest
                   then forall a. Doc a
empty
                   else forall a. HasChars a => a -> Doc a
literal Text
".RS 3" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
rest' forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
".RE"
  forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
first'' forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
rest'')
bulletListItemToMs WriterOptions
opts (Block
first:[Block]
rest) = do
  Doc Text
first' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts Block
first
  Doc Text
rest' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
rest
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"\\[bu] .RS 3" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
first' forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
rest' forall a. Doc a -> Doc a -> Doc a
$$ 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
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
orderedListItemToMs WriterOptions
opts Text
num Int
indent (Para [Inline]
first:[Block]
rest) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Int -> [Block] -> MS m (Doc Text)
orderedListItemToMs WriterOptions
opts Text
num Int
indent ([Inline] -> Block
Plain [Inline]
firstforall a. a -> [a] -> [a]
:[Block]
rest)
orderedListItemToMs WriterOptions
opts Text
num Int
indent (Block
first:[Block]
rest) = do
  Doc Text
first' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts Block
first
  Doc Text
rest' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
rest
  let num' :: Text
num' = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf (String
"%" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Int
indent forall a. Num a => a -> a -> a
- Int
1) forall a. Semigroup a => a -> a -> a
<> String
"s") Text
num
  let first'' :: Doc Text
first'' = forall a. HasChars a => a -> Doc a
literal (Text
".IP \"" forall a. Semigroup a => a -> a -> a
<> Text
num' forall a. Semigroup a => a -> a -> a
<> Text
"\" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
indent) forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
first'
  let rest'' :: Doc Text
rest''  = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
rest
                   then forall a. Doc a
empty
                   else forall a. HasChars a => a -> Doc a
literal Text
".RS " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow Int
indent) forall a. Doc a -> Doc a -> Doc a
$$
                         Doc Text
rest' forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
".RE"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
first'' 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 <- forall a (m :: * -> *).
(HasChars a, IsString a, PandocMonad m) =>
Char -> MS m (Doc a) -> MS m (Doc a)
withFontFeature Char
'B' forall a b. (a -> b) -> a -> b
$
                 forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
breakToSpace [Inline]
label
  Doc Text
contents <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
defs
                 then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
                 else forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Block]]
defs 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' <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$
                                  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Block
item -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts Block
item) [Block]
rest
                        Doc Text
first' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> MS m (Doc Text)
blockToMs WriterOptions
opts Block
first
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
first' forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
".RS 3" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
rest' forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
".RE"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Doc a -> Doc a
nowrap (forall a. HasChars a => a -> Doc a
literal Text
".IP " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
doubleQuotes Doc Text
labelText forall a. Semigroup a => a -> a -> a
<> Doc Text
" 3") 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 =
  forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 = forall a. [Doc a] -> Doc a
hcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 <- forall a. [Doc a] -> Doc a
hcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts) [Inline]
lst
  Doc Text
y <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes WriterOptions
opts forall a. Doc a
empty
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
x 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) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
ils
inlineToMs WriterOptions
opts (Emph [Inline]
lst) =
  forall a (m :: * -> *).
(HasChars a, IsString a, PandocMonad m) =>
Char -> MS m (Doc a) -> MS m (Doc a)
withFontFeature Char
'I' (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst)
inlineToMs WriterOptions
opts (Underline [Inline]
lst) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts ([Inline] -> Inline
Emph [Inline]
lst)
inlineToMs WriterOptions
opts (Strong [Inline]
lst) =
  forall a (m :: * -> *).
(HasChars a, IsString a, PandocMonad m) =>
Char -> MS m (Doc a) -> MS m (Doc a)
withFontFeature Char
'B' (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 <- 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"\\m[strikecolor]" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"\\m[]"
inlineToMs WriterOptions
opts (Superscript [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"\\*{" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"\\*}"
inlineToMs WriterOptions
opts (Subscript [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"\\*<" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> 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
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stSmallCaps :: Bool
stSmallCaps = Bool -> Bool
not (WriterState -> Bool
stSmallCaps WriterState
st) }
  Doc Text
res <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stSmallCaps :: Bool
stSmallCaps = Bool -> Bool
not (WriterState -> Bool
stSmallCaps WriterState
st) }
  forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
res
inlineToMs WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Char -> Doc a
char Char
'`' forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'\''
inlineToMs WriterOptions
opts (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs WriterOptions
opts [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"\\[lq]" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"\\[rq]"
inlineToMs WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
  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 <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> (Text, [Text], [(Text, Text)]) -> Text -> MS m (Doc Text)
highlightCode WriterOptions
opts (Text, [Text], [(Text, Text)])
attr Text
str
  forall a (m :: * -> *).
(HasChars a, IsString a, PandocMonad m) =>
Char -> MS m (Doc a) -> MS m (Doc a)
withFontFeature Char
'C' (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
_) -> forall a. Text -> Doc a
afterBreak Text
"\\&"
                  Maybe (Char, Text)
_            -> forall a. Doc a
empty
  Bool
smallcaps <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stSmallCaps
  if Bool
smallcaps
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
shim forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
toSmallCaps WriterOptions
opts Text
str)
     else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
shim forall a. Semigroup a => a -> a -> a
<> 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
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasInlineMath :: Bool
stHasInlineMath = Bool
True }
  Either Inline Text
res <- 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 -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts Inline
il
       Right Text
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"@" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
r forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"@"
inlineToMs WriterOptions
opts (Math MathType
DisplayMath Text
str) = do
  Either Inline Text
res <- 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 <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts Inline
il
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
".RS 3" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
".RE"
       Right Text
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
            forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
".EQ" forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
r forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
".EN" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr
inlineToMs WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
str)
  | Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"ms" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise        = do
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
inlineToMs WriterOptions
_ Inline
LineBreak = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
".br" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr
inlineToMs WriterOptions
opts Inline
SoftBreak =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes WriterOptions
opts forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
         WrapOption
WrapAuto     -> forall a. Doc a
space
         WrapOption
WrapNone     -> forall a. Doc a
space
         WrapOption
WrapPreserve -> forall a. Doc a
cr
inlineToMs WriterOptions
opts Inline
Space = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Doc Text -> MS m (Doc Text)
handleNotes WriterOptions
opts 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 <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
breakToSpace [Inline]
txt
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"\\c" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => Doc a -> Doc a
nowrap (forall a. HasChars a => a -> Doc a
literal Text
".pdfhref L -D " forall a. Semigroup a => a -> a -> a
<>
       forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. HasChars a => a -> Doc a
literal (Text -> Text
toAscii Text
ident)) forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
" -A " forall a. Semigroup a => a -> a -> a
<>
       forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. HasChars a => a -> Doc a
literal Text
"\\c") forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"\\") forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<>
       forall a. HasChars a => a -> Doc a
literal Text
" -- " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
contents) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> 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 <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
breakToSpace [Inline]
txt
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"\\c" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => Doc a -> Doc a
nowrap (forall a. HasChars a => a -> Doc a
literal Text
".pdfhref W -D " forall a. Semigroup a => a -> a -> a
<>
       forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeUri Text
src)) forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
" -A " forall a. Semigroup a => a -> a -> a
<>
       forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. HasChars a => a -> Doc a
literal Text
"\\c") forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"\\") forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<>
       forall a. HasChars a => a -> Doc a
literal Text
" -- " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
contents) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"\\&"
inlineToMs WriterOptions
opts (Image (Text, [Text], [(Text, Text)])
_ [Inline]
alternate (Text
_, Text
_)) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Char -> Doc a
char Char
'[' forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"IMAGE: " forall a. Semigroup a => a -> a -> a
<>
           forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
escapeStr WriterOptions
opts (forall a. Walkable Inline a => a -> Text
stringify [Inline]
alternate))
             forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
']'
inlineToMs WriterOptions
_ (Note [Block]
contents) = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stNotes :: [[Block]]
stNotes = [Block]
contents forall a. a -> [a] -> [a]
: WriterState -> [[Block]]
stNotes WriterState
st }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> MS m (Doc Text)
inlineListToMs' WriterOptions
opts [Inline]
lils
            ((forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
".IP " forall a. Semigroup a => a -> a -> a
<>
              forall a. HasChars a => Doc a -> Doc a
doubleQuotes (forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
lils') forall a. Semigroup a => a -> a -> a
<>
              forall a. HasChars a => a -> Doc a
literal Text
" 5") forall a. Doc a -> Doc a -> Doc a
$$)
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
      -> ((forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
".LP") forall a. Doc a -> Doc a -> Doc a
$$)
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
False WriterOptions
opts ([Inline] -> Block
Para ([Inline]
ils forall a. [a] -> [a] -> [a]
++ [Inline]
rest))
    (Span (Text
"",[Text
"csl-left-margin"],[]) [Inline]
ils : [Inline]
rest)
      -> ((forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
".LP") forall a. Doc a -> Doc a -> Doc a
$$)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
False WriterOptions
opts ([Inline] -> Block
Para ([Inline]
ils forall a. [a] -> [a] -> [a]
++ [Inline]
rest))
    (Span (Text
"",[Text
"csl-indented"],[]) [Inline]
ils : [Inline]
rest)
      -> ((forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
".LP") forall a. Doc a -> Doc a -> Doc a
$$)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
Bool -> WriterOptions -> Block -> MS m (Doc Text)
cslEntryToMs Bool
False WriterOptions
opts ([Inline] -> Block
Para ([Inline]
ils forall a. [a] -> [a] -> [a]
++ [Inline]
rest))
    [Inline]
_ | Bool
atStart
         -> (Doc Text
".CSLP" forall a. Doc a -> Doc a -> Doc a
$$) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
           [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
           (Inline
x:[Inline]
rest) -> forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> MS m (Doc Text)
inlineToMs WriterOptions
opts Inline
x
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
notes
     then forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
fallback
     else do
       forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stNotes :: [[Block]]
stNotes = [] }
       forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 forall a. a -> [a] -> [a]
: [Block]
rest
                 [Block]
_                 -> [Block]
bs
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> MS m (Doc Text)
blockListToMs WriterOptions
opts [Block]
bs'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
".FS" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
".FE" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr

setFirstPara :: PandocMonad m => MS m ()
setFirstPara :: forall (m :: * -> *). PandocMonad m => MS m ()
setFirstPara = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stFirstPara :: Bool
stFirstPara = Bool
True }

resetFirstPara :: PandocMonad m => MS m ()
resetFirstPara :: forall (m :: * -> *). PandocMonad m => MS m ()
resetFirstPara = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stFirstPara :: Bool
stFirstPara = Bool
False }

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

-- Highlighting

styleToMs :: Style -> Doc Text
styleToMs :: Style -> Doc Text
styleToMs Style
sty = forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ [Doc Text]
colordefs forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map (Style -> TokenType -> Doc Text
toMacro Style
sty) [TokenType]
alltoktypes
  where alltoktypes :: [TokenType]
alltoktypes = forall a. Enum a => a -> a -> [a]
enumFromTo TokenType
KeywordTok TokenType
NormalTok
        colordefs :: [Doc Text]
colordefs = forall a b. (a -> b) -> [a] -> [b]
map Color -> Doc Text
toColorDef [Color]
allcolors
        toColorDef :: Color -> Doc Text
toColorDef Color
c = forall a. HasChars a => a -> Doc a
literal (Text
".defcolor " forall a. Semigroup a => a -> a -> a
<>
            Color -> Text
hexColor Color
c forall a. Semigroup a => a -> a -> a
<> Text
" rgb #" forall a. Semigroup a => a -> a -> a
<> Color -> Text
hexColor Color
c)
        allcolors :: [Color]
allcolors = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
nubOrd 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] forall a. Semigroup a => a -> a -> a
<>
           forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TokenStyle -> [Maybe Color]
colorsForTokenforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (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 forall a b. (a -> b) -> a -> b
$ 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 =
  forall a. IsString a => Doc a -> Doc a
nowrap (forall a. HasChars a => a -> Doc a
literal Text
".ds " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow TokenType
toktype) forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
" \\&" forall a. Semigroup a => a -> a -> a
<>
            forall a. Doc a
setbg forall a. Semigroup a => a -> a -> a
<> Doc Text
setcolor forall a. Semigroup a => a -> a -> a
<> Doc Text
setfont forall a. Semigroup a => a -> a -> a
<>
            forall a. HasChars a => a -> Doc a
literal Text
"\\\\$1" forall a. Semigroup a => a -> a -> a
<>
            Doc Text
resetfont forall a. Semigroup a => a -> a -> a
<> Doc Text
resetcolor forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
resetbg)
  where setcolor :: Doc Text
setcolor = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Doc a
empty Color -> Doc Text
fgcol Maybe Color
tokCol
        resetcolor :: Doc Text
resetcolor = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Doc a
empty (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"\\\\m[]") Maybe Color
tokCol
        setbg :: Doc a
setbg = forall a. Doc a
empty -- maybe empty bgcol tokBg
        resetbg :: Doc a
resetbg = forall a. Doc a
empty -- maybe empty (const $ text "\\\\M[]") tokBg
        fgcol :: Color -> Doc Text
fgcol Color
c = forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text
"\\\\m[" forall a. Semigroup a => a -> a -> a
<> Color -> Text
hexColor Color
c 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 forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"\\\\f[C" forall a. Semigroup a => a -> a -> a
<> [Char
'B' | Bool
tokBold] forall a. Semigroup a => a -> a -> a
<>
                          [Char
'I' | Bool
tokItalic] forall a. Semigroup a => a -> a -> a
<> String
"]"
                     else forall a. Doc a
empty
        resetfont :: Doc Text
resetfont = if Bool
tokBold Bool -> Bool -> Bool
|| Bool
tokItalic
                       then forall a. HasChars a => a -> Doc a
literal Text
"\\\\f[C]"
                       else forall a. Doc a
empty
        tokSty :: Maybe TokenStyle
tokSty = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TokenStyle -> Maybe Color
tokenColor) 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False TokenStyle -> Bool
tokenBold Maybe TokenStyle
tokSty
        tokItalic :: Bool
tokItalic = 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 =
  forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map SourceLine -> Text
fmtLine
 where
  fmtLine :: SourceLine -> Text
fmtLine = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, Text) -> Text
fmtToken
  fmtToken :: (a, Text) -> Text
fmtToken (a
toktype, Text
tok) =
    Text
"\\*[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow a
toktype forall a. Semigroup a => a -> a -> a
<> Text
" \"" forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Text -> Text
escapeStr WriterOptions
opts Text
tok 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 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
           forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
escapeStr WriterOptions
opts Text
str)
         Right Doc Text
h -> do
           forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stHighlighting :: Bool
stHighlighting = Bool
True })
           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" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (Char -> Int
ord Char
c) forall a. Semigroup a => a -> a -> a
<> Text
"_"
              Just Char
'/' -> Text
"_u" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (Char -> Int
ord Char
c) forall a. Semigroup a => a -> a -> a
<> Text
"_" -- see #4515
              Just Char
c' -> Char -> Text
T.singleton Char
c')