{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where
import Control.Monad.State.Strict
import Data.Char (ord, isDigit)
import Data.List (intersperse)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (unEscapeString)
import Text.Collate.Lang (Lang(..))
import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Walk (query)
import Text.Pandoc.Writers.Shared
import Text.Printf (printf)
data WriterState =
WriterState { WriterState -> Int
stNextRef :: Int
, WriterState -> Int
stOrderedListLevel :: Int
, WriterState -> WriterOptions
stOptions :: WriterOptions
, WriterState -> Bool
stHasCslRefs :: Bool
, WriterState -> Bool
stCslHangingIndent :: Bool
}
data Tabl = Xtb | Ntb deriving (Int -> Tabl -> ShowS
[Tabl] -> ShowS
Tabl -> String
(Int -> Tabl -> ShowS)
-> (Tabl -> String) -> ([Tabl] -> ShowS) -> Show Tabl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tabl] -> ShowS
$cshowList :: [Tabl] -> ShowS
show :: Tabl -> String
$cshow :: Tabl -> String
showsPrec :: Int -> Tabl -> ShowS
$cshowsPrec :: Int -> Tabl -> ShowS
Show, Tabl -> Tabl -> Bool
(Tabl -> Tabl -> Bool) -> (Tabl -> Tabl -> Bool) -> Eq Tabl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tabl -> Tabl -> Bool
$c/= :: Tabl -> Tabl -> Bool
== :: Tabl -> Tabl -> Bool
$c== :: Tabl -> Tabl -> Bool
Eq)
orderedListStyles :: [Char]
orderedListStyles :: String
orderedListStyles = ShowS
forall a. [a] -> [a]
cycle "narg"
writeConTeXt :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeConTeXt :: WriterOptions -> Pandoc -> m Text
writeConTeXt options :: WriterOptions
options document :: Pandoc
document =
let defaultWriterState :: WriterState
defaultWriterState = WriterState :: Int -> Int -> WriterOptions -> Bool -> Bool -> WriterState
WriterState { stNextRef :: Int
stNextRef = 1
, stOrderedListLevel :: Int
stOrderedListLevel = 0
, stOptions :: WriterOptions
stOptions = WriterOptions
options
, stHasCslRefs :: Bool
stHasCslRefs = Bool
False
, stCslHangingIndent :: Bool
stCslHangingIndent = Bool
False
}
in 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 -> WM m Text
pandocToConTeXt WriterOptions
options Pandoc
document) WriterState
defaultWriterState
type WM = StateT WriterState
pandocToConTeXt :: PandocMonad m => WriterOptions -> Pandoc -> WM m Text
pandocToConTeXt :: WriterOptions -> Pandoc -> WM m Text
pandocToConTeXt options :: WriterOptions
options (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) = do
let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
options 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
options
else Maybe Int
forall a. Maybe a
Nothing
Context Text
metadata <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
options
[Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt
((Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt)
Meta
meta
Doc Text
main <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt ([Block] -> StateT WriterState m (Doc Text))
-> [Block] -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False Maybe Int
forall a. Maybe a
Nothing [Block]
blocks
let layoutFromMargins :: Doc Text
layoutFromMargins = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse ("," :: Doc Text) ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
((Doc Text, Text) -> Maybe (Doc Text))
-> [(Doc Text, Text)] -> [Doc Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(x :: Doc Text
x,y :: Text
y) ->
((Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "=") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text) -> Maybe (Doc Text) -> Maybe (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
y Context Text
metadata)
[("leftmargin","margin-left")
,("rightmargin","margin-right")
,("top","margin-top")
,("bottom","margin-bottom")
]
Maybe Text
mblang <- Maybe Text -> WM m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Maybe Text -> WM m (Maybe Text)
fromBCP47 (WriterOptions -> Meta -> Maybe Text
getLang WriterOptions
options Meta
meta)
WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
let context :: Context Text
context = Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
options)
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "placelist"
([Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([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] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse ("," :: Doc Text) ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$
Int -> [Doc Text] -> [Doc Text]
forall a. Int -> [a] -> [a]
take (WriterOptions -> Int
writerTOCDepth WriterOptions
options Int -> Int -> Int
forall a. Num a => a -> a -> a
+
case WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
options of
TopLevelPart -> 0
TopLevelChapter -> 0
_ -> 1)
["chapter","section","subsection","subsubsection",
"subsubsubsection","subsubsubsubsection"])
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "body" Doc Text
main
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "layout" Doc Text
layoutFromMargins
(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 "number-sections" (WriterOptions -> Bool
writerNumberSections WriterOptions
options)
(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 "csl-refs" (WriterState -> Bool
stHasCslRefs WriterState
st)
(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 "csl-hanging-indent" (WriterState -> Bool
stCslHangingIndent WriterState
st)
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (Context Text -> Context Text)
-> (Text -> Context Text -> Context Text)
-> Maybe Text
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (\l :: Text
l ->
Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "context-lang" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
l :: Doc Text)) Maybe Text
mblang
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (case Text -> String
T.unpack (Text -> String) -> (Doc Text -> Text) -> Doc Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> String) -> Maybe (Doc Text) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField "papersize" Context Text
metadata of
Just (('a':d :: Char
d:ds :: String
ds) :: String)
| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit (Char
dChar -> ShowS
forall a. a -> [a] -> [a]
:String
ds) -> Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField "papersize"
(String -> Text
T.pack ('A'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
dChar -> ShowS
forall a. a -> [a] -> [a]
:String
ds))
_ -> Context Text -> Context Text
forall a. a -> a
id)
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (case Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Text
lookupMetaString "pdfa" Meta
meta of
"true" -> Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField "pdfa" (String -> Text
T.pack "1b:2005")
_ -> Context Text -> Context Text
forall a. a -> a
id) Context Text
metadata
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 "context-dir" (Doc Text -> (Doc Text -> Doc Text) -> Maybe (Doc Text) -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
forall a. Monoid a => a
mempty Doc Text -> Doc Text
toContextDir
(Maybe (Doc Text) -> Doc Text) -> Maybe (Doc Text) -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField "dir" Context Text
context) Context Text
context
Text -> WM m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> WM m Text) -> Text -> WM 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
options of
Nothing -> Doc Text
main
Just tpl :: Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context'
toContextDir :: Doc Text -> Doc Text
toContextDir :: Doc Text -> Doc Text
toContextDir = (Text -> Text) -> Doc Text -> Doc Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t :: Text
t -> case Text
t of
"ltr" -> "l2r"
"rtl" -> "r2l"
_ -> Text
t)
escapeCharForConTeXt :: WriterOptions -> Char -> Text
escapeCharForConTeXt :: WriterOptions -> Char -> Text
escapeCharForConTeXt opts :: WriterOptions
opts ch :: Char
ch =
let ligatures :: Bool
ligatures = Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts in
case Char
ch of
'{' -> "\\{"
'}' -> "\\}"
'\\' -> "\\letterbackslash{}"
'$' -> "\\$"
'|' -> "\\letterbar{}"
'%' -> "\\letterpercent{}"
'~' -> "\\lettertilde{}"
'#' -> "\\#"
'[' -> "{[}"
']' -> "{]}"
'\160' -> "~"
'\x2014' | Bool
ligatures -> "---"
'\x2013' | Bool
ligatures -> "--"
'\x2019' | Bool
ligatures -> "'"
'\x2026' -> "\\ldots{}"
x :: Char
x -> Char -> Text
T.singleton Char
x
stringToConTeXt :: WriterOptions -> Text -> Text
stringToConTeXt :: WriterOptions -> Text -> Text
stringToConTeXt opts :: WriterOptions
opts = (Char -> Text) -> Text -> Text
T.concatMap (WriterOptions -> Char -> Text
escapeCharForConTeXt WriterOptions
opts)
toLabel :: Text -> Text
toLabel :: Text -> Text
toLabel z :: Text
z = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
go Text
z
where go :: Char -> Text
go x :: Char
x
| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("\\#[]\",{}%()|=" :: String) = "ux" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf "%x" (Char -> Int
ord Char
x))
| Bool
otherwise = Char -> Text
T.singleton Char
x
blockToConTeXt :: PandocMonad m => Block -> WM m (Doc Text)
blockToConTeXt :: Block -> WM m (Doc Text)
blockToConTeXt Null = Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToConTeXt (Div attr :: Attr
attr@(_,"section":_,_)
(Header level :: Int
level _ title' :: [Inline]
title' : xs :: [Block]
xs)) = do
Doc Text
header' <- Attr -> Int -> [Inline] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> Int -> [Inline] -> WM m (Doc Text)
sectionHeader Attr
attr Int
level [Inline]
title'
Doc Text
footer' <- Attr -> Int -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> Int -> WM m (Doc Text)
sectionFooter Attr
attr Int
level
Doc Text
innerContents <- [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
xs
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
header' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
innerContents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
footer'
blockToConTeXt (Plain lst :: [Inline]
lst) = [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
blockToConTeXt (SimpleFigure attr :: Attr
attr txt :: [Inline]
txt (src :: Text
src, _)) = do
Doc Text
capt <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
txt
Doc Text
img <- Inline -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> WM m (Doc Text)
inlineToConTeXt (Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
txt (Text
src, ""))
let (ident :: Text
ident, _, _) = Attr
attr
label :: Doc Text
label = if Text -> Bool
T.null Text
ident
then Doc Text
forall a. Doc a
empty
else "[]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
toLabel Text
ident)
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\placefigure" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
label 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
braces Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
img Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToConTeXt (Para lst :: [Inline]
lst) = do
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToConTeXt (LineBlock lns :: [[Inline]]
lns) = do
let emptyToBlankline :: Doc a -> Doc a
emptyToBlankline doc :: Doc a
doc = if Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
doc
then Doc a
forall a. Doc a
blankline
else Doc a
doc
[Doc Text]
doclines <- ([Inline] -> WM m (Doc Text))
-> [[Inline]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [[Inline]]
lns
let contextLines :: Doc Text
contextLines = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([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) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
forall a. Doc a -> Doc a
emptyToBlankline ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text]
doclines
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\startlines" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contextLines Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stoplines" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToConTeXt (BlockQuote lst :: [Block]
lst) = do
Doc Text
contents <- [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\startblockquote" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest 0 Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stopblockquote" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToConTeXt (CodeBlock _ str :: Text
str) =
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush ("\\starttyping" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "\\stoptyping") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToConTeXt b :: Block
b@(RawBlock f :: Format
f str :: Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "context" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "tex" = Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
| Bool
otherwise = Doc Text
forall a. Doc a
empty Doc Text -> StateT WriterState m () -> WM m (Doc Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)
blockToConTeXt (Div ("refs",classes :: [Text]
classes,_) bs :: [Block]
bs) = do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st{ stHasCslRefs :: Bool
stHasCslRefs = Bool
True
, stCslHangingIndent :: Bool
stCslHangingIndent = "hanging-indent" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes }
Doc Text
inner <- [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
bs
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\startcslreferences" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
inner Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stopcslreferences"
blockToConTeXt (Div (ident :: Text
ident,_,kvs :: [Target]
kvs) bs :: [Block]
bs) = do
let align :: Doc a -> Doc a -> Doc a
align dir :: Doc a
dir txt :: Doc a
txt = "\\startalignment[" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
dir Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> "]" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$ Doc a
txt Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$ "\\stopalignment"
Maybe Text
mblang <- Maybe Text -> WM m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Maybe Text -> WM m (Maybe Text)
fromBCP47 (Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "lang" [Target]
kvs)
let wrapRef :: Doc Text -> Doc Text
wrapRef txt :: Doc Text
txt = if Text -> Bool
T.null Text
ident
then Doc Text
txt
else ("\\reference" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
toLabel Text
ident) 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
braces Doc Text
forall a. Doc a
empty Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "%") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
txt
wrapDir :: Doc Text -> Doc Text
wrapDir = case Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "dir" [Target]
kvs of
Just "rtl" -> Doc Text -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a -> Doc a
align "righttoleft"
Just "ltr" -> Doc Text -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a -> Doc a
align "lefttoright"
_ -> Doc Text -> Doc Text
forall a. a -> a
id
wrapLang :: Doc Text -> Doc Text
wrapLang txt :: Doc Text
txt = case Maybe Text
mblang of
Just lng :: Text
lng -> "\\start\\language["
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
lng Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "]" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
txt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stop"
Nothing -> Doc Text
txt
wrapBlank :: Doc a -> Doc a
wrapBlank txt :: Doc a
txt = Doc a
forall a. Doc a
blankline Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
txt Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
blankline
Doc Text -> Doc Text
forall a. Doc a -> Doc a
wrapBlank (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
wrapLang (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
wrapDir (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
wrapRef (Doc Text -> Doc Text) -> WM m (Doc Text) -> WM m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
bs
blockToConTeXt (BulletList lst :: [[Block]]
lst) = do
[Doc Text]
contents <- ([Block] -> WM m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt [[Block]]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ("\\startitemize" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> if [[Block]] -> Bool
isTightList [[Block]]
lst
then Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets "packed"
else Doc Text
forall a. Doc a
empty) 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]
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 "\\stopitemize" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToConTeXt (OrderedList (start :: Int
start, style' :: ListNumberStyle
style', delim :: ListNumberDelim
delim) lst :: [[Block]]
lst) = do
WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
let level :: Int
level = WriterState -> Int
stOrderedListLevel WriterState
st
WriterState -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put WriterState
st {stOrderedListLevel :: Int
stOrderedListLevel = Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1}
[Doc Text]
contents <- ([Block] -> WM m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt [[Block]]
lst
WriterState -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put WriterState
st {stOrderedListLevel :: Int
stOrderedListLevel = Int
level}
let start' :: Text
start' = if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "" else "start=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
start
let delim' :: Text
delim' = case ListNumberDelim
delim of
DefaultDelim -> ""
Period -> "stopper=."
OneParen -> "stopper=)"
TwoParens -> "left=(,stopper=)"
let specs2Items :: [Text]
specs2Items = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text
start', Text
delim']
let specs2 :: Text
specs2 = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
specs2Items
then ""
else "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate "," [Text]
specs2Items Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
let style'' :: String
style'' = '['Char -> ShowS
forall a. a -> [a] -> [a]
: (case ListNumberStyle
style' of
DefaultStyle -> String
orderedListStyles String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
level
Decimal -> 'n'
Example -> 'n'
LowerRoman -> 'r'
UpperRoman -> 'R'
LowerAlpha -> 'a'
UpperAlpha -> 'A') Char -> ShowS
forall a. a -> [a] -> [a]
:
if [[Block]] -> Bool
isTightList [[Block]]
lst then ",packed]" else "]"
let specs :: Text
specs = String -> Text
T.pack String
style'' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
specs2
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\startenumerate" 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
specs 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]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
"\\stopenumerate" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToConTeXt (DefinitionList lst :: [([Inline], [[Block]])]
lst) =
([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> WM 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] -> WM m (Doc Text))
-> StateT WriterState m [Doc Text] -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> WM m (Doc Text))
-> [([Inline], [[Block]])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Inline], [[Block]]) -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> WM m (Doc Text)
defListItemToConTeXt [([Inline], [[Block]])]
lst
blockToConTeXt HorizontalRule = Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\thinrule" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToConTeXt (Header level :: Int
level attr :: Attr
attr lst :: [Inline]
lst) = Attr -> Int -> [Inline] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> Int -> [Inline] -> WM m (Doc Text)
sectionHeader Attr
attr Int
level [Inline]
lst
blockToConTeXt (Table _ blkCapt :: Caption
blkCapt specs :: [ColSpec]
specs thead :: TableHead
thead tbody :: [TableBody]
tbody tfoot :: TableFoot
tfoot) = do
let (caption :: [Inline]
caption, aligns :: [Alignment]
aligns, widths :: [Double]
widths, heads :: [[Block]]
heads, rows :: [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let tabl :: Tabl
tabl = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_ntb WriterOptions
opts
then Tabl
Ntb
else Tabl
Xtb
Doc Text
captionText <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
caption
Doc Text
headers <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
heads
then Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
else Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m (Doc Text)
tableRowToConTeXt Tabl
tabl [Alignment]
aligns [Double]
widths [[Block]]
heads
[Doc Text]
rows' <- ([[Block]] -> WM m (Doc Text))
-> [[[Block]]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m (Doc Text)
tableRowToConTeXt Tabl
tabl [Alignment]
aligns [Double]
widths) [[[Block]]]
rows
Doc Text
body <- Tabl -> Doc Text -> [Doc Text] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> Doc Text -> [Doc Text] -> WM m (Doc Text)
tableToConTeXt Tabl
tabl Doc Text
headers [Doc Text]
rows'
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\startplacetable" 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 (
if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
then "location=none"
else "title=" 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
braces Doc Text
captionText
) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stopplacetable" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
tableToConTeXt :: PandocMonad m
=> Tabl -> Doc Text -> [Doc Text] -> WM m (Doc Text)
tableToConTeXt :: Tabl -> Doc Text -> [Doc Text] -> WM m (Doc Text)
tableToConTeXt Xtb heads :: Doc Text
heads rows :: [Doc Text]
rows =
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\startxtable" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
(if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
heads
then Doc Text
forall a. Doc a
empty
else "\\startxtablehead[head]" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
heads Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stopxtablehead") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
(if [Doc Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
rows
then Doc Text
forall a. Doc a
empty
else "\\startxtablebody[body]" 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] -> [Doc Text]
forall a. [a] -> [a]
init [Doc Text]
rows) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stopxtablebody" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
"\\startxtablefoot[foot]" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
forall a. [a] -> a
last [Doc Text]
rows Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stopxtablefoot") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
"\\stopxtable"
tableToConTeXt Ntb heads :: Doc Text
heads rows :: [Doc Text]
rows =
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\startTABLE" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
(if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
heads
then Doc Text
forall a. Doc a
empty
else "\\startTABLEhead" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
heads Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stopTABLEhead") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
(if [Doc Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
rows
then Doc Text
forall a. Doc a
empty
else "\\startTABLEbody" 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] -> [Doc Text]
forall a. [a] -> [a]
init [Doc Text]
rows) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stopTABLEbody" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
"\\startTABLEfoot" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
forall a. [a] -> a
last [Doc Text]
rows Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stopTABLEfoot") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
"\\stopTABLE"
tableRowToConTeXt :: PandocMonad m => Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m (Doc Text)
tableRowToConTeXt :: Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m (Doc Text)
tableRowToConTeXt Xtb aligns :: [Alignment]
aligns widths :: [Double]
widths cols :: [[Block]]
cols = do
[Doc Text]
cells <- ((Alignment, Double, [Block]) -> WM m (Doc Text))
-> [(Alignment, Double, [Block])]
-> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Tabl -> (Alignment, Double, [Block]) -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> (Alignment, Double, [Block]) -> WM m (Doc Text)
tableColToConTeXt Tabl
Xtb) ([(Alignment, Double, [Block])] -> StateT WriterState m [Doc Text])
-> [(Alignment, Double, [Block])]
-> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ [Alignment]
-> [Double] -> [[Block]] -> [(Alignment, Double, [Block])]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Alignment]
aligns [Double]
widths [[Block]]
cols
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\startxrow" 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]
cells Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\stopxrow"
tableRowToConTeXt Ntb aligns :: [Alignment]
aligns widths :: [Double]
widths cols :: [[Block]]
cols = do
[Doc Text]
cells <- ((Alignment, Double, [Block]) -> WM m (Doc Text))
-> [(Alignment, Double, [Block])]
-> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Tabl -> (Alignment, Double, [Block]) -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> (Alignment, Double, [Block]) -> WM m (Doc Text)
tableColToConTeXt Tabl
Ntb) ([(Alignment, Double, [Block])] -> StateT WriterState m [Doc Text])
-> [(Alignment, Double, [Block])]
-> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ [Alignment]
-> [Double] -> [[Block]] -> [(Alignment, Double, [Block])]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Alignment]
aligns [Double]
widths [[Block]]
cols
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
cells Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ "\\NC\\NR"
tableColToConTeXt :: PandocMonad m => Tabl -> (Alignment, Double, [Block]) -> WM m (Doc Text)
tableColToConTeXt :: Tabl -> (Alignment, Double, [Block]) -> WM m (Doc Text)
tableColToConTeXt tabl :: Tabl
tabl (align :: Alignment
align, width :: Double
width, blocks :: [Block]
blocks) = do
Doc Text
cellContents <- [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
blocks
let colwidth :: Doc Text
colwidth = if Double
width Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then Doc Text
forall a. Doc a
empty
else "width=" 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
braces (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Double -> String
forall r. PrintfType r => String -> r
printf "%.2f\\textwidth" Double
width))
let halign :: Doc Text
halign = Alignment -> Doc Text
alignToConTeXt Alignment
align
let options :: Doc Text
options = (if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
keys
then Doc Text
forall a. Doc a
empty
else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
keys) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space
where keys :: Doc Text
keys = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse "," ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Bool) -> [Doc Text] -> [Doc Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc Text -> Bool) -> Doc Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty) [Doc Text
halign, Doc Text
colwidth]
Tabl -> Doc Text -> Doc Text -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> Doc Text -> Doc Text -> WM m (Doc Text)
tableCellToConTeXt Tabl
tabl Doc Text
options Doc Text
cellContents
tableCellToConTeXt :: PandocMonad m
=> Tabl -> Doc Text -> Doc Text -> WM m (Doc Text)
tableCellToConTeXt :: Tabl -> Doc Text -> Doc Text -> WM m (Doc Text)
tableCellToConTeXt Xtb options :: Doc Text
options cellContents :: Doc Text
cellContents =
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\startxcell" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
options Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
cellContents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> " \\stopxcell"
tableCellToConTeXt Ntb options :: Doc Text
options cellContents :: Doc Text
cellContents =
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\NC" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
options Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
cellContents
alignToConTeXt :: Alignment -> Doc Text
alignToConTeXt :: Alignment -> Doc Text
alignToConTeXt align :: Alignment
align = case Alignment
align of
AlignLeft -> "align=right"
AlignRight -> "align=left"
AlignCenter -> "align=middle"
AlignDefault -> Doc Text
forall a. Doc a
empty
listItemToConTeXt :: PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt :: [Block] -> WM m (Doc Text)
listItemToConTeXt list :: [Block]
list = ("\\item" 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
. Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest 2 (Doc Text -> Doc Text) -> WM m (Doc Text) -> WM m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
list
defListItemToConTeXt :: PandocMonad m => ([Inline], [[Block]]) -> WM m (Doc Text)
defListItemToConTeXt :: ([Inline], [[Block]]) -> WM m (Doc Text)
defListItemToConTeXt (term :: [Inline]
term, defs :: [[Block]]
defs) = do
Doc Text
term' <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
term
Doc Text
def' <- ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> WM 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
vsep (StateT WriterState m [Doc Text] -> WM m (Doc Text))
-> StateT WriterState m [Doc Text] -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ([Block] -> WM m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [[Block]]
defs
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\startdescription" 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
braces Doc Text
term' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest 2 Doc Text
def' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
"\\stopdescription" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockListToConTeXt :: PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt :: [Block] -> WM m (Doc Text)
blockListToConTeXt lst :: [Block]
lst = ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> WM 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] -> WM m (Doc Text))
-> StateT WriterState m [Doc Text] -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Block -> WM m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> WM m (Doc Text)
blockToConTeXt [Block]
lst
inlineListToConTeXt :: PandocMonad m
=> [Inline]
-> WM m (Doc Text)
inlineListToConTeXt :: [Inline] -> WM m (Doc Text)
inlineListToConTeXt lst :: [Inline]
lst = ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> WM 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
hcat (StateT WriterState m [Doc Text] -> WM m (Doc Text))
-> StateT WriterState m [Doc Text] -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Inline -> WM m (Doc Text))
-> [Inline] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> WM m (Doc Text)
inlineToConTeXt ([Inline] -> StateT WriterState m [Doc Text])
-> [Inline] -> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
addStruts [Inline]
lst
where addStruts :: [Inline] -> [Inline]
addStruts (LineBreak : s :: Inline
s : xs :: [Inline]
xs) | Inline -> Bool
isSpacey Inline
s =
Inline
LineBreak Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline (Text -> Format
Format "context") "\\strut " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
s Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:
[Inline] -> [Inline]
addStruts [Inline]
xs
addStruts (x :: Inline
x:xs :: [Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
addStruts [Inline]
xs
addStruts [] = []
isSpacey :: Inline -> Bool
isSpacey Space = Bool
True
isSpacey (Str (Text -> Maybe (Char, Text)
T.uncons -> Just ('\160',_))) = Bool
True
isSpacey _ = Bool
False
inlineToConTeXt :: PandocMonad m
=> Inline
-> WM m (Doc Text)
inlineToConTeXt :: Inline -> WM m (Doc Text)
inlineToConTeXt (Emph lst :: [Inline]
lst) = do
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ "\\em " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
inlineToConTeXt (Underline lst :: [Inline]
lst) = do
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\underbar" 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
braces Doc Text
contents
inlineToConTeXt (Strong lst :: [Inline]
lst) = do
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ "\\bf " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
inlineToConTeXt (Strikeout lst :: [Inline]
lst) = do
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\overstrikes" 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
braces Doc Text
contents
inlineToConTeXt (Superscript lst :: [Inline]
lst) = do
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\high" 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
braces Doc Text
contents
inlineToConTeXt (Subscript lst :: [Inline]
lst) = do
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\low" 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
braces Doc Text
contents
inlineToConTeXt (SmallCaps lst :: [Inline]
lst) = do
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ "\\sc " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
inlineToConTeXt (Code _ str :: Text
str) | Bool -> Bool
not ('{' Char -> Text -> Bool
`elemText` Text
str Bool -> Bool -> Bool
|| '}' Char -> Text -> Bool
`elemText` Text
str) =
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\type" 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
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str)
inlineToConTeXt (Code _ str :: Text
str) = do
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\mono" 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
braces (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
stringToConTeXt WriterOptions
opts Text
str)
inlineToConTeXt (Quoted SingleQuote lst :: [Inline]
lst) = do
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\quote" 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
braces Doc Text
contents
inlineToConTeXt (Quoted DoubleQuote lst :: [Inline]
lst) = do
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\quotation" 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
braces Doc Text
contents
inlineToConTeXt (Cite _ lst :: [Inline]
lst) = [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
inlineToConTeXt (Str str :: Text
str) = do
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM 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
stringToConTeXt WriterOptions
opts Text
str
inlineToConTeXt (Math InlineMath str :: Text
str) =
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char '$' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char '$'
inlineToConTeXt (Math DisplayMath str :: Text
str) =
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "\\startformula " 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
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal " \\stopformula" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space
inlineToConTeXt il :: Inline
il@(RawInline f :: Format
f str :: Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "tex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "context" = Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM 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 = Doc Text
forall a. Doc a
empty Doc Text -> StateT WriterState m () -> WM m (Doc Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Inline -> LogMessage
InlineNotRendered Inline
il)
inlineToConTeXt LineBreak = Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "\\crlf" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToConTeXt SoftBreak = do
WrapOption
wrapText <- (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions)
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ case WrapOption
wrapText of
WrapAuto -> Doc Text
forall a. Doc a
space
WrapNone -> Doc Text
forall a. Doc a
space
WrapPreserve -> Doc Text
forall a. Doc a
cr
inlineToConTeXt Space = Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToConTeXt (Link _ txt :: [Inline]
txt (Text -> Maybe (Char, Text)
T.uncons -> Just ('#', ref :: Text
ref), _)) = do
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
txt
let ref' :: Text
ref' = Text -> Text
toLabel (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text -> Text
stringToConTeXt WriterOptions
opts Text
ref
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "\\goto"
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
braces Doc Text
contents
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ref')
inlineToConTeXt (Link _ txt :: [Inline]
txt (src :: Text
src, _)) = do
let isAutolink :: Bool
isAutolink = [Inline]
txt [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src)]
WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
let next :: Int
next = WriterState -> Int
stNextRef WriterState
st
WriterState -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (WriterState -> StateT WriterState m ())
-> WriterState -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ WriterState
st {stNextRef :: Int
stNextRef = Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1}
let ref :: Text
ref = "url" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
next
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
txt
let escChar :: Char -> Text
escChar '#' = "\\#"
escChar '%' = "\\%"
escChar c :: Char
c = Char -> Text
T.singleton Char
c
let escContextURL :: Text -> Text
escContextURL = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escChar
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "\\useURL"
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ref)
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escContextURL Text
src)
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
isAutolink
then Doc Text
forall a. Doc a
empty
else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
forall a. Doc a
empty 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 Doc Text
contents)
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "\\from"
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ref)
inlineToConTeXt (Image attr :: Attr
attr@(_,cls :: [Text]
cls,_) _ (src :: Text
src, _)) = do
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let showDim :: Direction -> [Doc Text]
showDim dir :: Direction
dir = let d :: Doc Text
d = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Direction -> Text
forall a. Show a => a -> Text
tshow Direction
dir) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "="
in case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
Just (Pixel a :: Integer
a) ->
[Doc Text
d 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 -> Dimension -> Text
showInInch WriterOptions
opts (Integer -> Dimension
Pixel Integer
a)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "in"]
Just (Percent a :: Double
a) ->
[Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 100)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "\\textwidth"]
Just dim :: Dimension
dim ->
[Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
dim)]
Nothing ->
[]
dimList :: [Doc Text]
dimList = Direction -> [Doc Text]
showDim Direction
Width [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ Direction -> [Doc Text]
showDim Direction
Height
dims :: Doc Text
dims = if [Doc Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
dimList
then Doc Text
forall a. Doc a
empty
else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse "," [Doc Text]
dimList)
clas :: Doc Text
clas = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls
then Doc Text
forall a. Doc a
empty
else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (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 -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
toLabel (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head [Text]
cls
fixPathSeparators :: Text -> Text
fixPathSeparators = (Char -> Char) -> Text -> Text
T.map ((Char -> Char) -> Text -> Text) -> (Char -> Char) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \c :: Char
c -> case Char
c of
'\\' -> '/'
_ -> Char
c
src' :: Text
src' = Text -> Text
fixPathSeparators (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
if Text -> Bool
isURI Text
src
then Text
src
else String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ "\\externalfigure" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src') Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
dims Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
clas
inlineToConTeXt (Note contents :: [Block]
contents) = do
Doc Text
contents' <- [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
contents
let codeBlock :: Block -> [Block]
codeBlock x :: Block
x@(CodeBlock _ _) = [Block
x]
codeBlock _ = []
let codeBlocks :: [Block]
codeBlocks = (Block -> [Block]) -> [Block] -> [Block]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [Block]
codeBlock [Block]
contents
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
codeBlocks
then Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "\\footnote{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest 2 (Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp 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 '}'
else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "\\startbuffer " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest 2 (Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp 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 "\\stopbuffer\\footnote{\\getbuffer}"
inlineToConTeXt (Span (ident :: Text
ident,_,kvs :: [Target]
kvs) ils :: [Inline]
ils) = do
Maybe Text
mblang <- Maybe Text -> WM m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Maybe Text -> WM m (Maybe Text)
fromBCP47 (Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "lang" [Target]
kvs)
let wrapDir :: Doc a -> Doc a
wrapDir txt :: Doc a
txt = case Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "dir" [Target]
kvs of
Just "rtl" -> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
braces (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ "\\righttoleft " Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
txt
Just "ltr" -> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
braces (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ "\\lefttoright " Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
txt
_ -> Doc a
txt
wrapLang :: Doc Text -> Doc Text
wrapLang txt :: Doc Text
txt = case Maybe Text
mblang of
Just lng :: Text
lng -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces ("\\language" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
lng) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
txt)
Nothing -> Doc Text
txt
addReference :: Doc Text -> Doc Text
addReference =
if Text -> Bool
T.null Text
ident
then Doc Text -> Doc Text
forall a. a -> a
id
else (("\\reference" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "{}") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>)
Doc Text -> Doc Text
addReference (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
wrapLang (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. HasChars a => Doc a -> Doc a
wrapDir (Doc Text -> Doc Text) -> WM m (Doc Text) -> WM m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
ils
sectionHeader :: PandocMonad m
=> Attr
-> Int
-> [Inline]
-> WM m (Doc Text)
(ident :: Text
ident,classes :: [Text]
classes,kvs :: [Target]
kvs) hdrLevel :: Int
hdrLevel lst :: [Inline]
lst = do
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
Doc Text
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
Doc Text
levelText <- WriterOptions -> Attr -> Int -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Int -> WM m (Doc Text)
sectionLevelToText WriterOptions
opts (Text
ident,[Text]
classes,[Target]
kvs) Int
hdrLevel
let ident' :: Doc Text
ident' = if Text -> Bool
T.null Text
ident
then Doc Text
forall a. Doc a
empty
else "reference=" 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
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
toLabel Text
ident))
let contents' :: Doc Text
contents' = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
contents
then Doc Text
forall a. Doc a
empty
else "title=" 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
braces Doc Text
contents
let options :: Doc Text
options = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
keys Bool -> Bool -> Bool
|| Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
levelText
then Doc Text
forall a. Doc a
empty
else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
keys
where keys :: Doc Text
keys = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse "," ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Bool) -> [Doc Text] -> [Doc Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc Text -> Bool) -> Doc Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty) [Doc Text
contents', Doc Text
ident']
let starter :: Doc Text
starter = if WriterOptions -> Bool
writerSectionDivs WriterOptions
opts
then "\\start"
else "\\"
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
starter Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
levelText Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
options Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
sectionFooter :: PandocMonad m => Attr -> Int -> WM m (Doc Text)
attr :: Attr
attr hdrLevel :: Int
hdrLevel = do
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
Doc Text
levelText <- WriterOptions -> Attr -> Int -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Int -> WM m (Doc Text)
sectionLevelToText WriterOptions
opts Attr
attr Int
hdrLevel
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if WriterOptions -> Bool
writerSectionDivs WriterOptions
opts
then "\\stop" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
levelText Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
else Doc Text
forall a. Doc a
empty
sectionLevelToText :: PandocMonad m => WriterOptions -> Attr -> Int -> WM m (Doc Text)
sectionLevelToText :: WriterOptions -> Attr -> Int -> WM m (Doc Text)
sectionLevelToText opts :: WriterOptions
opts (_,classes :: [Text]
classes,_) hdrLevel :: Int
hdrLevel = do
let level' :: Int
level' = case WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts of
TopLevelPart -> Int
hdrLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2
TopLevelChapter -> Int
hdrLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
TopLevelSection -> Int
hdrLevel
TopLevelDefault -> Int
hdrLevel
let (section :: Doc Text
section, chapter :: Doc Text
chapter) = if "unnumbered" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
then (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "subject", Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "title")
else (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "section", Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "chapter")
Doc Text -> WM m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text)) -> Doc Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$ case Int
level' of
-1 -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal "part"
0 -> Doc Text
chapter
n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 -> String -> Doc Text
forall a. HasChars a => String -> Doc a
text ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) "sub"))
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
section
_ -> Doc Text
forall a. Doc a
empty
fromBCP47 :: PandocMonad m => Maybe Text -> WM m (Maybe Text)
fromBCP47 :: Maybe Text -> WM m (Maybe Text)
fromBCP47 mbs :: Maybe Text
mbs = Maybe Lang -> Maybe Text
fromBCP47' (Maybe Lang -> Maybe Text)
-> StateT WriterState m (Maybe Lang) -> WM m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> StateT WriterState m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang Maybe Text
mbs
fromBCP47' :: Maybe Lang -> Maybe Text
fromBCP47' :: Maybe Lang -> Maybe Text
fromBCP47' (Just (Lang "ar" _ (Just "SY") _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "ar-sy"
fromBCP47' (Just (Lang "ar" _ (Just "IQ") _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "ar-iq"
fromBCP47' (Just (Lang "ar" _ (Just "JO") _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "ar-jo"
fromBCP47' (Just (Lang "ar" _ (Just "LB") _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "ar-lb"
fromBCP47' (Just (Lang "ar" _ (Just "DZ") _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "ar-dz"
fromBCP47' (Just (Lang "ar" _ (Just "MA") _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "ar-ma"
fromBCP47' (Just (Lang "de" _ _ ["1901"] _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "deo"
fromBCP47' (Just (Lang "de" _ (Just "DE") _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "de-de"
fromBCP47' (Just (Lang "de" _ (Just "AT") _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "de-at"
fromBCP47' (Just (Lang "de" _ (Just "CH") _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "de-ch"
fromBCP47' (Just (Lang "el" _ _ ["poly"] _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "agr"
fromBCP47' (Just (Lang "en" _ (Just "US") _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "en-us"
fromBCP47' (Just (Lang "en" _ (Just "GB") _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "en-gb"
fromBCP47' (Just (Lang "grc"_ _ _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "agr"
fromBCP47' (Just (Lang "el" _ _ _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "gr"
fromBCP47' (Just (Lang "eu" _ _ _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "ba"
fromBCP47' (Just (Lang "he" _ _ _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "il"
fromBCP47' (Just (Lang "jp" _ _ _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "ja"
fromBCP47' (Just (Lang "uk" _ _ _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "ua"
fromBCP47' (Just (Lang "vi" _ _ _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "vn"
fromBCP47' (Just (Lang "zh" _ _ _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just "cn"
fromBCP47' (Just (Lang l :: Text
l _ _ _ _ _)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l
fromBCP47' Nothing = Maybe Text
forall a. Maybe a
Nothing