{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Writers.Man
   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 man page format.

-}
module Text.Pandoc.Writers.Man ( writeMan ) where
import Control.Monad ( liftM, zipWithM, forM, unless )
import Control.Monad.State.Strict ( StateT, gets, modify, evalStateT )
import Control.Monad.Trans (MonadTrans(lift))
import Data.List (intersperse)
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe (fromMaybe)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Builder (deleteMeta)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.URI
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Writers.Roff
import Text.Pandoc.Highlighting
import Text.Printf (printf)
import Skylighting (TokenType(..), SourceLine, FormatOptions, defaultFormatOpts,
                    defStyle, TokenStyle(..), Style(..))

-- | Convert Pandoc to Man.
writeMan :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMan 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 -> StateT WriterState m Text
pandocToMan WriterOptions
opts Pandoc
document) WriterState
defaultWriterState

-- | Return roff man representation of document.
pandocToMan :: PandocMonad m => WriterOptions -> Pandoc -> StateT WriterState m Text
pandocToMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> StateT WriterState m Text
pandocToMan 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
titleText <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline] -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta
  let title' :: Text
title' = Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
titleText
  let setFieldsFromTitle :: Context Text -> Context Text
setFieldsFromTitle =
       case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
title' of
           (Text
cmdName, Text
rest) -> case (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'(') Text
cmdName of
                                   (Text
xs, Text
ys) | Text
"(" Text -> Text -> Bool
`T.isPrefixOf` Text
ys
                                                Bool -> Bool -> Bool
&& Text
")" Text -> Text -> Bool
`T.isSuffixOf` Text
ys ->
                                     Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"title" Text
xs (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"section" (HasCallStack => Text -> Text
Text -> Text
T.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
ys) (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"|" Text
rest of
                                          (Text
ft:[Text]
hds) ->
                                            Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"footer" (Text -> Text
T.strip Text
ft) (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"header"
                                               (Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
hds)
                                          [] -> Context Text -> Context Text
forall a. a -> a
id
                                   (Text, Text)
_  -> Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"title" Text
title'
  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] -> StateT WriterState m (Doc Text)
blockListToMan 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] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts)
              (Meta -> StateT WriterState m (Context Text))
-> Meta -> StateT WriterState m (Context Text)
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
deleteMeta Text
"title" Meta
meta
  Doc Text
body <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToMan WriterOptions
opts [Block]
blocks
  [[Block]]
notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
  Doc Text
notes' <- WriterOptions -> [[Block]] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> StateT WriterState m (Doc Text)
notesToMan WriterOptions
opts ([[Block]] -> [[Block]]
forall a. [a] -> [a]
reverse [[Block]]
notes)
  let main :: Doc Text
main = Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
notes' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
""
  Bool
hasTables <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHasTables
  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
$ Context Text -> Context Text
setFieldsFromTitle
              (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-tables" Bool
hasTables
                Context Text
metadata
  Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT WriterState m Text)
-> Text -> StateT WriterState 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

escString :: WriterOptions -> Text -> Text
escString :: WriterOptions -> Text -> Text
escString WriterOptions
opts = EscapeMode -> Text -> Text
escapeString (if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
                                  then EscapeMode
AsciiOnly
                                  else EscapeMode
AllowUTF8)

-- | Return man representation of notes.
notesToMan :: PandocMonad m => WriterOptions -> [[Block]] -> StateT WriterState m (Doc Text)
notesToMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> StateT WriterState m (Doc Text)
notesToMan WriterOptions
opts [[Block]]
notes =
  if [[Block]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
notes
     then 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
     else (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
".SH NOTES" 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]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> [Block] -> StateT WriterState m (Doc Text))
-> [Int] -> [[Block]] -> StateT WriterState m [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (WriterOptions -> Int -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> StateT WriterState m (Doc Text)
noteToMan WriterOptions
opts) [Int
1..] [[Block]]
notes

-- | Return man representation of a note.
noteToMan :: PandocMonad m => WriterOptions -> Int -> [Block] -> StateT WriterState m (Doc Text)
noteToMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> StateT WriterState m (Doc Text)
noteToMan WriterOptions
opts Int
num [Block]
note = do
  Doc Text
contents <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToMan WriterOptions
opts [Block]
note
  let marker :: Doc Text
marker = Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
".SS " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
num))
  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
marker Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents

-- 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.

-- | Convert Pandoc block element to man.
blockToMan :: PandocMonad m
           => WriterOptions -- ^ Options
           -> Block         -- ^ Block element
           -> StateT WriterState m (Doc Text)
blockToMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToMan WriterOptions
opts (Div Attr
_ [Block]
bs) = WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToMan WriterOptions
opts [Block]
bs
blockToMan WriterOptions
opts (Plain [Inline]
inlines) =
  Doc Text -> Doc Text
splitSentences (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] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
inlines
blockToMan WriterOptions
opts (Para [Inline]
inlines) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
inlines
  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
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
".PP" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text -> Doc Text
splitSentences Doc Text
contents
blockToMan WriterOptions
opts (LineBlock [[Inline]]
lns) =
  WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToMan WriterOptions
opts (Block -> StateT WriterState m (Doc Text))
-> Block -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToMan 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
"man" = 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
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
$ Block -> LogMessage
BlockNotRendered Block
b
      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
blockToMan WriterOptions
_ Block
HorizontalRule = 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
".PP" 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
"   *   *   *   *   *"
blockToMan WriterOptions
opts (Header Int
level Attr
_ [Inline]
inlines) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
inlines
  let heading :: Text
heading = case Int
level of
                  Int
1 -> Text
".SH "
                  Int
_ -> Text
".SS "
  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 -> 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
heading Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
blockToMan WriterOptions
opts (CodeBlock Attr
attr Text
str) = do
  Doc Text
hlCode <- case SyntaxMap
-> (FormatOptions -> [SourceLine] -> Doc Text)
-> Attr
-> Text
-> Either Text (Doc Text)
forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts) (WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
formatSource WriterOptions
opts)
                  Attr
attr Text
str of
              Right Doc Text
d -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
d
              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 -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
formatSource WriterOptions
opts FormatOptions
defaultFormatOpts
                          ((Text -> SourceLine) -> [Text] -> [SourceLine]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
t -> [(TokenType
NormalTok,Text
t)]) ([Text] -> [SourceLine]) -> [Text] -> [SourceLine]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
str)
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
".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
".EX" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
         Doc Text
hlCode Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
         Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".EE"
blockToMan WriterOptions
opts (BlockQuote [Block]
blocks) = do
  Doc Text
contents <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToMan WriterOptions
opts [Block]
blocks
  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
".RS" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".RE"
blockToMan WriterOptions
opts (Table Attr
_ 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] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
caption
  (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{ stHasTables = True }
  let iwidths :: [Text]
iwidths = if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths
                   then Text -> [Text]
forall a. a -> [a]
repeat Text
""
                   else (Double -> Text) -> [Double] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"w(%0.1fn)" (Double -> String) -> (Double -> Double) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
70 Double -> Double -> Double
forall a. Num a => a -> a -> a
*)) [Double]
widths
  -- 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 -> Text -> Text) -> [Alignment] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Alignment
align Text
width -> Alignment -> Text
forall {a}. IsString a => Alignment -> a
aligncode Alignment
align Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
width)
                        [Alignment]
alignments [Text]
iwidths) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  [Doc Text]
colheadings <- ([Block] -> 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] -> StateT WriterState m (Doc Text)
blockListToMan 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}@T{") [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]] -> 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 (\[[Block]]
row -> do
                         [Doc Text]
cols <- ([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] -> StateT WriterState m (Doc Text)
blockListToMan WriterOptions
opts) [[Block]]
row
                         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] -> Doc Text
forall {a}. HasChars a => [Doc a] -> Doc a
makeRow [Doc Text]
cols) [[[Block]]]
rows
  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
".PP" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".TS" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"tab(@);" 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"
blockToMan WriterOptions
opts (BulletList [[Block]]
items) = do
  [Doc Text]
contents <- ([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] -> StateT WriterState m (Doc Text)
bulletListItemToMan WriterOptions
opts) [[Block]]
items
  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] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents)
blockToMan 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
1 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]) -> StateT WriterState 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] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Text -> Int -> [Block] -> StateT WriterState m (Doc Text)
orderedListItemToMan 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
  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] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents)
blockToMan WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
  [Doc Text]
contents <- (([Inline], [[Block]]) -> StateT WriterState 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]]) -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> ([Inline], [[Block]]) -> StateT WriterState m (Doc Text)
definitionListItemToMan WriterOptions
opts) [([Inline], [[Block]])]
items
  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] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents)
blockToMan WriterOptions
opts (Figure Attr
attr Caption
capt [Block]
body) = do
  WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToMan WriterOptions
opts (Attr -> Caption -> [Block] -> Block
figureDiv Attr
attr Caption
capt [Block]
body)

-- | Convert bullet list item (list of blocks) to man.
bulletListItemToMan :: PandocMonad m => WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
bulletListItemToMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
bulletListItemToMan 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
bulletListItemToMan WriterOptions
opts (Para [Inline]
first:[Block]
rest) =
  WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
bulletListItemToMan WriterOptions
opts ([Inline] -> Block
Plain [Inline]
firstBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
rest)
bulletListItemToMan WriterOptions
opts (Plain [Inline]
first:[Block]
rest) = do
  Doc Text
first' <- WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToMan WriterOptions
opts ([Inline] -> Block
Plain [Inline]
first)
  Doc Text
rest' <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToMan WriterOptions
opts [Block]
rest
  let first'' :: Doc Text
first'' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
".IP \\[bu] 2" 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 2" 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'')
bulletListItemToMan WriterOptions
opts (Block
first:[Block]
rest) = do
  Doc Text
first' <- WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToMan WriterOptions
opts Block
first
  Doc Text
rest' <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToMan 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 2" 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 man.
orderedListItemToMan :: PandocMonad m
                     => WriterOptions -- ^ options
                     -> Text   -- ^ order marker for list item
                     -> Int      -- ^ number of spaces to indent
                     -> [Block]  -- ^ list item (list of blocks)
                     -> StateT WriterState m (Doc Text)
orderedListItemToMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Text -> Int -> [Block] -> StateT WriterState m (Doc Text)
orderedListItemToMan 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
orderedListItemToMan 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] -> StateT WriterState m (Doc Text)
orderedListItemToMan WriterOptions
opts Text
num Int
indent ([Inline] -> Block
Plain [Inline]
firstBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
rest)
orderedListItemToMan 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 -> StateT WriterState m (Doc Text)
blockToMan WriterOptions
opts Block
first
  Doc Text
rest' <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToMan WriterOptions
opts [Block]
rest
  let num' :: String
num' = String -> Text -> String
forall r. PrintfType r => String -> r
printf (String
"%" String -> String -> String
forall 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. [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
<> String -> Text
T.pack String
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 4" 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 man.
definitionListItemToMan :: PandocMonad m
                        => WriterOptions
                        -> ([Inline],[[Block]])
                        -> StateT WriterState m (Doc Text)
definitionListItemToMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> ([Inline], [[Block]]) -> StateT WriterState m (Doc Text)
definitionListItemToMan WriterOptions
opts ([Inline]
label, [[Block]]
defs) = do
  -- in most man pages, option and other code in option lists is boldface,
  -- but not other things, so we try to reproduce this style:
  Doc Text
labelText <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [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 -> 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
                 else ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState 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]
 -> StateT WriterState m (Doc Text))
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Block]]
-> ([Block] -> StateT WriterState 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] -> StateT WriterState m (Doc Text))
 -> StateT WriterState m [Doc Text])
-> ([Block] -> StateT WriterState m (Doc Text))
-> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ \case
                          (Block
x:[Block]
xs) -> do
                            Doc Text
first' <- WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToMan WriterOptions
opts (Block -> StateT WriterState m (Doc Text))
-> Block -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$
                                      case Block
x of
                                           Para [Inline]
y -> [Inline] -> Block
Plain [Inline]
y
                                           Block
_      -> Block
x
                            Doc Text
rest' <- ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState 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]
 -> StateT WriterState m (Doc Text))
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> 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
                                        (\Block
item -> WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToMan WriterOptions
opts Block
item) [Block]
xs
                            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
$$
                                     if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
xs
                                        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. 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
forall a. Doc a
empty
  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
".TP" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
labelText Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents

-- | Convert list of Pandoc block elements to man.
blockListToMan :: PandocMonad m
               => WriterOptions -- ^ Options
               -> [Block]       -- ^ List of block elements
               -> StateT WriterState m (Doc Text)
blockListToMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToMan 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 -> StateT WriterState m (Doc Text)
blockToMan WriterOptions
opts) ([Block] -> [Block]
go [Block]
blocks)
 where
   -- Avoid .PP right after .SH; this is a no-op in groff man and mandoc
   -- but may cause unwanted extra space in some renderers (see #9020)
   go :: [Block] -> [Block]
go [] = []
   go (h :: Block
h@Header{} : Para [Inline]
ils : [Block]
rest) = Block
h Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Inline] -> Block
Plain [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
go [Block]
rest
   go (Block
x : [Block]
xs) = Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
go [Block]
xs

-- | Convert list of Pandoc inline elements to man.
inlineListToMan :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan 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 -> StateT WriterState m (Doc Text)
inlineToMan WriterOptions
opts) [Inline]
lst

-- | Convert Pandoc inline element to man.
inlineToMan :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToMan WriterOptions
opts (Span Attr
_ [Inline]
ils) = WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
ils
inlineToMan WriterOptions
opts (Emph [Inline]
lst) =
  Char
-> StateT WriterState m (Doc Text)
-> StateT WriterState 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] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst)
-- Underline is not supported, so treat the same as Emph
inlineToMan WriterOptions
opts (Underline [Inline]
lst) =
  Char
-> StateT WriterState m (Doc Text)
-> StateT WriterState 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] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst)
inlineToMan WriterOptions
opts (Strong [Inline]
lst) =
  Char
-> StateT WriterState m (Doc Text)
-> StateT WriterState 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] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst)
inlineToMan WriterOptions
opts (Strikeout [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst
  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
"[STRIKEOUT:" 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
']'
inlineToMan WriterOptions
opts (Superscript [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst
  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
$ 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
'^'
inlineToMan WriterOptions
opts (Subscript [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst
  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
$ 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
'~'
inlineToMan WriterOptions
opts (SmallCaps [Inline]
lst) = WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst -- not supported
inlineToMan WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst
  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
$ 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
'\''
inlineToMan WriterOptions
opts (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst
  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
"\\[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]"
inlineToMan WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
  WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst
inlineToMan WriterOptions
opts (Code Attr
_ Text
str) =
  Char
-> StateT WriterState m (Doc Text)
-> StateT WriterState 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 -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text -> Text
escString WriterOptions
opts Text
str))
inlineToMan WriterOptions
opts (Str str :: Text
str@(Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'.',Text
_))) =
  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. Text -> Doc a
afterBreak 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 (WriterOptions -> Text -> Text
escString WriterOptions
opts Text
str)
inlineToMan WriterOptions
opts (Str Text
str) = 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 -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text -> Text
escString WriterOptions
opts Text
str
inlineToMan WriterOptions
opts (Math MathType
InlineMath Text
str) =
  m [Inline] -> StateT WriterState m [Inline]
forall (m :: * -> *) a. Monad m => m a -> StateT WriterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MathType -> Text -> m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
InlineMath Text
str) StateT WriterState m [Inline]
-> ([Inline] -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
forall a b.
StateT WriterState m a
-> (a -> StateT WriterState m b) -> StateT WriterState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts
inlineToMan WriterOptions
opts (Math MathType
DisplayMath Text
str) = do
  Doc Text
contents <- m [Inline] -> StateT WriterState m [Inline]
forall (m :: * -> *) a. Monad m => m a -> StateT WriterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MathType -> Text -> m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
DisplayMath Text
str) StateT WriterState m [Inline]
-> ([Inline] -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
forall a b.
StateT WriterState m a
-> (a -> StateT WriterState m b) -> StateT WriterState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts
  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
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" 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"
inlineToMan 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
"man" = 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
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 -> 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
inlineToMan WriterOptions
_ Inline
LineBreak = 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
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
".PD 0" 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
".P" 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
".PD" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToMan WriterOptions
_ Inline
SoftBreak = 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. Text -> Doc a
afterBreak Text
"\\" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space
inlineToMan WriterOptions
_ Inline
Space = 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. Text -> Doc a
afterBreak Text
"\\" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space
inlineToMan WriterOptions
opts (Link Attr
_ [Inline]
txt (Text
src, Text
_))
  | Bool -> Bool
not (Text -> Bool
isURI Text
src) = WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
txt -- skip relative links
  | Bool
otherwise       = do
  let srcSuffix :: Text
srcSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
src (Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src)
  Doc Text
linktext <- case [Inline]
txt of
                [Str Text
s] | Text -> Text
escapeURI Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
srcSuffix -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
                [Inline]
_ -> WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
txt
  let (Doc Text
start, Doc Text
end) = if Text
"mailto:" Text -> Text -> Bool
`T.isPrefixOf` Text
src
                        then (Doc Text
".MT", Doc Text
".ME")
                        else (Doc Text
".UR", Doc Text
".UE")
  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
"\\c" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr -- \c avoids extra space
        Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text
start 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
srcSuffix)
        Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
linktext
        Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ (Doc Text
end Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
"\\c" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr)  -- \c avoids space after
inlineToMan WriterOptions
opts (Image Attr
attr [Inline]
alternate (Text
source, Text
tit)) = do
  let txt :: [Inline]
txt = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
alternate Bool -> Bool -> Bool
|| ([Inline]
alternate [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
""]) Bool -> Bool -> Bool
||
               ([Inline]
alternate [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
source]) -- to prevent autolinks
               then [Text -> Inline
Str Text
"image"]
               else [Inline]
alternate
  Doc Text
linkPart <- WriterOptions -> Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToMan WriterOptions
opts (Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
txt (Text
source, Text
tit))
  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
$ Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'[' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"IMAGE: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linkPart 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
']'
inlineToMan WriterOptions
_ (Note [Block]
contents) = do
  -- add to notes in state
  (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 }
  [[Block]]
notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
  let ref :: Text
ref = Int -> Text
forall a. Show a => a -> Text
tshow ([[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
notes)
  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
$ Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'[' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ref 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
']'

formatSource :: WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
formatSource :: WriterOptions -> FormatOptions -> [SourceLine] -> Doc Text
formatSource WriterOptions
wopts FormatOptions
fopts = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ([SourceLine] -> [Doc Text]) -> [SourceLine] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceLine -> Doc Text) -> [SourceLine] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (WriterOptions -> FormatOptions -> SourceLine -> Doc Text
formatSourceLine WriterOptions
wopts FormatOptions
fopts)

formatSourceLine :: WriterOptions -> FormatOptions -> SourceLine -> Doc Text
formatSourceLine :: WriterOptions -> FormatOptions -> SourceLine -> Doc Text
formatSourceLine WriterOptions
_wopts FormatOptions
_fopts [] = Doc Text
forall a. Doc a
blankline
formatSourceLine WriterOptions
wopts FormatOptions
fopts ts :: SourceLine
ts@((TokenType
_,Text
firstTxt):SourceLine
_) =
  (case Text -> Maybe (Char, Text)
T.uncons Text
firstTxt 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] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat (((TokenType, Text) -> Doc Text) -> SourceLine -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (WriterOptions -> FormatOptions -> (TokenType, Text) -> Doc Text
formatTok WriterOptions
wopts FormatOptions
fopts) SourceLine
ts) 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
"\n"

formatTok :: WriterOptions -> FormatOptions -> (TokenType, Text) -> Doc Text
formatTok :: WriterOptions -> FormatOptions -> (TokenType, Text) -> Doc Text
formatTok WriterOptions
wopts FormatOptions
_fopts (TokenType
toktype, Text
t) =
  let txt :: Doc Text
txt = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Text -> Text
escString WriterOptions
wopts Text
t)
      styleMap :: Maybe (Map TokenType TokenStyle)
styleMap = Style -> Map TokenType TokenStyle
tokenStyles (Style -> Map TokenType TokenStyle)
-> Maybe Style -> Maybe (Map TokenType TokenStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
wopts
      tokStyle :: TokenStyle
tokStyle = TokenStyle -> Maybe TokenStyle -> TokenStyle
forall a. a -> Maybe a -> a
fromMaybe TokenStyle
defStyle (Maybe TokenStyle -> TokenStyle) -> Maybe TokenStyle -> TokenStyle
forall a b. (a -> b) -> a -> b
$ Maybe (Map TokenType TokenStyle)
styleMap Maybe (Map TokenType TokenStyle)
-> (Map TokenType TokenStyle -> Maybe TokenStyle)
-> Maybe TokenStyle
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TokenType
toktype
  in  if TokenType
toktype TokenType -> TokenType -> Bool
forall a. Eq a => a -> a -> Bool
== TokenType
NormalTok
         then Doc Text
txt
         else
           let fonts :: String
fonts = [Char
'B' | TokenStyle -> Bool
tokenBold TokenStyle
tokStyle] String -> String -> String
forall a. [a] -> [a] -> [a]
++
                       [Char
'I' | TokenStyle -> Bool
tokenItalic TokenStyle
tokStyle Bool -> Bool -> Bool
|| TokenStyle -> Bool
tokenUnderline TokenStyle
tokStyle]
            in if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fonts
                  then Doc Text
txt
                  else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"\\f[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fonts 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
txt 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
"\\f[R]"