{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}
{- |
   Module      : Text.Pandoc.Writers.ConTeXt
   Copyright   : Copyright (C) 2007-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' format into ConTeXt.
-}
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 -- CSL hanging indent
  , WriterState -> Bool
stHasCslRefs       :: Bool -- has CSL citations
  , WriterState -> Bool
stHighlighting     :: Bool -- has syntax-highlighted code blocks
  , WriterState -> Int
stNextRef          :: Int  -- number of next URL reference
  , WriterState -> WriterOptions
stOptions          :: WriterOptions -- writer options
  , WriterState -> Int
stOrderedListLevel :: Int  -- level of ordered list
  , WriterState -> Map Text (Doc Text)
stEmphasisCommands :: Map.Map Text (Doc Text)
  }

-- | Table type
data Tabl = Xtb  -- ^ Extreme tables
          | Ntb  -- ^ Natural tables
  deriving (Int -> Tabl -> ShowS
[Tabl] -> ShowS
Tabl -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Tabl] -> ShowS
$cshowList :: [Tabl] -> ShowS
show :: Tabl -> [Char]
$cshow :: Tabl -> [Char]
showsPrec :: Int -> Tabl -> ShowS
$cshowsPrec :: Int -> Tabl -> ShowS
Show, Tabl -> Tabl -> Bool
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)

-- | Whether a heading belongs to a section environment or is standalone.
data HeadingType = SectionHeading | NonSectionHeading

orderedListStyles :: [Char]
orderedListStyles :: [Char]
orderedListStyles = forall a. [a] -> [a]
cycle [Char]
"narg"

-- | Convert Pandoc to ConTeXt.
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 = forall a. Monoid a => a
mempty
        }
  in forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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 forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
options
                    else forall a. Maybe a
Nothing
  Context Text
metadata <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
options
              forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt
              (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Doc a -> Doc a
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt)
              Meta
meta
  Doc Text
main <- forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False forall a. Maybe a
Nothing [Block]
blocks
  let layoutFromMargins :: Doc Text
layoutFromMargins = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (Doc Text
"," :: Doc Text) forall a b. (a -> b) -> a -> b
$
                          forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Doc Text
x,Text
y) ->
                                ((Doc Text
x forall a. Semigroup a => a -> a -> a
<> Doc Text
"=") forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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")
                              ]
  Maybe Text
mblang <- forall (m :: * -> *).
PandocMonad m =>
Maybe Text -> WM m (Maybe Text)
fromBCP47 (WriterOptions -> Meta -> Maybe Text
getLang WriterOptions
options Meta
meta)
  WriterState
st <- forall s (m :: * -> *). MonadState s m => m s
get
  let context :: Context Text
context =   forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
options)
                forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"placelist"
                   (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (Doc Text
"," :: Doc Text) forall a b. (a -> b) -> a -> b
$
                     forall a. Int -> [a] -> [a]
take (WriterOptions -> Int
writerTOCDepth WriterOptions
options 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"])
                forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
                forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"layout" Doc Text
layoutFromMargins
                forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"number-sections" (WriterOptions -> Bool
writerNumberSections WriterOptions
options)
                forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"csl-refs" (WriterState -> Bool
stHasCslRefs WriterState
st)
                forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"csl-hanging-indent" (WriterState -> Bool
stCslHangingIndent WriterState
st)
                forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Text
l ->
                     forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"context-lang" (forall a. HasChars a => a -> Doc a
literal Text
l :: Doc Text)) Maybe Text
mblang
                forall a b. (a -> b) -> a -> b
$ (case Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                      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)
                          | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit (Char
dforall a. a -> [a] -> [a]
:[Char]
ds) -> forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"papersize"
                                                   ([Char] -> Text
T.pack (Char
'A'forall a. a -> [a] -> [a]
:Char
dforall a. a -> [a] -> [a]
:[Char]
ds))
                        Maybe [Char]
_                     -> forall a. a -> a
id)
                forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"emphasis-commands"
                    (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems (WriterState -> Map Text (Doc Text)
stEmphasisCommands WriterState
st))
                forall a b. (a -> b) -> a -> b
$ (case WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
options of
                        Just Style
sty | WriterState -> Bool
stHighlighting WriterState
st ->
                          forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"highlighting-commands" (Style -> Text
styleToConTeXt Style
sty)
                        Maybe Style
_ -> forall a. a -> a
id)
                forall a b. (a -> b) -> a -> b
$ (case Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Text
lookupMetaString Text
"pdfa" Meta
meta of
                        Text
"true" -> forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"pdfa" ([Char] -> Text
T.pack [Char]
"1b:2005")
                        Text
_                     -> forall a. a -> a
id) Context Text
metadata
  let context' :: Context Text
context' = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"context-dir" (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Doc Text -> Doc Text
toContextDir
                                         forall a b. (a -> b) -> a -> b
$ forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"dir" Context Text
context) Context Text
context
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
options of
       Maybe (Template Text)
Nothing  -> Doc Text
main
       Just Template Text
tpl -> forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context'

-- change rtl to r2l, ltr to l2r
toContextDir :: Doc Text -> Doc Text
toContextDir :: Doc Text -> Doc Text
toContextDir = 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)

-- | escape things as needed for ConTeXt
escapeCharForConTeXt :: WriterOptions -> Char -> Text
escapeCharForConTeXt :: WriterOptions -> Char -> Text
escapeCharForConTeXt WriterOptions
opts Char
ch =
 let ligatures :: Bool
ligatures = 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

-- | Escape string for ConTeXt
stringToConTeXt :: WriterOptions -> Text -> Text
stringToConTeXt :: WriterOptions -> Text -> Text
stringToConTeXt WriterOptions
opts = (Char -> Text) -> Text -> Text
T.concatMap (WriterOptions -> Char -> Text
escapeCharForConTeXt WriterOptions
opts)

-- | Sanitize labels
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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"\\#[]\",{}%()|=" :: String) = Text
"ux" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall r. PrintfType r => [Char] -> r
printf [Char]
"%x" (Char -> Int
ord Char
x))
         | Bool
otherwise = Char -> Text
T.singleton Char
x

-- | Convert Pandoc block element to ConTeXt.
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
  Doc Text
header' <- forall (m :: * -> *).
PandocMonad m =>
Attr -> Int -> [Inline] -> HeadingType -> WM m (Doc Text)
sectionHeader Attr
attr Int
level [Inline]
title' HeadingType
SectionHeading
  Doc Text
footer' <- forall (m :: * -> *).
PandocMonad m =>
Attr -> Int -> WM m (Doc Text)
sectionFooter Attr
attr Int
level
  Doc Text
innerContents <- forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
xs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
header' forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
innerContents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
footer'
blockToConTeXt (Plain [Inline]
lst) = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tagging WriterOptions
opts
    then Doc Text
"\\bpar{}" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\epar{}"
    else Doc Text
contents
blockToConTeXt (Para [Inline]
lst) = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tagging WriterOptions
opts
    then Doc Text
"\\bpar" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\epar" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
    else Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToConTeXt (LineBlock [[Inline]]
lns) = do
  let emptyToBlankline :: Doc a -> Doc a
emptyToBlankline Doc a
doc = if forall a. Doc a -> Bool
isEmpty Doc a
doc
                             then forall a. Doc a
blankline
                             else Doc a
doc
  [Doc Text]
doclines <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [[Inline]]
lns
  let contextLines :: Doc Text
contextLines = forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Doc a -> Doc a
emptyToBlankline forall a b. (a -> b) -> a -> b
$ [Doc Text]
doclines
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\startlines" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contextLines forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\stoplines" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToConTeXt (BlockQuote [Block]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\startblockquote" forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
0 Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\stopblockquote" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToConTeXt (CodeBlock (Text
_ident, [Text]
classes, [(Text, Text)]
kv) Text
str) = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let syntaxMap :: SyntaxMap
syntaxMap = WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts
  let attr' :: Attr
attr' = (Text
"", [Text]
classes, [(Text, Text)]
kv)
  let unhighlighted :: Doc Text
unhighlighted = forall a. [Doc a] -> Doc a
vcat [Doc Text
"\\starttyping", forall a. HasChars a => a -> Doc a
literal Text
str, Doc Text
"\\stoptyping"]
  let highlighted :: WM m (Doc Text)
highlighted =
        case 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
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> LogMessage
CouldNotHighlight Text
msg)
            forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
unhighlighted
          Right Text
h  -> do
            forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{ stHighlighting :: Bool
stHighlighting = Bool
True })
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. HasChars a => a -> Doc a
literal Text
h)
  -- blankline because \stoptyping can't have anything after it, inc. '}'
  (forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Doc a -> Doc a
flush forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isNothing (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts)
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
unhighlighted
    else WM m (Doc Text)
highlighted
blockToConTeXt b :: Block
b@(RawBlock Format
f Text
str)
  | Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"context" Bool -> Bool -> Bool
|| Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
  | Bool
otherwise = forall a. Doc a
empty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)
blockToConTeXt (Div (Text
"refs",[Text]
classes,[(Text, Text)]
_) [Block]
bs) = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasCslRefs :: Bool
stHasCslRefs = Bool
True
                    , stCslHangingIndent :: Bool
stCslHangingIndent = Text
"hanging-indent" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes }
  Doc Text
inner <- forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
bs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\startcslreferences" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
inner forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\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[" forall a. Semigroup a => a -> a -> a
<> Doc a
dir forall a. Semigroup a => a -> a -> a
<> Doc a
"]" forall a. Doc a -> Doc a -> Doc a
$$ Doc a
txt forall a. Doc a -> Doc a -> Doc a
$$ Doc a
"\\stopalignment"
  Maybe Text
mblang <- forall (m :: * -> *).
PandocMonad m =>
Maybe Text -> WM m (Maybe Text)
fromBCP47 (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs)
  let wrapRef :: Doc Text -> Doc Text
wrapRef Doc Text
txt = if Text -> Bool
T.null Text
ident
                       then Doc Text
txt
                       else (Doc Text
"\\reference" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
toLabel Text
ident) forall a. Semigroup a => a -> a -> a
<>
                              forall a. HasChars a => Doc a -> Doc a
braces forall a. Doc a
empty forall a. Semigroup a => a -> a -> a
<> Doc Text
"%") forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
txt
      wrapDir :: Doc Text -> Doc Text
wrapDir = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
                  Just Text
"rtl" -> forall {a}. HasChars a => Doc a -> Doc a -> Doc a
align Doc Text
"righttoleft"
                  Just Text
"ltr" -> forall {a}. HasChars a => Doc a -> Doc a -> Doc a
align Doc Text
"lefttoright"
                  Maybe Text
_          -> forall a. a -> a
id
      wrapLang :: Doc Text -> Doc Text
wrapLang Doc Text
txt = case Maybe Text
mblang of
                       Just Text
lng -> Doc Text
"\\start\\language["
                                     forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
lng forall a. Semigroup a => a -> a -> a
<> Doc Text
"]" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
txt forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\stop"
                       Maybe Text
Nothing  -> Doc Text
txt
      wrapBlank :: Doc a -> Doc a
wrapBlank Doc a
txt = forall a. Doc a
blankline forall a. Semigroup a => a -> a -> a
<> Doc a
txt forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
  forall a. Doc a -> Doc a
wrapBlank forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
wrapLang forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
wrapDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
wrapRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
bs
blockToConTeXt (BulletList [[Block]]
lst) = do
  [Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt [[Block]]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Doc Text
"\\startitemize" forall a. Semigroup a => a -> a -> a
<> if [[Block]] -> Bool
isTightList [[Block]]
lst
                                   then forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
"packed"
                                   else forall a. Doc a
empty) forall a. Doc a -> Doc a -> Doc a
$$
    forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
"\\stopitemize" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToConTeXt (OrderedList (Int
start, ListNumberStyle
style', ListNumberDelim
delim) [[Block]]
lst) = do
    WriterState
st <- forall s (m :: * -> *). MonadState s m => m s
get
    let level :: Int
level = WriterState -> Int
stOrderedListLevel WriterState
st
    forall s (m :: * -> *). MonadState s m => s -> m ()
put WriterState
st {stOrderedListLevel :: Int
stOrderedListLevel = Int
level forall a. Num a => a -> a -> a
+ Int
1}
    [Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt [[Block]]
lst
    forall s (m :: * -> *). MonadState s m => s -> m ()
put WriterState
st {stOrderedListLevel :: Int
stOrderedListLevel = Int
level}
    let start' :: Text
start' = if Int
start forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"start=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
start
    let delim' :: Text
delim' = case ListNumberDelim
delim of
                        ListNumberDelim
DefaultDelim -> Text
""
                        ListNumberDelim
Period       -> Text
"stopper=."
                        ListNumberDelim
OneParen     -> Text
"stopper=)"
                        ListNumberDelim
TwoParens    -> Text
"left=(,stopper=)"
    let specs2Items :: [Text]
specs2Items = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text
start', Text
delim']
    let specs2 :: Text
specs2 = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
specs2Items
                    then Text
""
                    else Text
"[" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," [Text]
specs2Items forall a. Semigroup a => a -> a -> a
<> Text
"]"
    let style'' :: [Char]
style'' = Char
'['forall a. a -> [a] -> [a]
: (case ListNumberStyle
style' of
                          ListNumberStyle
DefaultStyle -> [Char]
orderedListStyles forall a. [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') forall a. a -> [a] -> [a]
:
                       if [[Block]] -> Bool
isTightList [[Block]]
lst then [Char]
",packed]" else [Char]
"]"
    let specs :: Text
specs = [Char] -> Text
T.pack [Char]
style'' forall a. Semigroup a => a -> a -> a
<> Text
specs2
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\startenumerate" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
specs forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents forall a. Doc a -> Doc a -> Doc a
$$
             Doc Text
"\\stopenumerate" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToConTeXt (DefinitionList [([Inline], [[Block]])]
lst) =
  forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> WM m (Doc Text)
defListItemToConTeXt [([Inline], [[Block]])]
lst
blockToConTeXt Block
HorizontalRule = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\thinrule" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
-- If this is ever executed, provide a default for the reference identifier.
blockToConTeXt (Header Int
level Attr
attr [Inline]
lst) =
  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) =
  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
  Doc Text
title   <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt ([Block] -> [Inline]
blocksToInlines [Block]
clong)
  Doc Text
list    <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Doc a
empty) forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt Maybe [Inline]
cshort
  Doc Text
content <- forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
body

  let options :: [Doc Text]
options =
           [Doc Text
"reference=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (Text -> Text
toLabel Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)]
        forall a. [a] -> [a] -> [a]
++ [Doc Text
"title="     forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
title | Bool -> Bool
not (forall a. Doc a -> Bool
isEmpty Doc Text
title)]
        forall a. [a] -> [a] -> [a]
++ [Doc Text
"list="      forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
list  | Bool -> Bool
not (forall a. Doc a -> Bool
isEmpty Doc Text
list)]
  let hasSubfigures :: Bool
hasSubfigures = Any -> Bool
getAny forall a b. (a -> b) -> a -> b
$
        forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (Bool -> Any
Any forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case {Figure {} -> Bool
True; Block
_ -> Bool
False}) [Block]
body
  forall (m :: * -> *) a. Monad m => a -> m a
return
     forall a b. (a -> b) -> a -> b
$ Doc Text
"\\startplacefigure" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Doc Text
"," [Doc Text]
options)
    forall a. Doc a -> Doc a -> Doc a
$$ (if Bool
hasSubfigures then Doc Text
"\\startfloatcombination" else forall a. Doc a
empty)
    forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
content
    forall a. Doc a -> Doc a -> Doc a
$$ (if Bool
hasSubfigures then Doc Text
"\\stopfloatcombination" else forall a. Doc a
empty)
    forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\stopplacefigure"
    forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
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
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let tabl :: Tabl
tabl = if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_ntb WriterOptions
opts
             then Tabl
Ntb
             else Tabl
Xtb
  Doc Text
captionText <- case Caption
caption of
                   Caption Maybe [Inline]
_ []       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
                   Caption Maybe [Inline]
_ [Block]
longCapt -> forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
longCapt
  Doc Text
head'  <- forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableHead -> WM m (Doc Text)
tableHeadToConTeXt Tabl
tabl TableHead
thead
  [Doc Text]
bodies <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableBody -> WM m (Doc Text)
tableBodyToConTeXt Tabl
tabl) [TableBody]
tbodies
  Doc Text
foot'  <- forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableFoot -> WM m (Doc Text)
tableFootToConTeXt Tabl
tabl TableFoot
tfoot
  let body :: Doc Text
body = case Tabl
tabl of
        Tabl
Xtb -> Doc Text
"\\startxtable" forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
head' forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
"\\startxtablebody[body]" forall a. Doc a -> Doc a -> Doc a
$$
               forall a. [Doc a] -> Doc a
vcat [Doc Text]
bodies forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
"\\stopxtablebody" forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
foot' forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
"\\stopxtable"
        Tabl
Ntb -> [ColSpec] -> Doc Text
setupCols [ColSpec]
colspecs forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
"\\bTABLE" forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
head' forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
"\\bTABLEbody" forall a. Doc a -> Doc a -> Doc a
$$
               forall a. [Doc a] -> Doc a
vcat [Doc Text]
bodies forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
"\\eTABLEbody" forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
foot' forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
"\\eTABLE"
  let (Text
ident, [Text]
_classes, [(Text, Text)]
_attribs) = Attr
attr
  let tblopts :: [Doc Text]
tblopts = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Doc a -> Bool
isEmpty)
             [ if forall a. Doc a -> Bool
isEmpty Doc Text
captionText
               then Doc Text
"location=none"
               else Doc Text
"title=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
captionText
             , if Text -> Bool
T.null Text
ident
               then forall a. Doc a
empty
               else Doc Text
"reference=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces (forall a. HasChars a => a -> Doc a
literal (Text -> Text
toLabel Text
ident))
             ]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
vcat
    [ Doc Text
"\\startplacetable" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Doc Text
"," [Doc Text]
tblopts)
    , Doc Text
body
    , Doc Text
"\\stopplacetable" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
    ]

setupCols :: [ColSpec] -> Doc Text
setupCols :: [ColSpec] -> Doc Text
setupCols = forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall a. Doc a
empty
                     ColWidth Double
w -> (Doc a
"width=" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => Doc a -> Doc a
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => [Char] -> Doc a
text forall a b. (a -> b) -> a -> b
$
                                   forall r. PrintfType r => [Char] -> r
printf [Char]
"%.2f\\textwidth" Double
w
                 ]
      in Doc a
"\\setupTABLE[column]" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => [Char] -> Doc a
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show a
i)
                                forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ 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
  Doc Text
intermediateHead <-
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeaderRow]
inthead
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
    else forall (m :: * -> *).
PandocMonad m =>
Tabl -> TablePart -> [HeaderRow] -> WM m (Doc Text)
headerRowsToConTeXt Tabl
tabl TablePart
Thead [HeaderRow]
inthead
  Doc Text
bodyRows <- forall (m :: * -> *).
PandocMonad m =>
Tabl -> [BodyRow] -> WM m (Doc Text)
bodyRowsToConTeXt Tabl
tabl [BodyRow]
rows
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
intermediateHead forall a. Semigroup a => a -> a -> a
<> Doc Text
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) =
  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)
tableFootToConTeXt :: forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableFoot -> WM m (Doc Text)
tableFootToConTeXt Tabl
tbl (Ann.TableFoot Attr
attr [HeaderRow]
rows) =
  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
"") -- this would be unexpected
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
Tabl -> TablePart -> [HeaderRow] -> WM m (Doc Text)
headerRowsToConTeXt Tabl
tabl TablePart
tblpart [HeaderRow]
rows
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
startCmd forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
stopCmd

-- | The part of a table; header, footer, or body.
data TablePart = Thead | Tfoot | Tbody
  deriving (TablePart -> TablePart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TablePart -> TablePart -> Bool
$c/= :: TablePart -> TablePart -> Bool
== :: TablePart -> TablePart -> Bool
$c== :: TablePart -> TablePart -> Bool
Eq)

data CellType = HeaderCell | BodyCell

data TableRow = TableRow TablePart Attr Ann.RowHead Ann.RowBody

headerRowsToConTeXt :: PandocMonad m
                    => Tabl
                    -> TablePart
                    -> [Ann.HeaderRow]
                    -> WM m (Doc Text)
headerRowsToConTeXt :: forall (m :: * -> *).
PandocMonad m =>
Tabl -> TablePart -> [HeaderRow] -> WM m (Doc Text)
headerRowsToConTeXt Tabl
tabl TablePart
tablepart = forall (m :: * -> *).
PandocMonad m =>
Tabl -> [TableRow] -> WM m (Doc Text)
rowListToConTeXt Tabl
tabl forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *).
PandocMonad m =>
Tabl -> [TableRow] -> WM m (Doc Text)
rowListToConTeXt Tabl
tabl forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableRow -> WM m (Doc Text)
tableRowToConTeXt Tabl
Ntb)
  Tabl
Xtb -> \[TableRow]
rows -> do
    ([Doc Text]
butlast, Doc Text
lastrow) <-
      case forall a. [a] -> [a]
reverse [TableRow]
rows of
        []   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ( []
                     , forall a. Doc a
empty
                     )
        TableRow
r:[TableRow]
rs -> (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableRow -> WM m (Doc Text)
tableRowToConTeXt Tabl
Xtb) (forall a. [a] -> [a]
reverse [TableRow]
rs))
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *).
PandocMonad m =>
Tabl -> TableRow -> WM m (Doc Text)
tableRowToConTeXt Tabl
Xtb TableRow
r
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      forall a. [Doc a] -> Doc a
vcat [Doc Text]
butlast forall a. Doc a -> Doc a -> Doc a
$$
      if forall a. Doc a -> Bool
isEmpty Doc Text
lastrow
      then forall a. Doc a
empty
      else Doc Text
"\\startxrowgroup[lastrow]" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
lastrow forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\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
  [Doc Text]
headcells <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
Tabl -> CellType -> Cell -> WM m (Doc Text)
tableCellToConTeXt Tabl
tabl CellType
HeaderCell) [Cell]
rowhead
  [Doc Text]
bodycells <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
Tabl -> CellType -> Cell -> WM m (Doc Text)
tableCellToConTeXt Tabl
tabl CellType
celltype) [Cell]
rowbody
  let cells :: Doc Text
cells = forall a. [Doc a] -> Doc a
vcat [Doc Text]
headcells forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
vcat [Doc Text]
bodycells
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Tabl
tabl of
    Tabl
Xtb -> Doc Text
"\\startxrow" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
cells forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\stopxrow"
    Tabl
Ntb -> Doc Text
"\\bTR" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
cells 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 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 -> forall a. Doc a
empty
             ColSpan Int
n -> Doc Text
"nc=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow Int
n)
  let ny :: Doc Text
ny = case RowSpan
rowspan of
             RowSpan Int
1 -> forall a. Doc a
empty
             RowSpan Int
n -> Doc Text
"nr=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow Int
n)
  let widths :: [ColWidth]
widths = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ColSpec
colspecs)
  let mbcolwidth :: [Maybe Double]
mbcolwidth = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [ColWidth]
widths forall a b. (a -> b) -> a -> b
$ \case
        ColWidth
ColWidthDefault -> forall a. Maybe a
Nothing
        ColWidth Double
w      -> forall a. a -> Maybe a
Just Double
w
  let colwidth :: Doc Text
colwidth = case forall a. [Maybe a] -> [a]
catMaybes [Maybe Double]
mbcolwidth of
                   [] -> forall a. Doc a
empty
                   [Double]
ws -> (Doc Text
"width=" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => Doc a -> Doc a
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => [Char] -> Doc a
text forall a b. (a -> b) -> a -> b
$
                         forall r. PrintfType r => [Char] -> r
printf [Char]
"%.2f\\textwidth" (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws)
  let keys :: Doc Text
keys = forall a. [Doc a] -> Doc a
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Doc Text
"," forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Doc a -> Bool
isEmpty) 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]  -- no need for a column width
  let options :: Doc Text
options = (if forall a. Doc a -> Bool
isEmpty Doc Text
keys
                 then forall a. Doc a
empty
                 else forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
keys) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space
  Doc Text
cellContents <- forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
blocks
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Tabl
tabl of
             Tabl
Xtb -> Doc Text
"\\startxcell" forall a. Semigroup a => a -> a -> a
<> Doc Text
options forall a. Semigroup a => a -> a -> a
<> Doc Text
cellContents forall a. Semigroup a => a -> a -> a
<> Doc Text
" \\stopxcell"
             Tabl
Ntb -> case CellType
celltype of
               CellType
BodyCell   -> Doc Text
"\\bTD" forall a. Semigroup a => a -> a -> a
<> Doc Text
options forall a. Semigroup a => a -> a -> a
<> Doc Text
cellContents forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\eTD"
               CellType
HeaderCell -> Doc Text
"\\bTH" forall a. Semigroup a => a -> a -> a
<> Doc Text
options forall a. Semigroup a => a -> a -> a
<> Doc Text
cellContents 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 -> forall a. Doc a
empty


---
--- Lists
--

listItemToConTeXt :: PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt :: forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
listItemToConTeXt [Block]
list = (Doc Text
"\\item" forall a. Doc a -> Doc a -> Doc a
$$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
  Doc Text
term' <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
term
  Doc Text
def'  <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [Doc a] -> Doc a
vsep forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [[Block]]
defs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\startdescription" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
term' forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 Doc Text
def' forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
"\\stopdescription" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline

-- | Convert list of block elements to ConTeXt.
blockListToConTeXt :: PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt :: forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
lst = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Block -> WM m (Doc Text)
blockToConTeXt [Block]
lst

-- | Convert list of inline elements to ConTeXt.
inlineListToConTeXt :: PandocMonad m
                    => [Inline]  -- ^ Inlines to convert
                    -> WM m (Doc Text)
inlineListToConTeXt :: forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [Doc a] -> Doc a
hcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Inline -> WM m (Doc Text)
inlineToConTeXt forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
addStruts [Inline]
lst
  -- We add a \strut after a line break that precedes a space,
  -- or the space gets swallowed
  where addStruts :: [Inline] -> [Inline]
addStruts (Inline
LineBreak : Inline
s : [Inline]
xs) | Inline -> Bool
isSpacey Inline
s =
           Inline
LineBreak forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"context") Text
"\\strut " forall a. a -> [a] -> [a]
: Inline
s forall a. a -> [a] -> [a]
:
             [Inline] -> [Inline]
addStruts [Inline]
xs
        addStruts (Inline
x:[Inline]
xs) = Inline
x 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
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
inlines
  if Bool -> Bool
not (forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_tagging WriterOptions
opts)
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Doc a -> Doc a
braces (Doc Text
style forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<> Doc Text
contents)
    else do
      let cmd :: Doc Text
cmd = Doc Text
"\\definehighlight " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => a -> Doc a
literal Text
name) forall a. Semigroup a => a -> a -> a
<>
                forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text
"style=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
style)
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stEmphasisCommands :: Map Text (Doc Text)
stEmphasisCommands =
                         forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name Doc Text
cmd (WriterState -> Map Text (Doc Text)
stEmphasisCommands WriterState
st) })
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
name forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents

-- | Convert inline element to ConTeXt
inlineToConTeXt :: PandocMonad m
                => Inline    -- ^ Inline to convert
                -> WM m (Doc Text)
inlineToConTeXt :: forall (m :: * -> *). PandocMonad m => Inline -> WM m (Doc Text)
inlineToConTeXt (Emph [Inline]
lst)      = forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> [Inline] -> WM m (Doc Text)
highlightInlines Text
"emph"      Doc Text
"\\em" [Inline]
lst
inlineToConTeXt (Strong [Inline]
lst)    = forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> [Inline] -> WM m (Doc Text)
highlightInlines Text
"strong"    Doc Text
"\\bf" [Inline]
lst
inlineToConTeXt (SmallCaps [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> [Inline] -> WM m (Doc Text)
highlightInlines Text
"smallcaps" Doc Text
"\\sc" [Inline]
lst
inlineToConTeXt (Underline [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\underbar" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
inlineToConTeXt (Strikeout [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\overstrikes" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
inlineToConTeXt (Superscript [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\high" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
inlineToConTeXt (Subscript [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\low" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
inlineToConTeXt (Code (Text
_ident, [Text]
classes, [(Text, Text)]
_kv) Text
str) = do
  let rawCode :: WM m (Doc Text)
rawCode =
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$
        case Text -> Maybe (Char, Char)
typeDelim Text
str of
          Just (Char
open, Char
close) ->
            Text
"\\type" 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]{" forall a. Semigroup a => a -> a -> a
<>
            (Text -> Text -> Text -> Text
T.replace Text
"{" Text
"/BTEX\\letteropenbrace /ETEX" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Text -> Text -> Text -> Text
T.replace Text
"}" Text
"/BTEX\\letterclosebrace /ETEX" forall a b. (a -> b) -> a -> b
$
             Text
str) Text -> Char -> Text
`T.snoc` Char
'}'
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let syntaxMap :: SyntaxMap
syntaxMap = WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts
  let attr' :: (Text, [Text], [a])
attr' = (Text
"", [Text]
classes, [])
  let highlightCode :: WM m (Doc Text)
highlightCode =
        case forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight SyntaxMap
syntaxMap FormatOptions -> [SourceLine] -> Text
formatConTeXtInline forall {a}. (Text, [Text], [a])
attr' Text
str of
          Left Text
msg -> do
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Text -> LogMessage
CouldNotHighlight Text
msg)
            WM m (Doc Text)
rawCode
          Right Text
h -> do
            forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stHighlighting :: Bool
stHighlighting = Bool
True })
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. HasChars a => [Char] -> Doc a
text (Text -> [Char]
T.unpack Text
h))
  if forall a. Maybe a -> Bool
isNothing (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts) Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes
    then WM m (Doc Text)
rawCode
    else WM m (Doc Text)
highlightCode
inlineToConTeXt (Quoted QuoteType
SingleQuote [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\quote" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
inlineToConTeXt (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\quotation" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
inlineToConTeXt (Cite [Citation]
_ [Inline]
lst) = forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
inlineToConTeXt (Str Text
str) = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text -> Text
stringToConTeXt WriterOptions
opts Text
str
inlineToConTeXt (Math MathType
InlineMath Text
str) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Char -> Doc a
char Char
'$' forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'$'
inlineToConTeXt (Math MathType
DisplayMath Text
str) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"\\startformula "  forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
" \\stopformula" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space
inlineToConTeXt il :: Inline
il@(RawInline Format
f Text
str)
  | Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex" Bool -> Bool -> Bool
|| Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"context" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise = forall a. Doc a
empty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Inline -> LogMessage
InlineNotRendered Inline
il)
inlineToConTeXt Inline
LineBreak = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"\\crlf" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr
inlineToConTeXt Inline
SoftBreak = do
  WrapOption
wrapText <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WriterOptions -> WrapOption
writerWrapText forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case WrapOption
wrapText of
               WrapOption
WrapAuto     -> forall a. Doc a
space
               WrapOption
WrapNone     -> forall a. Doc a
space
               WrapOption
WrapPreserve -> forall a. Doc a
cr
inlineToConTeXt Inline
Space = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
inlineToConTeXt (Link Attr
_ [Inline]
txt (Text
src, Text
_)) = do
  let isAutolink :: Bool
isAutolink = [Inline]
txt forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
src)]
  let escConTeXtURL :: Text -> Text
escConTeXtURL = (Char -> Text) -> Text -> Text
T.concatMap 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
      Int
next <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNextRef
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st {stNextRef :: Int
stNextRef = Int
next forall a. Num a => a -> a -> a
+ Int
1}
      let ref :: Text
ref = Text
"url" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
next
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ Doc Text
"\\useURL"
        , forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => a -> Doc a
literal Text
ref)
        , forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escConTeXtURL Text
src)
        , Doc Text
"\\from"
        , forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => a -> Doc a
literal Text
ref)
        ]
    else do
      Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
txt
      -- Handle HTML-like internal document references to sections
      Text
reference <- case Text -> Maybe (Char, Text)
T.uncons Text
src of
        Just (Char
'#', Text
ref) -> Text -> Text
toLabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                           (WriterOptions -> Text -> Text
stringToConTeXt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
ref)
        Maybe (Char, Text)
_               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
"url(" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escConTeXtURL Text
src forall a. Semigroup a => a -> a -> a
<> Text
")"
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ Doc Text
"\\goto"
        , forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
        , forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => a -> Doc a
literal Text
reference)
        ]
inlineToConTeXt (Image attr :: Attr
attr@(Text
_,[Text]
cls,[(Text, Text)]
_) [Inline]
_ (Text
src, Text
_)) = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let showDim :: Direction -> [Doc Text]
showDim Direction
dir = let d :: Doc Text
d = forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow Direction
dir) 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 forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Dimension -> Text
showInInch WriterOptions
opts (Integer -> Dimension
Pixel Integer
a)) forall a. Semigroup a => a -> a -> a
<> Doc Text
"in"]
                         Just (Percent Double
a) ->
                           [Doc Text
d forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (forall a. RealFloat a => a -> Text
showFl (Double
a forall a. Fractional a => a -> a -> a
/ Double
100)) forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\textwidth"]
                         Just Dimension
dim         ->
                           [Doc Text
d forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow Dimension
dim)]
                         Maybe Dimension
Nothing          ->
                           []
      dimList :: [Doc Text]
dimList = Direction -> [Doc Text]
showDim Direction
Width forall a. [a] -> [a] -> [a]
++ Direction -> [Doc Text]
showDim Direction
Height
      dims :: Doc Text
dims = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
dimList
                then forall a. Doc a
empty
                else forall a. HasChars a => Doc a -> Doc a
brackets forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Doc Text
"," [Doc Text]
dimList)
      clas :: Doc Text
clas = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls
                then forall a. Doc a
empty
                else forall a. HasChars a => Doc a -> Doc a
brackets forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
toLabel forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Text]
cls
      -- Use / for path separators on Windows; see #4918
      fixPathSeparators :: Text -> Text
fixPathSeparators = (Char -> Char) -> Text -> Text
T.map forall a b. (a -> b) -> a -> b
$ \Char
c -> case Char
c of
                                          Char
'\\' -> Char
'/'
                                          Char
_    -> Char
c
      src' :: Text
src' = Text -> Text
fixPathSeparators forall a b. (a -> b) -> a -> b
$
             if Text -> Bool
isURI Text
src
                then Text
src
                else [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
src
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Doc a -> Doc a
braces forall a b. (a -> b) -> a -> b
$ Doc Text
"\\externalfigure" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => a -> Doc a
literal Text
src') forall a. Semigroup a => a -> a -> a
<> Doc Text
dims forall a. Semigroup a => a -> a -> a
<> Doc Text
clas
inlineToConTeXt (Note [Block]
contents) = do
  Doc Text
contents' <- forall (m :: * -> *). PandocMonad m => [Block] -> WM m (Doc Text)
blockListToConTeXt [Block]
contents
  let codeBlock :: Block -> [Block]
codeBlock x :: Block
x@(CodeBlock Attr
_ Text
_) = [Block
x]
      codeBlock Block
_                 = []
  let codeBlocks :: [Block]
codeBlocks = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [Block]
codeBlock [Block]
contents
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
codeBlocks
              then forall a. HasChars a => a -> Doc a
literal Text
"\\footnote{" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (forall a. Doc a -> Doc a
chomp Doc Text
contents') forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'}'
              else forall a. HasChars a => a -> Doc a
literal Text
"\\startbuffer " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (forall a. Doc a -> Doc a
chomp Doc Text
contents') forall a. Semigroup a => a -> a -> a
<>
                   forall a. HasChars a => a -> Doc a
literal Text
"\\stopbuffer\\footnote{\\getbuffer}"
inlineToConTeXt (Span (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
ils) = do
  Maybe Text
mblang <- forall (m :: * -> *).
PandocMonad m =>
Maybe Text -> WM m (Maybe Text)
fromBCP47 (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs)
  let wrapDir :: Doc a -> Doc a
wrapDir Doc a
txt = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
                      Just Text
"rtl" -> forall a. HasChars a => Doc a -> Doc a
braces forall a b. (a -> b) -> a -> b
$ Doc a
"\\righttoleft " forall a. Semigroup a => a -> a -> a
<> Doc a
txt
                      Just Text
"ltr" -> forall a. HasChars a => Doc a -> Doc a
braces forall a b. (a -> b) -> a -> b
$ Doc a
"\\lefttoright " forall a. Semigroup a => a -> a -> a
<> Doc a
txt
                      Maybe Text
_          -> Doc a
txt
      wrapLang :: Doc Text -> Doc Text
wrapLang Doc Text
txt = case Maybe Text
mblang of
                       Just Text
lng -> forall a. HasChars a => Doc a -> Doc a
braces (Doc Text
"\\language" forall a. Semigroup a => a -> a -> a
<>
                                           forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => a -> Doc a
literal Text
lng) forall a. Semigroup a => a -> a -> a
<> Doc Text
txt)
                       Maybe Text
Nothing -> Doc Text
txt
      addReference :: Doc Text -> Doc Text
addReference =
        if Text -> Bool
T.null Text
ident
        then forall a. a -> a
id
        else ((Doc Text
"\\reference" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => a -> Doc a
literal Text
ident) forall a. Semigroup a => a -> a -> a
<> Doc Text
"{}") forall a. Semigroup a => a -> a -> a
<>)
  Doc Text -> Doc Text
addReference forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
wrapLang forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => Doc a -> Doc a
wrapDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
ils

-- | Craft the section header, inserting the section reference, if supplied.
sectionHeader :: PandocMonad m
              => Attr
              -> Int
              -> [Inline]
              -> HeadingType
              -> WM m (Doc Text)
sectionHeader :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Int -> [Inline] -> HeadingType -> WM m (Doc Text)
sectionHeader (Text
ident,[Text]
classes,[(Text, Text)]
kvs) Int
hdrLevel [Inline]
lst HeadingType
secenv = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> WM m (Doc Text)
inlineListToConTeXt [Inline]
lst
  Doc Text
levelText <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Int -> HeadingType -> WM m (Doc Text)
sectionLevelToText WriterOptions
opts (Text
ident,[Text]
classes,[(Text, Text)]
kvs) Int
hdrLevel HeadingType
secenv
  let optsList :: [Doc Text]
optsList = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$
        [ [Doc Text
"title=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents | Bool -> Bool
not (forall a. Doc a -> Bool
isEmpty Doc Text
contents)]
        , [Doc Text
"reference=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces (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" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
        , [Doc Text
"incrementnumber=no" | Text
"unnumbered" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes]
        ]
  let starter :: Doc Text
starter = case HeadingType
secenv of
                  HeadingType
SectionHeading -> Doc Text
"\\start"
                  HeadingType
NonSectionHeading -> Doc Text
"\\"
  let options :: Doc Text
options = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
optsList Bool -> Bool -> Bool
|| forall a. Doc a -> Bool
isEmpty Doc Text
levelText
                then forall a. Doc a
empty
                else forall a. HasChars a => Doc a -> Doc a
brackets forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
hcat (forall a. a -> [a] -> [a]
intersperse Doc Text
"," [Doc Text]
optsList)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
starter forall a. Semigroup a => a -> a -> a
<> Doc Text
levelText forall a. Semigroup a => a -> a -> a
<> Doc Text
options forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline

-- | Craft the section footer
sectionFooter :: PandocMonad m => Attr -> Int -> WM m (Doc Text)
sectionFooter :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Int -> WM m (Doc Text)
sectionFooter Attr
attr Int
hdrLevel = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Doc Text
levelText <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Int -> HeadingType -> WM m (Doc Text)
sectionLevelToText WriterOptions
opts Attr
attr Int
hdrLevel HeadingType
SectionHeading
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\stop" forall a. Semigroup a => a -> a -> a
<> Doc Text
levelText forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline

-- | Generate a textual representation of the section level
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" 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 (forall a. HasChars a => a -> Doc a
literal a
"subject", forall a. HasChars a => a -> Doc a
literal a
"title")
                                 else (forall a. HasChars a => a -> Doc a
literal a
"section", forall a. HasChars a => a -> Doc a
literal a
"chapter")
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Int
hdrLevel forall a. Num a => a -> a -> a
+ Int
shift of
                   -1         -> forall a. HasChars a => a -> Doc a
literal a
"part"
                   Int
0          -> Doc a
chapter
                   Int
n | Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 -> forall a. HasChars a => [Char] -> Doc a
text (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- Int
1) [Char]
"sub"))
                                 forall a. Semigroup a => a -> a -> a
<> Doc a
section
                   Int
_          -> forall a. Doc a
empty -- cannot happen

  case WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts of
    TopLevelDivision
TopLevelPart    -> forall {m :: * -> *} {a}. (Monad m, HasChars a) => Int -> m (Doc a)
semanticSection (-Int
2)
    TopLevelDivision
TopLevelChapter -> forall {m :: * -> *} {a}. (Monad m, HasChars a) => Int -> m (Doc a)
semanticSection (-Int
1)
    TopLevelDivision
TopLevelSection -> forall {m :: * -> *} {a}. (Monad m, HasChars a) => Int -> m (Doc a)
semanticSection Int
0
    TopLevelDivision
TopLevelDefault -> if Bool
unlisted
                       then forall {m :: * -> *} {a}. (Monad m, HasChars a) => Int -> m (Doc a)
semanticSection Int
0
                       else forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$
                            case HeadingType
headingType of
                              HeadingType
SectionHeading    -> Text
"sectionlevel"
                              HeadingType
NonSectionHeading -> Text
""

-- | Finds a pair of symbols that can be used as delimiters.
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 (forall a. Eq a => a -> a -> Bool
/= Char
c) Text
delims
  in case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons forall a b. (a -> b) -> a -> b
$ forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' Text -> Char -> Text
go Text
delimChars Text
t of
       Just Char
'{' -> forall a. a -> Maybe a
Just (Char
'{', Char
'}')
       Just Char
c   -> forall a. a -> Maybe a
Just (Char
c, Char
c)
       Maybe Char
Nothing  -> 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' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang Maybe Text
mbs

-- Takes a list of the constituents of a BCP 47 language code
-- and irons out ConTeXt's exceptions
-- https://tools.ietf.org/html/bcp47#section-2.1
-- http://wiki.contextgarden.net/Language_Codes
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]
_)) = forall a. a -> Maybe a
Just Text
"ar-sy"
fromBCP47' (Just (Lang Text
"ar" Maybe Text
_ (Just Text
"IQ") [Text]
_ [(Text, [(Text, Text)])]
_ [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]
_)) = forall a. a -> Maybe a
Just Text
"ar-jo"
fromBCP47' (Just (Lang Text
"ar" Maybe Text
_ (Just Text
"LB") [Text]
_ [(Text, [(Text, Text)])]
_ [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]
_)) = forall a. a -> Maybe a
Just Text
"ar-dz"
fromBCP47' (Just (Lang Text
"ar" Maybe Text
_ (Just Text
"MA") [Text]
_ [(Text, [(Text, Text)])]
_ [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]
_))    = forall a. a -> Maybe a
Just Text
"deo"
fromBCP47' (Just (Lang Text
"de" Maybe Text
_ (Just Text
"DE") [Text]
_ [(Text, [(Text, Text)])]
_ [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]
_)) = forall a. a -> Maybe a
Just Text
"de-at"
fromBCP47' (Just (Lang Text
"de" Maybe Text
_ (Just Text
"CH") [Text]
_ [(Text, [(Text, Text)])]
_ [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]
_))    = forall a. a -> Maybe a
Just Text
"agr"
fromBCP47' (Just (Lang Text
"en" Maybe Text
_ (Just Text
"US") [Text]
_ [(Text, [(Text, Text)])]
_ [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]
_)) = forall a. a -> Maybe a
Just Text
"en-gb"
fromBCP47' (Just (Lang Text
"grc"Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_))           = forall a. a -> Maybe a
Just Text
"agr"
fromBCP47' (Just (Lang Text
"el" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_))           = forall a. a -> Maybe a
Just Text
"gr"
fromBCP47' (Just (Lang Text
"eu" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_))           = forall a. a -> Maybe a
Just Text
"ba"
fromBCP47' (Just (Lang Text
"he" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_))           = forall a. a -> Maybe a
Just Text
"il"
fromBCP47' (Just (Lang Text
"jp" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_))           = forall a. a -> Maybe a
Just Text
"ja"
fromBCP47' (Just (Lang Text
"uk" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_))           = forall a. a -> Maybe a
Just Text
"ua"
fromBCP47' (Just (Lang Text
"vi" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_))           = forall a. a -> Maybe a
Just Text
"vn"
fromBCP47' (Just (Lang Text
"zh" Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_))           = forall a. a -> Maybe a
Just Text
"cn"
fromBCP47' (Just (Lang Text
l Maybe Text
_ Maybe Text
_ [Text]
_ [(Text, [(Text, Text)])]
_ [Text]
_))              = forall a. a -> Maybe a
Just Text
l
fromBCP47' Maybe Lang
Nothing                                = forall a. Maybe a
Nothing