{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
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(..))
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
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
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' = 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 =
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'
metadata <- metaToContext opts
(blockListToMan opts)
(fmap chomp . inlineListToMan opts)
$ deleteMeta "title" meta
body <- blockListToMan opts blocks
notes <- gets stNotes
notes' <- notesToMan opts (reverse notes)
let 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
""
hasTables <- gets stHasTables
let 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
return $ render colwidth $
case writerTemplate 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)
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
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
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
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))
return $ marker $$ contents
blockToMan :: PandocMonad m
=> WriterOptions
-> Block
-> 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
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
inlines
return $ text ".PP" $$ splitSentences 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
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 = case Int
level of
Int
1 -> Text
".SH "
Int
_ -> Text
".SS "
return $ nowrap $ literal heading <> contents
blockToMan WriterOptions
opts (CodeBlock Attr
attr Text
str) = do
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)
pure $ literal ".IP" $$
literal ".EX" $$
hlCode $$
literal ".EE"
blockToMan WriterOptions
opts (BlockQuote [Block]
blocks) = do
contents <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToMan WriterOptions
opts [Block]
blocks
return $ literal ".RS" $$ contents $$ literal ".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
caption' <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
caption
modify $ \WriterState
st -> WriterState
st{ stHasTables = True }
let iwidths = if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths
then Text -> [Text]
forall a. a -> [a]
repeat Text
""
else (Double -> Text) -> [Double] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"w(%0.1fn)" (Double -> String) -> (Double -> Double) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
70 Double -> Double -> Double
forall a. Num a => a -> a -> a
*)) [Double]
widths
let coldescriptions = 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
"."
colheadings <- mapM (blockListToMan opts) headers
let 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' = 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
'_'
body <- mapM (\[[Block]]
row -> do
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
return $ makeRow cols) rows
return $ literal ".PP" $$ caption' $$
literal ".TS" $$ literal "tab(@);" $$ coldescriptions $$
colheadings' $$ vcat body $$ literal ".TE"
blockToMan WriterOptions
opts (BulletList [[Block]]
items) = do
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
return (vcat 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))
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
return (vcat contents)
blockToMan WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
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
return (vcat 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)
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
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)
rest' <- blockListToMan opts rest
let 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'' = 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"
return (first'' $$ rest'')
bulletListItemToMan WriterOptions
opts (Block
first:[Block]
rest) = do
first' <- WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToMan WriterOptions
opts Block
first
rest' <- blockListToMan opts rest
return $ literal "\\[bu] .RS 2" $$ first' $$ rest' $$ literal ".RE"
orderedListItemToMan :: PandocMonad m
=> WriterOptions
-> Text
-> Int
-> [Block]
-> 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
first' <- WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToMan WriterOptions
opts Block
first
rest' <- blockListToMan opts rest
let 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'' = 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'' = 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"
return $ first'' $$ rest''
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
labelText <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
label
contents <- if null defs
then return empty
else liftM vcat $ forM defs $ \case
(Block
x:[Block]
xs) -> do
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
rest' <- liftM vcat $ 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) xs
return $ first' $$
if null xs
then empty
else literal ".RS" $$ rest' $$ literal ".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
return $ literal ".TP" $$ nowrap labelText $$ contents
blockListToMan :: PandocMonad m
=> WriterOptions
-> [Block]
-> 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
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
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
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)
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
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst
return $ literal "[STRIKEOUT:" <> contents <> char ']'
inlineToMan WriterOptions
opts (Superscript [Inline]
lst) = do
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst
return $ char '^' <> contents <> char '^'
inlineToMan WriterOptions
opts (Subscript [Inline]
lst) = do
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst
return $ char '~' <> contents <> 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
inlineToMan WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = do
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst
return $ char '`' <> contents <> char '\''
inlineToMan WriterOptions
opts (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToMan WriterOptions
opts [Inline]
lst
return $ literal "\\[lq]" <> contents <> literal "\\[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
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
return $ cr <> literal ".RS" $$ contents $$ literal ".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
| 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)
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 (start, end) = if "mailto:" `T.isPrefixOf` src
then (".MT", ".ME")
else (".UR", ".UE")
return $ "\\c" <> cr
$$ nowrap (start <+> literal srcSuffix)
$$ linktext
$$ (end <+> "\\c" <> cr)
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])
then [Text -> Inline
Str Text
"image"]
else [Inline]
alternate
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))
return $ char '[' <> literal "IMAGE: " <> linkPart <> char ']'
inlineToMan WriterOptions
_ (Note [Block]
contents) = do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stNotes = contents : stNotes st }
notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
let 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)
return $ char '[' <> literal ref <> 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]"