{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where
import Control.Monad (liftM, unless)
import Control.Monad.State.Strict
( StateT, MonadState(put, get), gets, modify, evalStateT )
import Data.Char (ord, isDigit)
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Maybe (isNothing, mapMaybe, catMaybes)
import Data.Monoid (Any (Any, getAny))
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.Highlighting
(formatConTeXtBlock, formatConTeXtInline, highlight, styleToConTeXt)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.URI (isURI)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Walk (query)
import Text.Pandoc.Writers.Shared
import Text.Printf (printf)
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map.Strict as Map
import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
data WriterState =
WriterState
{ WriterState -> Bool
stCslHangingIndent :: Bool
, WriterState -> Bool
stHasCslRefs :: Bool
, WriterState -> Bool
stHighlighting :: Bool
, WriterState -> Int
stNextRef :: Int
, WriterState -> WriterOptions
stOptions :: WriterOptions
, WriterState -> Int
stOrderedListLevel :: Int
, WriterState -> Map Text (Doc Text)
stEmphasisCommands :: Map.Map Text (Doc Text)
}
data Tabl = Xtb
| Ntb
deriving (Int -> Tabl -> ShowS
[Tabl] -> ShowS
Tabl -> [Char]
(Int -> Tabl -> ShowS)
-> (Tabl -> [Char]) -> ([Tabl] -> ShowS) -> Show Tabl
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tabl -> ShowS
showsPrec :: Int -> Tabl -> ShowS
$cshow :: Tabl -> [Char]
show :: Tabl -> [Char]
$cshowList :: [Tabl] -> ShowS
showList :: [Tabl] -> ShowS
Show, Tabl -> Tabl -> Bool
(Tabl -> Tabl -> Bool) -> (Tabl -> Tabl -> Bool) -> Eq Tabl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tabl -> Tabl -> Bool
== :: Tabl -> Tabl -> Bool
$c/= :: Tabl -> Tabl -> Bool
/= :: Tabl -> Tabl -> Bool
Eq)
data HeadingType = SectionHeading | NonSectionHeading
orderedListStyles :: [Char]
orderedListStyles :: [Char]
orderedListStyles = ShowS
forall a. HasCallStack => [a] -> [a]
cycle [Char]
"narg"
writeConTeXt :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeConTeXt :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeConTeXt WriterOptions
options Pandoc
document =
let defaultWriterState :: WriterState
defaultWriterState = WriterState
{ stCslHangingIndent :: Bool
stCslHangingIndent = Bool
False
, stHasCslRefs :: Bool
stHasCslRefs = Bool
False
, stHighlighting :: Bool
stHighlighting = Bool
False
, stNextRef :: Int
stNextRef = Int
1
, stOptions :: WriterOptions
stOptions = WriterOptions
options
, stOrderedListLevel :: Int
stOrderedListLevel = Int
0
, stEmphasisCommands :: Map Text (Doc Text)
stEmphasisCommands = Map Text (Doc Text)
forall a. Monoid a => a
mempty
}
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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> WM m Text
pandocToConTeXt WriterOptions
options (Pandoc Meta
meta [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
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 a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt)
Meta
meta
main <- blockListToConTeXt $ makeSections False Nothing blocks
let 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] -> [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 (\(Doc Text
x,Text
y) ->
((Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"=") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text) -> 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)
[(Doc Text
"leftmargin",Text
"margin-left")
,(Doc Text
"rightmargin",Text
"margin-right")
,(Doc Text
"top",Text
"margin-top")
,(Doc Text
"bottom",Text
"margin-bottom")
]
mblang <- fromBCP47 (getLang options meta)
st <- get
let context = Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
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 Text
"lof" (WriterOptions -> Bool
writerListOfFigures 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 Text
"lot" (WriterOptions -> Bool
writerListOfTables 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 Text
"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] -> 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
TopLevelDivision
TopLevelPart -> Int
0
TopLevelDivision
TopLevelChapter -> Int
0
TopLevelDivision
_ -> Int
1)
[Doc Text
"chapter",Doc Text
"section",Doc Text
"subsection",Doc Text
"subsubsection",
Doc Text
"subsubsubsection",Doc Text
"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 Text
"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 Text
"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 Text
"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 Text
"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 Text
"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 (\Text
l ->
Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"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 -> [Char]
T.unpack (Text -> [Char]) -> (Doc Text -> Text) -> Doc Text -> [Char]
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 -> [Char]) -> Maybe (Doc Text) -> Maybe [Char]
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
"papersize" Context Text
metadata of
Just ((Char
'a':Char
d:[Char]
ds) :: String)
| (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit (Char
dChar -> ShowS
forall a. a -> [a] -> [a]
:[Char]
ds) -> Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"papersize"
([Char] -> Text
T.pack (Char
'A'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
dChar -> ShowS
forall a. a -> [a] -> [a]
:[Char]
ds))
Maybe [Char]
_ -> Context Text -> Context Text
forall a. a -> a
id)
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"emphasis-commands"
([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
$ Map Text (Doc Text) -> [Doc Text]
forall k a. Map k a -> [a]
Map.elems (WriterState -> Map Text (Doc Text)
stEmphasisCommands WriterState
st))
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (case WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
options of
Just Style
sty | WriterState -> Bool
stHighlighting WriterState
st ->
Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"highlighting-commands" (Style -> Text
styleToConTeXt Style
sty)
Maybe Style
_ -> 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 Text
"pdfa" Meta
meta of
Text
"true" -> Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"pdfa" ([Char] -> Text
T.pack [Char]
"1b:2005")
Text
_ -> Context Text -> Context Text
forall a. a -> a
id) Context Text
metadata
let context' = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"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 Text
"dir" Context Text
context) Context Text
context
return $ render colwidth $
case writerTemplate options 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'
toContextDir :: Doc Text -> Doc Text
toContextDir :: Doc Text -> Doc Text
toContextDir = (Text -> Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
t -> case Text
t of
Text
"ltr" -> Text
"l2r"
Text
"rtl" -> Text
"r2l"
Text
_ -> Text
t)
escapeCharForConTeXt :: WriterOptions -> Char -> Text
escapeCharForConTeXt :: WriterOptions -> Char -> Text
escapeCharForConTeXt WriterOptions
opts 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
Char
'{' -> Text
"\\{"
Char
'}' -> Text
"\\}"
Char
'\\' -> Text
"\\letterbackslash{}"
Char
'$' -> Text
"\\$"
Char
'|' -> Text
"\\letterbar{}"
Char
'%' -> Text
"\\letterpercent{}"
Char
'~' -> Text
"\\lettertilde{}"
Char
'#' -> Text
"\\#"
Char
'[' -> Text
"{[}"
Char
']' -> Text
"{]}"
Char
'\160' -> Text
"~"
Char
'\x2014' | Bool
ligatures -> Text
"---"
Char
'\x2013' | Bool
ligatures -> Text
"--"
Char
'\x2019' | Bool
ligatures -> Text
"'"
Char
'\x2026' -> Text
"\\ldots{}"
Char
x -> Char -> Text
T.singleton Char
x
stringToConTeXt :: WriterOptions -> Text -> Text
stringToConTeXt :: WriterOptions -> Text -> Text
stringToConTeXt WriterOptions
opts = (Char -> Text) -> Text -> Text
T.concatMap (WriterOptions -> Char -> Text
escapeCharForConTeXt WriterOptions
opts)
toLabel :: Text -> Text
toLabel :: Text -> Text
toLabel Text
z = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
go Text
z
where go :: Char -> Text
go Char
x
| Char
x Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"\\#[]\",{}%()|=" :: String) = Text
"ux" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%x" (Char -> Int
ord Char
x))
| Bool
otherwise = Char -> Text
T.singleton Char
x
blockToConTeXt :: PandocMonad m => Block -> WM m (Doc Text)
blockToConTeXt :: forall (m :: * -> *). PandocMonad m => Block -> WM m (Doc Text)
blockToConTeXt (Div attr :: Attr
attr@(Text
_,Text
"section":[Text]
_,[(Text, Text)]
_)
(Header Int
level Attr
_ [Inline]
title' : [Block]
xs)) = do
header' <- Attr -> Int -> [Inline] -> HeadingType -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> Int -> [Inline] -> HeadingType -> WM m (Doc Text)
sectionHeader Attr
attr Int
level [Inline]
title' HeadingType
SectionHeading
footer' <- sectionFooter attr level
innerContents <- blockListToConTeXt xs
return $ header' $$ innerContents $$ footer'
blockToConTeXt (Plain [Inline]
lst) = do
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
contents <- inlineListToConTeXt lst
return $
if isEnabled Ext_tagging opts
then "\\bpar{}" <> contents <> "\\epar{}"
else contents
blockToConTeXt (Para [Inline]
lst) = do
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
contents <- inlineListToConTeXt lst
return $
if isEnabled Ext_tagging opts
then "\\bpar" $$ contents $$ "\\epar" <> blankline
else contents <> blankline
blockToConTeXt (LineBlock [[Inline]]
lns) = do
let emptyToBlankline :: Doc a -> Doc a
emptyToBlankline 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
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [[Inline]]
lns
let 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
return $ "\\startlines" $$ contextLines $$ "\\stoplines" <> blankline
blockToConTeXt (BlockQuote [Block]
lst) = do
contents <- [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
lst
return $ "\\startblockquote" $$ nest 0 contents $$ "\\stopblockquote" <> blankline
blockToConTeXt (CodeBlock (Text
_ident, [Text]
classes, [(Text, Text)]
kv) Text
str) = do
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let syntaxMap = WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts
let attr' = (Text
"", [Text]
classes, [(Text, Text)]
kv)
let unhighlighted = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text
"\\starttyping", Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str, Doc Text
"\\stoptyping"]
let highlighted =
case SyntaxMap
-> (FormatOptions -> [SourceLine] -> Text)
-> Attr
-> Text
-> Either Text Text
forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight SyntaxMap
syntaxMap FormatOptions -> [SourceLine] -> Text
formatConTeXtBlock Attr
attr' Text
str of
Left Text
msg -> do
Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$
LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> LogMessage
CouldNotHighlight Text
msg)
Doc Text -> WM m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
unhighlighted
Right Text
h -> do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{ stHighlighting = True })
Doc Text -> WM 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
h)
($$ blankline) . flush <$>
if null classes || isNothing (writerHighlightStyle opts)
then pure unhighlighted
else highlighted
blockToConTeXt b :: Block
b@(RawBlock Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"context" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex" = Doc Text -> WM m (Doc Text)
forall a. a -> StateT WriterState m a
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 a b. a -> StateT WriterState m b -> StateT WriterState m a
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 (Text
"refs",[Text]
classes,[(Text, Text)]
_) [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
$ \WriterState
st -> WriterState
st{ stHasCslRefs = True
, stCslHangingIndent = "hanging-indent" `elem` classes }
inner <- [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
bs
return $ "\\startcslreferences" $$ inner $$ "\\stopcslreferences"
blockToConTeXt (Div (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Block]
bs) = do
let align :: Doc a -> Doc a -> Doc a
align Doc a
dir Doc a
txt = Doc a
"\\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 -> 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
$$ Doc a
"\\stopalignment"
mblang <- Maybe Text -> WM m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Maybe Text -> WM m (Maybe Text)
fromBCP47 (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs)
let wrapRef Doc Text
txt = if Text -> Bool
T.null Text
ident
then Doc Text
txt
else (Doc Text
"\\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 -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
txt
wrapDir = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
Just Text
"rtl" -> Doc Text -> Doc Text -> Doc Text
forall {a}. HasChars a => Doc a -> Doc a -> Doc a
align Doc Text
"righttoleft"
Just Text
"ltr" -> Doc Text -> Doc Text -> Doc Text
forall {a}. HasChars a => Doc a -> Doc a -> Doc a
align Doc Text
"lefttoright"
Maybe Text
_ -> Doc Text -> Doc Text
forall a. a -> a
id
wrapLang Doc Text
txt = case Maybe Text
mblang of
Just Text
lng -> Doc Text
"\\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 -> 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
$$ Doc Text
"\\stop"
Maybe Text
Nothing -> Doc Text
txt
wrapBlank 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
wrapBlank . wrapLang . wrapDir . wrapRef <$> blockListToConTeXt bs
blockToConTeXt (BulletList [[Block]]
lst) = do
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt [[Block]]
lst
return $ ("\\startitemize" <> if isTightList lst
then brackets "packed"
else empty) $$
vcat contents $$ literal "\\stopitemize" <> blankline
blockToConTeXt (OrderedList (Int
start, ListNumberStyle
style', ListNumberDelim
delim) [[Block]]
lst) = do
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
let level = WriterState -> Int
stOrderedListLevel WriterState
st
put st {stOrderedListLevel = level + 1}
contents <- mapM listItemToConTeXt lst
put st {stOrderedListLevel = level}
let start' = if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"start=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
start
let delim' = case ListNumberDelim
delim of
ListNumberDelim
DefaultDelim -> Text
""
ListNumberDelim
Period -> Text
"stopper=."
ListNumberDelim
OneParen -> Text
"stopper=)"
ListNumberDelim
TwoParens -> Text
"left=(,stopper=)"
let 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 = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
specs2Items
then Text
""
else Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," [Text]
specs2Items Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
let style'' = Char
'['Char -> ShowS
forall a. a -> [a] -> [a]
: (case ListNumberStyle
style' of
ListNumberStyle
DefaultStyle -> [Char]
orderedListStyles [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
level
ListNumberStyle
Decimal -> Char
'n'
ListNumberStyle
Example -> Char
'n'
ListNumberStyle
LowerRoman -> Char
'r'
ListNumberStyle
UpperRoman -> Char
'R'
ListNumberStyle
LowerAlpha -> Char
'a'
ListNumberStyle
UpperAlpha -> Char
'A') Char -> ShowS
forall a. a -> [a] -> [a]
:
if [[Block]] -> Bool
isTightList [[Block]]
lst then [Char]
",packed]" else [Char]
"]"
let specs = [Char] -> Text
T.pack [Char]
style'' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
specs2
return $ "\\startenumerate" <> literal specs $$ vcat contents $$
"\\stopenumerate" <> blankline
blockToConTeXt (DefinitionList [([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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Inline], [[Block]]) -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> WM m (Doc Text)
defListItemToConTeXt [([Inline], [[Block]])]
lst
blockToConTeXt Block
HorizontalRule = Doc Text -> WM m (Doc Text)
forall a. a -> StateT WriterState m a
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
"\\thinrule" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToConTeXt (Header Int
level Attr
attr [Inline]
lst) =
Attr -> Int -> [Inline] -> HeadingType -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> Int -> [Inline] -> HeadingType -> WM m (Doc Text)
sectionHeader Attr
attr Int
level [Inline]
lst HeadingType
NonSectionHeading
blockToConTeXt (Table Attr
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =
Table -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => Table -> WM m (Doc Text)
tableToConTeXt (Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Ann.toTable Attr
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot)
blockToConTeXt (Figure (Text
ident, [Text]
_, [(Text, Text)]
_) (Caption Maybe [Inline]
cshort [Block]
clong) [Block]
body) = do
title <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt ([Block] -> [Inline]
blocksToInlines [Block]
clong)
list <- maybe (pure empty) inlineListToConTeXt cshort
content <- blockListToConTeXt body
let options =
[Doc Text
"reference=" 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 -> Text
toLabel Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)]
[Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ [Doc Text
"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
title | Bool -> Bool
not (Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
title)]
[Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ [Doc Text
"list=" 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
list | Bool -> Bool
not (Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
list)]
let hasSubfigures = Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$
(Block -> Any) -> [Block] -> Any
forall c. Monoid c => (Block -> c) -> [Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (Bool -> Any
Any (Bool -> Any) -> (Block -> Bool) -> Block -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case {Figure {} -> Bool
True; Block
_ -> Bool
False}) [Block]
body
return
$ "\\startplacefigure" <> brackets (mconcat $ intersperse "," options)
$$ (if hasSubfigures then "\\startfloatcombination" else empty)
$$ content
$$ (if hasSubfigures then "\\stopfloatcombination" else empty)
$$ "\\stopplacefigure"
$$ blankline
tableToConTeXt :: PandocMonad m => Ann.Table -> WM m (Doc Text)
tableToConTeXt :: forall (m :: * -> *). PandocMonad m => Table -> WM m (Doc Text)
tableToConTeXt (Ann.Table Attr
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot) = do
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let tabl = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_ntb WriterOptions
opts
then Tabl
Ntb
else Tabl
Xtb
captionText <- case caption of
Caption Maybe [Inline]
_ [] -> 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. Monoid a => a
mempty
Caption Maybe [Inline]
_ [Block]
longCapt -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
longCapt
head' <- tableHeadToConTeXt tabl thead
bodies <- mapM (tableBodyToConTeXt tabl) tbodies
foot' <- tableFootToConTeXt tabl tfoot
let body = case Tabl
tabl of
Tabl
Xtb -> Doc Text
"\\startxtable" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
head' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
"\\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]
bodies Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
"\\stopxtablebody" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
foot' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
"\\stopxtable"
Tabl
Ntb -> [ColSpec] -> Doc Text
setupCols [ColSpec]
colspecs Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
"\\bTABLE" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
head' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
"\\bTABLEbody" 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]
bodies Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
"\\eTABLEbody" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
foot' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
"\\eTABLE"
let (ident, _classes, _attribs) = attr
let tblopts = (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)
[ if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
captionText
then Doc Text
"location=none"
else Doc Text
"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
, if Text -> Bool
T.null Text
ident
then Doc Text
forall a. Doc a
empty
else Doc Text
"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))
]
return $ vcat
[ "\\startplacetable" <> brackets (mconcat $ intersperse "," tblopts)
, body
, "\\stopplacetable" <> blankline
]
setupCols :: [ColSpec] -> Doc Text
setupCols :: [ColSpec] -> Doc Text
setupCols = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ([ColSpec] -> [Doc Text]) -> [ColSpec] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ColSpec -> Doc Text) -> [Int] -> [ColSpec] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ColSpec -> Doc Text
forall {a} {a}. (HasChars a, Show a) => a -> ColSpec -> Doc a
toColSetup [Int
1::Int ..]
where
toColSetup :: a -> ColSpec -> Doc a
toColSetup a
i (Alignment
align, ColWidth
width) =
let opts :: [Doc a]
opts = (Doc a -> Bool) -> [Doc a] -> [Doc a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc a -> Bool) -> Doc a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> Bool
forall a. Doc a -> Bool
isEmpty)
[ case Alignment
align of
Alignment
AlignLeft -> Doc a
"align=right"
Alignment
AlignRight -> Doc a
"align=left"
Alignment
AlignCenter -> Doc a
"align=middle"
Alignment
AlignDefault -> Doc a
"align=left"
, case ColWidth
width of
ColWidth
ColWidthDefault -> Doc a
forall a. Doc a
empty
ColWidth Double
w -> (Doc a
"width=" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>) (Doc a -> Doc a) -> ([Char] -> Doc a) -> [Char] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
braces (Doc a -> Doc a) -> ([Char] -> Doc a) -> [Char] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc a
forall a. HasChars a => [Char] -> Doc a
text ([Char] -> Doc a) -> [Char] -> Doc a
forall a b. (a -> b) -> a -> b
$
[Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%.2f\\textwidth" Double
w
]
in Doc a
"\\setupTABLE[column]" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
brackets ([Char] -> Doc a
forall a. HasChars a => [Char] -> Doc a
text ([Char] -> Doc a) -> [Char] -> Doc a
forall a b. (a -> b) -> a -> b
$ a -> [Char]
forall a. Show a => a -> [Char]
show a
i)
Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
brackets ([Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse Doc a
"," [Doc a]
opts)
tableBodyToConTeXt :: PandocMonad m
=> Tabl
-> Ann.TableBody
-> WM m (Doc Text)
tableBodyToConTeXt :: forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableBody -> WM m (Doc Text)
tableBodyToConTeXt Tabl
tabl (Ann.TableBody Attr
_attr RowHeadColumns
_rowHeadCols [HeaderRow]
inthead [BodyRow]
rows) = do
intermediateHead <-
if [HeaderRow] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeaderRow]
inthead
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. Monoid a => a
mempty
else Tabl -> TablePart -> [HeaderRow] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> TablePart -> [HeaderRow] -> WM m (Doc Text)
headerRowsToConTeXt Tabl
tabl TablePart
Thead [HeaderRow]
inthead
bodyRows <- bodyRowsToConTeXt tabl rows
return $ intermediateHead <> bodyRows
tableHeadToConTeXt :: PandocMonad m
=> Tabl
-> Ann.TableHead
-> WM m (Doc Text)
tableHeadToConTeXt :: forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableHead -> WM m (Doc Text)
tableHeadToConTeXt Tabl
tabl (Ann.TableHead Attr
attr [HeaderRow]
rows) =
Tabl -> TablePart -> Attr -> [HeaderRow] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> TablePart -> Attr -> [HeaderRow] -> WM m (Doc Text)
tablePartToConTeXt Tabl
tabl TablePart
Thead Attr
attr [HeaderRow]
rows
tableFootToConTeXt :: PandocMonad m
=> Tabl
-> Ann.TableFoot
-> WM m (Doc Text)
Tabl
tbl (Ann.TableFoot Attr
attr [HeaderRow]
rows) =
Tabl -> TablePart -> Attr -> [HeaderRow] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> TablePart -> Attr -> [HeaderRow] -> WM m (Doc Text)
tablePartToConTeXt Tabl
tbl TablePart
Tfoot Attr
attr [HeaderRow]
rows
tablePartToConTeXt :: PandocMonad m
=> Tabl
-> TablePart
-> Attr
-> [Ann.HeaderRow]
-> WM m (Doc Text)
tablePartToConTeXt :: forall (m :: * -> *).
PandocMonad m =>
Tabl -> TablePart -> Attr -> [HeaderRow] -> WM m (Doc Text)
tablePartToConTeXt Tabl
tabl TablePart
tblpart Attr
_attr [HeaderRow]
rows = do
let (Doc Text
startCmd, Doc Text
stopCmd) = case (Tabl
tabl, TablePart
tblpart) of
(Tabl
Ntb, TablePart
Thead) -> (Doc Text
"\\bTABLEhead", Doc Text
"\\eTABLEhead")
(Tabl
Ntb, TablePart
Tfoot) -> (Doc Text
"\\bTABLEfoot", Doc Text
"\\eTABLEfoot")
(Tabl
Xtb, TablePart
Thead) -> (Doc Text
"\\startxtablehead[head]", Doc Text
"\\stopxtablehead")
(Tabl
Xtb, TablePart
Tfoot) -> (Doc Text
"\\startxtablefoot[foot]", Doc Text
"\\stopxtablefoot")
(Tabl, TablePart)
_ -> (Doc Text
"", Doc Text
"")
contents <- Tabl -> TablePart -> [HeaderRow] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> TablePart -> [HeaderRow] -> WM m (Doc Text)
headerRowsToConTeXt Tabl
tabl TablePart
tblpart [HeaderRow]
rows
return $ startCmd $$ contents $$ stopCmd
data TablePart = Thead | | Tbody
deriving (TablePart -> TablePart -> Bool
(TablePart -> TablePart -> Bool)
-> (TablePart -> TablePart -> Bool) -> Eq TablePart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TablePart -> TablePart -> Bool
== :: TablePart -> TablePart -> Bool
$c/= :: TablePart -> TablePart -> Bool
/= :: TablePart -> TablePart -> Bool
Eq)
data CellType = | BodyCell
data TableRow = TableRow TablePart Attr Ann.RowHead Ann.RowBody
headerRowsToConTeXt :: PandocMonad m
=> Tabl
-> TablePart
-> [Ann.HeaderRow]
-> WM m (Doc Text)
Tabl
tabl TablePart
tablepart = Tabl -> [TableRow] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> [TableRow] -> WM m (Doc Text)
rowListToConTeXt Tabl
tabl ([TableRow] -> WM m (Doc Text))
-> ([HeaderRow] -> [TableRow]) -> [HeaderRow] -> WM m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderRow -> TableRow) -> [HeaderRow] -> [TableRow]
forall a b. (a -> b) -> [a] -> [b]
map HeaderRow -> TableRow
toTableRow
where
toTableRow :: HeaderRow -> TableRow
toTableRow (Ann.HeaderRow Attr
attr RowNumber
_rownum [Cell]
rowbody) =
TablePart -> Attr -> [Cell] -> [Cell] -> TableRow
TableRow TablePart
tablepart Attr
attr [] [Cell]
rowbody
bodyRowsToConTeXt :: PandocMonad m
=> Tabl
-> [Ann.BodyRow]
-> WM m (Doc Text)
bodyRowsToConTeXt :: forall (m :: * -> *).
PandocMonad m =>
Tabl -> [BodyRow] -> WM m (Doc Text)
bodyRowsToConTeXt Tabl
tabl = Tabl -> [TableRow] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> [TableRow] -> WM m (Doc Text)
rowListToConTeXt Tabl
tabl ([TableRow] -> WM m (Doc Text))
-> ([BodyRow] -> [TableRow]) -> [BodyRow] -> WM m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyRow -> TableRow) -> [BodyRow] -> [TableRow]
forall a b. (a -> b) -> [a] -> [b]
map BodyRow -> TableRow
toTableRow
where
toTableRow :: BodyRow -> TableRow
toTableRow (Ann.BodyRow Attr
attr RowNumber
_rownum [Cell]
rowhead [Cell]
rowbody) =
TablePart -> Attr -> [Cell] -> [Cell] -> TableRow
TableRow TablePart
Tbody Attr
attr [Cell]
rowhead [Cell]
rowbody
rowListToConTeXt :: PandocMonad m
=> Tabl
-> [TableRow]
-> WM m (Doc Text)
rowListToConTeXt :: forall (m :: * -> *).
PandocMonad m =>
Tabl -> [TableRow] -> WM m (Doc Text)
rowListToConTeXt = \case
Tabl
Ntb -> ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> WM m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (StateT WriterState m [Doc Text] -> WM m (Doc Text))
-> ([TableRow] -> StateT WriterState m [Doc Text])
-> [TableRow]
-> WM m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableRow -> WM m (Doc Text))
-> [TableRow] -> 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 (Tabl -> TableRow -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableRow -> WM m (Doc Text)
tableRowToConTeXt Tabl
Ntb)
Tabl
Xtb -> \[TableRow]
rows -> do
(butlast, lastrow) <-
case [TableRow] -> [TableRow]
forall a. [a] -> [a]
reverse [TableRow]
rows of
[] -> ([Doc Text], Doc Text)
-> StateT WriterState m ([Doc Text], Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( []
, Doc Text
forall a. Doc a
empty
)
TableRow
r:[TableRow]
rs -> (,) ([Doc Text] -> Doc Text -> ([Doc Text], Doc Text))
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text -> ([Doc Text], Doc Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TableRow -> WM m (Doc Text))
-> [TableRow] -> 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 (Tabl -> TableRow -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableRow -> WM m (Doc Text)
tableRowToConTeXt Tabl
Xtb) ([TableRow] -> [TableRow]
forall a. [a] -> [a]
reverse [TableRow]
rs))
StateT WriterState m (Doc Text -> ([Doc Text], Doc Text))
-> WM m (Doc Text) -> StateT WriterState m ([Doc Text], Doc Text)
forall a b.
StateT WriterState m (a -> b)
-> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tabl -> TableRow -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableRow -> WM m (Doc Text)
tableRowToConTeXt Tabl
Xtb TableRow
r
return $
vcat butlast $$
if isEmpty lastrow
then empty
else "\\startxrowgroup[lastrow]" $$ lastrow $$ "\\stopxrowgroup"
tableRowToConTeXt :: PandocMonad m
=> Tabl
-> TableRow
-> WM m (Doc Text)
tableRowToConTeXt :: forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableRow -> WM m (Doc Text)
tableRowToConTeXt Tabl
tabl (TableRow TablePart
tblpart Attr
_attr [Cell]
rowhead [Cell]
rowbody) = do
let celltype :: CellType
celltype = case TablePart
tblpart of
TablePart
Thead -> CellType
HeaderCell
TablePart
_ -> CellType
BodyCell
headcells <- (Cell -> StateT WriterState m (Doc Text))
-> [Cell] -> 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 (Tabl -> CellType -> Cell -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tabl -> CellType -> Cell -> WM m (Doc Text)
tableCellToConTeXt Tabl
tabl CellType
HeaderCell) [Cell]
rowhead
bodycells <- mapM (tableCellToConTeXt tabl celltype) rowbody
let cells = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
headcells 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]
bodycells
return $ case tabl of
Tabl
Xtb -> Doc Text
"\\startxrow" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
cells Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\stopxrow"
Tabl
Ntb -> Doc Text
"\\bTR" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
cells Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\eTR"
tableCellToConTeXt :: PandocMonad m
=> Tabl
-> CellType
-> Ann.Cell -> WM m (Doc Text)
tableCellToConTeXt :: forall (m :: * -> *).
PandocMonad m =>
Tabl -> CellType -> Cell -> WM m (Doc Text)
tableCellToConTeXt Tabl
tabl CellType
celltype (Ann.Cell NonEmpty ColSpec
colspecs ColNumber
_colnum Cell
cell) = do
let Cell Attr
_attr Alignment
cellalign RowSpan
rowspan ColSpan
colspan [Block]
blocks = Cell
cell
let (Alignment
colalign, ColWidth
_) :| [ColSpec]
_ = NonEmpty ColSpec
colspecs
let halign :: Doc Text
halign = Alignment -> Doc Text
alignToConTeXt (Alignment -> Doc Text) -> Alignment -> Doc Text
forall a b. (a -> b) -> a -> b
$
case (Alignment
cellalign, Tabl
tabl) of
(Alignment
AlignDefault, Tabl
Xtb) -> Alignment
colalign
(Alignment, Tabl)
_ -> Alignment
cellalign
let nx :: Doc Text
nx = case ColSpan
colspan of
ColSpan Int
1 -> Doc Text
forall a. Doc a
empty
ColSpan Int
n -> Doc Text
"nc=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow Int
n)
let ny :: Doc Text
ny = case RowSpan
rowspan of
RowSpan Int
1 -> Doc Text
forall a. Doc a
empty
RowSpan Int
n -> Doc Text
"nr=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow Int
n)
let widths :: [ColWidth]
widths = (ColSpec -> ColWidth) -> [ColSpec] -> [ColWidth]
forall a b. (a -> b) -> [a] -> [b]
map ColSpec -> ColWidth
forall a b. (a, b) -> b
snd (NonEmpty ColSpec -> [ColSpec]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ColSpec
colspecs)
let mbcolwidth :: [Maybe Double]
mbcolwidth = ((ColWidth -> Maybe Double) -> [ColWidth] -> [Maybe Double])
-> [ColWidth] -> (ColWidth -> Maybe Double) -> [Maybe Double]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ColWidth -> Maybe Double) -> [ColWidth] -> [Maybe Double]
forall a b. (a -> b) -> [a] -> [b]
map [ColWidth]
widths ((ColWidth -> Maybe Double) -> [Maybe Double])
-> (ColWidth -> Maybe Double) -> [Maybe Double]
forall a b. (a -> b) -> a -> b
$ \case
ColWidth
ColWidthDefault -> Maybe Double
forall a. Maybe a
Nothing
ColWidth Double
w -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
let colwidth :: Doc Text
colwidth = case [Maybe Double] -> [Double]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Double]
mbcolwidth of
[] -> Doc Text
forall a. Doc a
empty
[Double]
ws -> (Doc Text
"width=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> ([Char] -> Doc Text) -> [Char] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text -> Doc Text)
-> ([Char] -> Doc Text) -> [Char] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text ([Char] -> Doc Text) -> [Char] -> Doc Text
forall a b. (a -> b) -> a -> b
$
[Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%.2f\\textwidth" ([Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws)
let keys :: Doc Text
keys = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([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
$ (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] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
case Tabl
tabl of
Tabl
Xtb -> [Doc Text
halign, Doc Text
colwidth, Doc Text
nx, Doc Text
ny]
Tabl
Ntb -> [Doc Text
halign, Doc Text
nx, Doc Text
ny]
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
cellContents <- [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
blocks
return $ case tabl of
Tabl
Xtb -> Doc Text
"\\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
<> Doc Text
" \\stopxcell"
Tabl
Ntb -> case CellType
celltype of
CellType
BodyCell -> Doc Text
"\\bTD" 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
<> Doc Text
"\\eTD"
CellType
HeaderCell -> Doc Text
"\\bTH" 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
<> Doc Text
"\\eTH"
alignToConTeXt :: Alignment -> Doc Text
alignToConTeXt :: Alignment -> Doc Text
alignToConTeXt = \case
Alignment
AlignLeft -> Doc Text
"align=right"
Alignment
AlignRight -> Doc Text
"align=left"
Alignment
AlignCenter -> Doc Text
"align=middle"
Alignment
AlignDefault -> Doc Text
forall a. Doc a
empty
listItemToConTeXt :: PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt :: forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt [Block]
list = (Doc Text
"\\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 Int
2 (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)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
list
defListItemToConTeXt :: PandocMonad m => ([Inline], [[Block]]) -> WM m (Doc Text)
defListItemToConTeXt :: forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> WM m (Doc Text)
defListItemToConTeXt ([Inline]
term, [[Block]]
defs) = do
term' <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
term
def' <- liftM vsep $ mapM blockListToConTeXt defs
return $ "\\startdescription" <> braces term' $$ nest 2 def' $$
"\\stopdescription" <> blankline
blockListToConTeXt :: PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt :: forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
lst = ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text))
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Block -> StateT WriterState m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> WM m (Doc Text)
blockToConTeXt [Block]
lst
inlineListToConTeXt :: PandocMonad m
=> [Inline]
-> WM m (Doc Text)
inlineListToConTeXt :: forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst = ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat (StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text))
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (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 Inline -> StateT WriterState 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 (Inline
LineBreak : Inline
s : [Inline]
xs) | Inline -> Bool
isSpacey Inline
s =
Inline
LineBreak Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"context") Text
"\\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 (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
addStruts [Inline]
xs
addStruts [] = []
isSpacey :: Inline -> Bool
isSpacey Inline
Space = Bool
True
isSpacey (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'\160',Text
_))) = Bool
True
isSpacey Inline
_ = Bool
False
highlightInlines :: PandocMonad m
=> Text -> (Doc Text) -> [Inline]
-> WM m (Doc Text)
highlightInlines :: forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> [Inline] -> WM m (Doc Text)
highlightInlines Text
name Doc Text
style [Inline]
inlines = do
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
contents <- inlineListToConTeXt inlines
if not (isEnabled Ext_tagging opts)
then return $ braces (style <> space <> contents)
else do
let cmd = Doc Text
"\\definehighlight " 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
name) 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
"style=" 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
style)
modify (\WriterState
st -> WriterState
st{ stEmphasisCommands =
Map.insert name cmd (stEmphasisCommands st) })
return $ "\\" <> literal name <> braces contents
inlineToConTeXt :: PandocMonad m
=> Inline
-> WM m (Doc Text)
inlineToConTeXt :: forall (m :: * -> *). PandocMonad m => Inline -> WM m (Doc Text)
inlineToConTeXt (Emph [Inline]
lst) = Text -> Doc Text -> [Inline] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> [Inline] -> WM m (Doc Text)
highlightInlines Text
"emph" Doc Text
"\\em" [Inline]
lst
inlineToConTeXt (Strong [Inline]
lst) = Text -> Doc Text -> [Inline] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> [Inline] -> WM m (Doc Text)
highlightInlines Text
"strong" Doc Text
"\\bf" [Inline]
lst
inlineToConTeXt (SmallCaps [Inline]
lst) = Text -> Doc Text -> [Inline] -> WM m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> [Inline] -> WM m (Doc Text)
highlightInlines Text
"smallcaps" Doc Text
"\\setsmallcaps" [Inline]
lst
inlineToConTeXt (Underline [Inline]
lst) = do
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
return $ "\\underbar" <> braces contents
inlineToConTeXt (Strikeout [Inline]
lst) = do
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
return $ "\\overstrikes" <> braces contents
inlineToConTeXt (Superscript [Inline]
lst) = do
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
return $ "\\high" <> braces contents
inlineToConTeXt (Subscript [Inline]
lst) = do
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
return $ "\\low" <> braces contents
inlineToConTeXt (Code (Text
_ident, [Text]
classes, [(Text, Text)]
_kv) Text
str) = do
let rawCode :: WM m (Doc Text)
rawCode =
Doc Text -> WM m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> WM m (Doc Text))
-> (Text -> Doc Text) -> Text -> WM m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> WM m (Doc Text)) -> Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$
case Text -> Maybe (Char, Char)
typeDelim Text
str of
Just (Char
open, Char
close) ->
Text
"\\type" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char
open Char -> Text -> Text
`T.cons` Text
str) Text -> Char -> Text
`T.snoc` Char
close
Maybe (Char, Char)
Nothing ->
Text
"\\type[escape=yes]{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"{" Text
"/BTEX\\letteropenbrace /ETEX" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"}" Text
"/BTEX\\letterclosebrace /ETEX" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
Text
str) Text -> Char -> Text
`T.snoc` Char
'}'
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let syntaxMap = WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts
let attr' = (Text
"", [Text]
classes, [])
let highlightCode =
case SyntaxMap
-> (FormatOptions -> [SourceLine] -> Text)
-> Attr
-> Text
-> Either Text Text
forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight SyntaxMap
syntaxMap FormatOptions -> [SourceLine] -> Text
formatConTeXtInline Attr
forall {a}. (Text, [Text], [a])
attr' Text
str of
Left Text
msg -> do
Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> LogMessage
CouldNotHighlight Text
msg)
WM m (Doc Text)
rawCode
Right Text
h -> do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stHighlighting = True })
Doc Text -> WM m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text (Text -> [Char]
T.unpack Text
h))
if isNothing (writerHighlightStyle opts) || null classes
then rawCode
else highlightCode
inlineToConTeXt (Quoted QuoteType
SingleQuote [Inline]
lst) = do
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
return $ "\\quote" <> braces contents
inlineToConTeXt (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
return $ "\\quotation" <> braces contents
inlineToConTeXt (Cite [Citation]
_ [Inline]
lst) = [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
inlineToConTeXt (Str Text
str) = do
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
return $ literal $ stringToConTeXt opts str
inlineToConTeXt (Math MathType
InlineMath Text
str) =
Doc Text -> WM m (Doc Text)
forall a. a -> StateT WriterState m a
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 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 Char
'$'
inlineToConTeXt (Math MathType
DisplayMath Text
str) =
Doc Text -> WM m (Doc Text)
forall a. a -> StateT WriterState m a
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
"\\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 Text
" \\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 Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"context" = Doc Text -> WM m (Doc Text)
forall a. a -> StateT WriterState m a
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 a b. a -> StateT WriterState m b -> StateT WriterState m a
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 Inline
LineBreak = Doc Text -> WM m (Doc Text)
forall a. a -> StateT WriterState m a
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
"\\crlf" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToConTeXt Inline
SoftBreak = do
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)
return $ case wrapText of
WrapOption
WrapAuto -> Doc Text
forall a. Doc a
space
WrapOption
WrapNone -> Doc Text
forall a. Doc a
space
WrapOption
WrapPreserve -> Doc Text
forall a. Doc a
cr
inlineToConTeXt Inline
Space = Doc Text -> WM 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
space
inlineToConTeXt (Link Attr
_ [Inline]
txt (Text
src, Text
_)) = do
let isAutolink :: Bool
isAutolink = [Inline]
txt [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
src)]
let escConTeXtURL :: Text -> Text
escConTeXtURL = (Char -> Text) -> Text -> Text
T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \case
Char
'#' -> Text
"\\#"
Char
'%' -> Text
"\\%"
Char
c -> Char -> Text
T.singleton Char
c
if Bool
isAutolink
then do
next <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNextRef
modify $ \WriterState
st -> WriterState
st {stNextRef = next + 1}
let ref = Text
"url" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
next
return $ mconcat
[ "\\useURL"
, brackets (literal ref)
, brackets (literal $ escConTeXtURL src)
, "\\from"
, brackets (literal ref)
]
else do
contents <- [Inline] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
txt
reference <- case T.uncons src of
Just (Char
'#', Text
ref) -> Text -> Text
toLabel (Text -> Text)
-> StateT WriterState m Text -> StateT WriterState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(WriterOptions -> Text -> Text
stringToConTeXt (WriterOptions -> Text -> Text)
-> StateT WriterState m WriterOptions
-> StateT WriterState m (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions StateT WriterState m (Text -> Text)
-> StateT WriterState m Text -> StateT WriterState m Text
forall a b.
StateT WriterState m (a -> b)
-> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
ref)
Maybe (Char, Text)
_ -> Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> StateT WriterState m Text)
-> Text -> StateT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"url(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escConTeXtURL Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
return $ mconcat
[ "\\goto"
, braces contents
, brackets (literal reference)
]
inlineToConTeXt (Image attr :: Attr
attr@(Text
_,[Text]
cls,[(Text, Text)]
_) [Inline]
_ (Text
src, Text
_)) = do
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
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
<> Doc Text
"="
in case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
Just (Pixel 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
<> Doc Text
"in"]
Just (Percent 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
/ Double
100)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\textwidth"]
Just 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)]
Maybe Dimension
Nothing ->
[]
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 = if [Doc Text] -> Bool
forall a. [a] -> 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
"," [Doc Text]
dimList)
clas = case [Text]
cls of
[] -> Doc Text
forall a. Doc a
empty
(Text
cl:[Text]
_) -> 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
cl
fixPathSeparators = (Char -> Char) -> Text -> Text
T.map ((Char -> Char) -> Text -> Text) -> (Char -> Char) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
c -> case Char
c of
Char
'\\' -> Char
'/'
Char
_ -> Char
c
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 [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
src
return $ braces $ "\\externalfigure" <> brackets (literal src') <> clas <> dims
inlineToConTeXt (Note [Block]
contents) = do
contents' <- [Block] -> WM m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
contents
let codeBlock x :: Block
x@(CodeBlock Attr
_ Text
_) = [Block
x]
codeBlock Block
_ = []
let codeBlocks = (Block -> [Block]) -> [Block] -> [Block]
forall c. Monoid c => (Block -> c) -> [Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [Block]
codeBlock [Block]
contents
return $ if null codeBlocks
then literal "\\footnote{" <> nest 2 (chomp contents') <> char '}'
else literal "\\startbuffer " <> nest 2 (chomp contents') <>
literal "\\stopbuffer\\footnote{\\getbuffer}"
inlineToConTeXt (Span (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
ils) = do
mblang <- Maybe Text -> WM m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Maybe Text -> WM m (Maybe Text)
fromBCP47 (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs)
let wrapDir Doc a
txt = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
Just Text
"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
$ Doc a
"\\righttoleft " Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
txt
Just Text
"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
$ Doc a
"\\lefttoright " Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
txt
Maybe Text
_ -> Doc a
txt
wrapLang Doc Text
txt = case Maybe Text
mblang of
Just Text
lng -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text
"\\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)
Maybe Text
Nothing -> Doc Text
txt
addReference =
if Text -> Bool
T.null Text
ident
then Doc Text -> Doc Text
forall a. a -> a
id
else ((Doc Text
"\\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 -> Doc Text
forall a. Semigroup a => a -> a -> a
<>)
addReference . wrapLang . wrapDir <$> inlineListToConTeXt ils
sectionHeader :: PandocMonad m
=> Attr
-> Int
-> [Inline]
-> HeadingType
-> WM m (Doc Text)
(Text
ident,[Text]
classes,[(Text, Text)]
kvs) Int
hdrLevel [Inline]
lst HeadingType
secenv = do
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
contents <- inlineListToConTeXt lst
levelText <- sectionLevelToText opts (ident,classes,kvs) hdrLevel secenv
let optsList = [[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] -> 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. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Doc Text]] -> [Doc Text]) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
[ [Doc Text
"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 | Bool -> Bool
not (Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
contents)]
, [Doc Text
"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)) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)]
, [Doc Text
"number=no" | Text
"unnumbered" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
, [Doc Text
"incrementnumber=no" | Text
"unnumbered" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
]
let starter = case HeadingType
secenv of
HeadingType
SectionHeading -> Doc Text
"\\start"
HeadingType
NonSectionHeading -> Doc Text
"\\"
let options = if [Doc Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
optsList 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 -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
"," [Doc Text]
optsList)
return $ starter <> levelText <> options <> blankline
sectionFooter :: PandocMonad m => Attr -> Int -> WM m (Doc Text)
Attr
attr Int
hdrLevel = do
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
levelText <- sectionLevelToText opts attr hdrLevel SectionHeading
return $ "\\stop" <> levelText <> blankline
sectionLevelToText :: PandocMonad m
=> WriterOptions -> Attr -> Int -> HeadingType
-> WM m (Doc Text)
sectionLevelToText :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Int -> HeadingType -> WM m (Doc Text)
sectionLevelToText WriterOptions
opts (Text
_,[Text]
classes,[(Text, Text)]
_) Int
hdrLevel HeadingType
headingType = do
let unlisted :: Bool
unlisted = Text
"unlisted" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
let semanticSection :: Int -> m (Doc a)
semanticSection Int
shift = do
let (Doc a
section, Doc a
chapter) = if Bool
unlisted
then (a -> Doc a
forall a. HasChars a => a -> Doc a
literal a
"subject", a -> Doc a
forall a. HasChars a => a -> Doc a
literal a
"title")
else (a -> Doc a
forall a. HasChars a => a -> Doc a
literal a
"section", a -> Doc a
forall a. HasChars a => a -> Doc a
literal a
"chapter")
Doc a -> m (Doc a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc a -> m (Doc a)) -> Doc a -> m (Doc a)
forall a b. (a -> b) -> a -> b
$ case Int
hdrLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
shift of
-1 -> a -> Doc a
forall a. HasChars a => a -> Doc a
literal a
"part"
Int
0 -> Doc a
chapter
Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 -> [Char] -> Doc a
forall a. HasChars a => [Char] -> Doc a
text ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Char]
"sub"))
Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
section
Int
_ -> Doc a
forall a. Doc a
empty
case WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts of
TopLevelDivision
TopLevelPart -> Int -> WM m (Doc Text)
forall {m :: * -> *} {a}. (Monad m, HasChars a) => Int -> m (Doc a)
semanticSection (-Int
2)
TopLevelDivision
TopLevelChapter -> Int -> WM m (Doc Text)
forall {m :: * -> *} {a}. (Monad m, HasChars a) => Int -> m (Doc a)
semanticSection (-Int
1)
TopLevelDivision
TopLevelSection -> Int -> WM m (Doc Text)
forall {m :: * -> *} {a}. (Monad m, HasChars a) => Int -> m (Doc a)
semanticSection Int
0
TopLevelDivision
TopLevelDefault -> if Bool
unlisted
then Int -> WM m (Doc Text)
forall {m :: * -> *} {a}. (Monad m, HasChars a) => Int -> m (Doc a)
semanticSection Int
0
else Doc Text -> WM m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WM m (Doc Text))
-> (Text -> Doc Text) -> Text -> WM m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> WM m (Doc Text)) -> Text -> WM m (Doc Text)
forall a b. (a -> b) -> a -> b
$
case HeadingType
headingType of
HeadingType
SectionHeading -> Text
"sectionlevel"
HeadingType
NonSectionHeading -> Text
""
typeDelim :: Text -> Maybe (Char, Char)
typeDelim :: Text -> Maybe (Char, Char)
typeDelim Text
t =
let delimChars :: Text
delimChars = Text
"{\"'`()-+=%,.:;"
go :: Text -> Char -> Text
go Text
delims Char
'}' = Text -> Char -> Text
go Text
delims Char
'{'
go Text
delims Char
c = (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c) Text
delims
in case ((Char, Text) -> Char) -> Maybe (Char, Text) -> Maybe Char
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, Text) -> Char
forall a b. (a, b) -> a
fst (Maybe (Char, Text) -> Maybe Char)
-> (Text -> Maybe (Char, Text)) -> Text -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe Char) -> Text -> Maybe Char
forall a b. (a -> b) -> a -> b
$ (Text -> Char -> Text) -> Text -> Text -> Text
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' Text -> Char -> Text
go Text
delimChars Text
t of
Just Char
'{' -> (Char, Char) -> Maybe (Char, Char)
forall a. a -> Maybe a
Just (Char
'{', Char
'}')
Just Char
c -> (Char, Char) -> Maybe (Char, Char)
forall a. a -> Maybe a
Just (Char
c, Char
c)
Maybe Char
Nothing -> Maybe (Char, Char)
forall a. Maybe a
Nothing
fromBCP47 :: PandocMonad m => Maybe Text -> WM m (Maybe Text)
fromBCP47 :: forall (m :: * -> *).
PandocMonad m =>
Maybe Text -> WM m (Maybe Text)
fromBCP47 Maybe Text
mbs = Maybe Lang -> Maybe Text
fromBCP47' (Maybe Lang -> Maybe Text)
-> StateT WriterState m (Maybe Lang)
-> StateT WriterState 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 Text
"ar" Maybe Text
_ (Just Text
"SY") [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ar-sy"
fromBCP47' (Just (Lang Text
"ar" Maybe Text
_ (Just Text
"IQ") [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ar-iq"
fromBCP47' (Just (Lang Text
"ar" Maybe Text
_ (Just Text
"JO") [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ar-jo"
fromBCP47' (Just (Lang Text
"ar" Maybe Text
_ (Just Text
"LB") [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ar-lb"
fromBCP47' (Just (Lang Text
"ar" Maybe Text
_ (Just Text
"DZ") [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ar-dz"
fromBCP47' (Just (Lang Text
"ar" Maybe Text
_ (Just Text
"MA") [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ar-ma"
fromBCP47' (Just (Lang Text
"de" Maybe Text
_ Maybe Text
_ [Text
"1901"] [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"deo"
fromBCP47' (Just (Lang Text
"de" Maybe Text
_ (Just Text
"DE") [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"de-de"
fromBCP47' (Just (Lang Text
"de" Maybe Text
_ (Just Text
"AT") [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"de-at"
fromBCP47' (Just (Lang Text
"de" Maybe Text
_ (Just Text
"CH") [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"de-ch"
fromBCP47' (Just (Lang Text
"el" Maybe Text
_ Maybe Text
_ [Text
"poly"] [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"agr"
fromBCP47' (Just (Lang Text
"en" Maybe Text
_ (Just Text
"US") [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"en-us"
fromBCP47' (Just (Lang Text
"en" Maybe Text
_ (Just Text
"GB") [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"en-gb"
fromBCP47' (Just (Lang Text
"grc"Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"agr"
fromBCP47' (Just (Lang Text
"el" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"gr"
fromBCP47' (Just (Lang Text
"eu" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ba"
fromBCP47' (Just (Lang Text
"he" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"il"
fromBCP47' (Just (Lang Text
"uk" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ua"
fromBCP47' (Just (Lang Text
"vi" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"vn"
fromBCP47' (Just (Lang Text
"zh" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"cn"
fromBCP47' (Just (Lang Text
l Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l
fromBCP47' Maybe Lang
Nothing = Maybe Text
forall a. Maybe a
Nothing