{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE ViewPatterns        #-}
{- |
   Module      : Text.Pandoc.Writers.LaTeX
   Copyright   : Copyright (C) 2006-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 LaTeX.
-}
module Text.Pandoc.Writers.LaTeX (
    writeLaTeX
  , writeBeamer
  ) where
import Control.Monad.State.Strict
    ( MonadState(get, put),
      gets,
      modify,
      evalStateT )
import Control.Monad
    ( MonadPlus(mplus),
      liftM,
      when,
      unless )
import Data.Containers.ListUtils (nubOrd)
import Data.Char (isDigit)
import Data.List (intersperse, (\\))
import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, isNothing)
import Data.Monoid (Any (..))
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (unEscapeString)
import Text.DocTemplates (FromContext(lookupContext), renderTemplate)
import Text.Collate.Lang (renderLang)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (formatLaTeXBlock, formatLaTeXInline, highlight,
                                 styleToLaTeX)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.URI
import Text.Pandoc.Slides
import Text.Pandoc.Walk (query, walk, walkM)
import Text.Pandoc.Writers.LaTeX.Caption (getCaption)
import Text.Pandoc.Writers.LaTeX.Table (tableToLaTeX)
import Text.Pandoc.Writers.LaTeX.Citation (citationsToNatbib,
                                           citationsToBiblatex)
import Text.Pandoc.Writers.LaTeX.Types (LW, WriterState (..), startingState)
import Text.Pandoc.Writers.LaTeX.Lang (toBabel)
import Text.Pandoc.Writers.LaTeX.Util (stringToLaTeX, StringContext(..),
                                       toLabel, inCmd,
                                       wrapDiv, hypertarget, labelFor,
                                       getListingsLanguage, mbBraced)
import Text.Pandoc.Writers.Shared
import qualified Text.Pandoc.Writers.AnnotatedTable as Ann

-- | Convert Pandoc to LaTeX.
writeLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeLaTeX :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX WriterOptions
options Pandoc
document =
  forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> LW m Text
pandocToLaTeX WriterOptions
options Pandoc
document) forall a b. (a -> b) -> a -> b
$
    WriterOptions -> WriterState
startingState WriterOptions
options

-- | Convert Pandoc to LaTeX Beamer.
writeBeamer :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeBeamer :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBeamer WriterOptions
options Pandoc
document =
  forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> LW m Text
pandocToLaTeX WriterOptions
options Pandoc
document) forall a b. (a -> b) -> a -> b
$
    (WriterOptions -> WriterState
startingState WriterOptions
options){ stBeamer :: Bool
stBeamer = Bool
True }

pandocToLaTeX :: PandocMonad m
              => WriterOptions -> Pandoc -> LW m Text
pandocToLaTeX :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> LW m Text
pandocToLaTeX WriterOptions
options (Pandoc Meta
meta [Block]
blocks) = do
  -- Strip off 'references' header if --natbib or --biblatex
  let method :: CiteMethod
method = WriterOptions -> CiteMethod
writerCiteMethod WriterOptions
options
  let isRefsDiv :: Block -> Bool
isRefsDiv (Div (Text
"refs",[Text]
_,[(Text, Text)]
_) [Block]
_) = Bool
True
      isRefsDiv Block
_ = Bool
False
  let blocks' :: [Block]
blocks' = if CiteMethod
method forall a. Eq a => a -> a -> Bool
== CiteMethod
Biblatex Bool -> Bool -> Bool
|| CiteMethod
method forall a. Eq a => a -> a -> Bool
== CiteMethod
Natbib
                   then forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isRefsDiv) [Block]
blocks
                   else [Block]
blocks
  -- see if there are internal links
  let isInternalLink :: Inline -> [Text]
isInternalLink (Link (Text, [Text], [(Text, Text)])
_ [Inline]
_ (Text
s,Text
_))
        | Just (Char
'#', Text
xs) <- Text -> Maybe (Char, Text)
T.uncons Text
s = [Text
xs]
      isInternalLink Inline
_                 = []
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stInternalLinks :: [Text]
stInternalLinks = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [Text]
isInternalLink [Block]
blocks' }
  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] -> LW m (Doc Text)
blockListToLaTeX
              (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] -> LW m (Doc Text)
inlineListToLaTeX)
              Meta
meta
  let chaptersClasses :: [Text]
chaptersClasses = [Text
"memoir",Text
"book",Text
"report",Text
"scrreprt",Text
"scrreport",
                        Text
"scrbook",Text
"extreport",Text
"extbook",Text
"tufte-book",
                        Text
"ctexrep",Text
"ctexbook",Text
"elegantbook"]
  let frontmatterClasses :: [Text]
frontmatterClasses = [Text
"memoir",Text
"book",Text
"scrbook",Text
"extbook",Text
"tufte-book",
                           Text
"ctexbook",Text
"elegantbook"]
  -- these have \frontmatter etc.
  Bool
beamer <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  let documentClass :: Text
documentClass =
        case forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"documentclass" (WriterOptions -> Context Text
writerVariables WriterOptions
options) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
              (forall a. Walkable Inline a => a -> Text
stringify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"documentclass" Meta
meta) of
                 Just Text
x -> Text
x
                 Maybe Text
Nothing | Bool
beamer    -> Text
"beamer"
                         | Bool
otherwise -> case WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
options of
                                          TopLevelDivision
TopLevelPart    -> Text
"book"
                                          TopLevelDivision
TopLevelChapter -> Text
"book"
                                          TopLevelDivision
_               -> Text
"article"
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
documentClass forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
chaptersClasses) forall a b. (a -> b) -> a -> b
$
     forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stHasChapters :: Bool
stHasChapters = Bool
True }
  case forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"csquotes" (WriterOptions -> Context Text
writerVariables WriterOptions
options) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
       (forall a. Walkable Inline a => a -> Text
stringify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"csquotes" Meta
meta) of
     Maybe Text
Nothing      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Just Text
"false" -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Just Text
_       -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stCsquotes :: Bool
stCsquotes = Bool
True}
  let ([Block]
blocks'', [Inline]
lastHeader) = if WriterOptions -> CiteMethod
writerCiteMethod WriterOptions
options forall a. Eq a => a -> a -> Bool
== CiteMethod
Citeproc then
                                 ([Block]
blocks', [])
                               else case forall a. [a] -> [a]
reverse [Block]
blocks' of
                                 Header Int
1 (Text, [Text], [(Text, Text)])
_ [Inline]
il : [Block]
_ -> (forall a. [a] -> [a]
init [Block]
blocks', [Inline]
il)
                                 [Block]
_                 -> ([Block]
blocks', [])
  [Block]
blocks''' <- if Bool
beamer
                  then forall (m :: * -> *). PandocMonad m => [Block] -> LW m [Block]
toSlides [Block]
blocks''
                  else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False forall a. Maybe a
Nothing [Block]
blocks''
  Doc Text
main <- forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
blocks'''
  Doc Text
biblioTitle <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lastHeader
  WriterState
st <- forall s (m :: * -> *). MonadState s m => m s
get
  Text
titleMeta <- forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
TextString forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta
  [Text]
authorsMeta <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
TextString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Walkable Inline a => a -> Text
stringify) forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
  [Lang]
docLangs <- forall a. [Maybe a] -> [a]
catMaybes 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 => Maybe Text -> m (Maybe Lang)
toLang forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) (forall a. Ord a => [a] -> [a]
nubOrd (forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (Text -> Block -> [Text]
extract Text
"lang") [Block]
blocks))
  let hasStringValue :: Text -> Bool
hasStringValue Text
x = forall a. Maybe a -> Bool
isJust (forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
x Context Text
metadata :: Maybe (Doc Text))
  let geometryFromMargins :: Doc Text
geometryFromMargins = 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
"lmargin",Text
"margin-left")
                              ,(Doc Text
"rmargin",Text
"margin-right")
                              ,(Doc Text
"tmargin",Text
"margin-top")
                              ,(Doc Text
"bmargin",Text
"margin-bottom")
                              ]
  Maybe Lang
mblang <- forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang forall a b. (a -> b) -> a -> b
$ case WriterOptions -> Meta -> Maybe Text
getLang WriterOptions
options Meta
meta of
                          Just Text
l -> forall a. a -> Maybe a
Just Text
l
                          Maybe Text
Nothing | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Lang]
docLangs -> forall a. Maybe a
Nothing
                                  | Bool
otherwise     -> forall a. a -> Maybe a
Just Text
"en"
  -- we need a default here since lang is used in template conditionals
  let otherLangs :: [Lang]
otherLangs = [Lang
l | Lang
l <- [Lang]
docLangs, Maybe Lang
mblang forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Lang
l]

  let dirs :: [Text]
dirs = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (Text -> Block -> [Text]
extract Text
"dir") [Block]
blocks

  let nociteIds :: [Text]
nociteIds = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (\case
                           Cite [Citation]
cs [Inline]
_ -> forall a b. (a -> b) -> [a] -> [b]
map Citation -> Text
citationId [Citation]
cs
                           Inline
_         -> [])
                    forall a b. (a -> b) -> a -> b
$ Text -> Meta -> [Inline]
lookupMetaInlines Text
"nocite" Meta
meta

  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
"toc-depth" (forall a. Show a => a -> Text
tshow
                                        (WriterOptions -> Int
writerTOCDepth WriterOptions
options forall a. Num a => a -> a -> a
-
                                              if WriterState -> Bool
stHasChapters WriterState
st
                                                 then Int
1
                                                 else Int
0)) 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
"title-meta" Text
titleMeta forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"author-meta"
                        (Text -> [Text] -> Text
T.intercalate Text
"; " [Text]
authorsMeta) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"documentclass" Text
documentClass forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"verbatim-in-note" (WriterState -> Bool
stVerbInNote WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"tables" (WriterState -> Bool
stTable WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"multirow" (WriterState -> Bool
stMultiRow WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"strikeout" (WriterState -> Bool
stStrikeout WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"url" (WriterState -> Bool
stUrl WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"numbersections" (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
"lhs" (WriterState -> Bool
stLHS WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"graphics" (WriterState -> Bool
stGraphics WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"subfigure" (WriterState -> Bool
stSubfigure WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"svg" (WriterState -> Bool
stSVG WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"has-chapters" (WriterState -> Bool
stHasChapters WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"has-frontmatter" (Text
documentClass forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
frontmatterClasses) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"listings" (WriterOptions -> Bool
writerListings WriterOptions
options Bool -> Bool -> Bool
|| WriterState -> Bool
stLHS WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"zero-width-non-joiner" (WriterState -> Bool
stZwnj WriterState
st) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"beamer" Bool
beamer forall a b. (a -> b) -> a -> b
$
                  (if WriterState -> Bool
stHighlighting WriterState
st
                      then case WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
options of
                                Just Style
sty ->
                                   forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"highlighting-macros"
                                      (Text -> Text
T.stripEnd forall a b. (a -> b) -> a -> b
$ Style -> Text
styleToLaTeX Style
sty)
                                Maybe Style
Nothing -> forall a. a -> a
id
                      else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
                  (case WriterOptions -> CiteMethod
writerCiteMethod WriterOptions
options of
                         CiteMethod
Natbib   -> forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"biblio-title" Doc Text
biblioTitle forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"natbib" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"nocite-ids" [Text]
nociteIds
                         CiteMethod
Biblatex -> forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"biblio-title" Doc Text
biblioTitle forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"biblatex" Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"nocite-ids" [Text]
nociteIds
                         CiteMethod
_        -> 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
"colorlinks" (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
hasStringValue
                           [Text
"citecolor", Text
"urlcolor", Text
"linkcolor", Text
"toccolor",
                            Text
"filecolor"]) forall a b. (a -> b) -> a -> b
$
                  (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
dirs
                     then forall a. a -> a
id
                     else forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"dir" (Text
"ltr" :: Text)) forall a b. (a -> b) -> a -> b
$
                  forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"section-titles" Bool
True 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
"geometry" Doc Text
geometryFromMargins forall a b. (a -> b) -> a -> b
$
                  (case Text -> Maybe (Char, Text)
T.uncons 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
                      -- uppercase a4, a5, etc.
                      Just (Just (Char
'A', Text
ds))
                        | Bool -> Bool
not (Text -> Bool
T.null Text
ds) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
ds
                          -> forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"papersize" (Text
"a" forall a. Semigroup a => a -> a -> a
<> Text
ds)
                      Maybe (Maybe (Char, Text))
_   -> forall a. a -> a
id)
                  Context Text
metadata
  let context' :: Context Text
context' =
          -- note: lang is used in some conditionals in the template,
          -- so we need to set it if we have any babel/polyglossia:
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Lang
l -> forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"lang"
                      (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Lang -> Text
renderLang Lang
l)) Maybe Lang
mblang
        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
"babel-lang"
                      (forall a. HasChars a => a -> Doc a
literal Text
l)) (Maybe Lang
mblang forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Lang -> Maybe Text
toBabel)
        forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"babel-otherlangs"
             (forall a b. (a -> b) -> [a] -> [b]
map forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Lang -> Maybe Text
toBabel [Lang]
otherLangs)
        forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"latex-dir-rtl"
           ((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
"dir" Context Text
context) forall a. Eq a => a -> a -> Bool
==
               forall a. a -> Maybe a
Just (Text
"rtl" :: Text)) 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'

toSlides :: PandocMonad m => [Block] -> LW m [Block]
toSlides :: forall (m :: * -> *). PandocMonad m => [Block] -> LW m [Block]
toSlides [Block]
bs = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let slideLevel :: Int
slideLevel = forall a. a -> Maybe a -> a
fromMaybe ([Block] -> Int
getSlideLevel [Block]
bs) forall a b. (a -> b) -> a -> b
$ WriterOptions -> Maybe Int
writerSlideLevel WriterOptions
opts
  let bs' :: [Block]
bs' = Int -> [Block] -> [Block]
prepSlides Int
slideLevel [Block]
bs
  forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM (forall (m :: * -> *). PandocMonad m => Int -> Block -> LW m Block
elementToBeamer Int
slideLevel) forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False forall a. Maybe a
Nothing [Block]
bs'

-- this creates section slides and marks slides with class "slide","block"
elementToBeamer :: PandocMonad m => Int -> Block -> LW m Block
elementToBeamer :: forall (m :: * -> *). PandocMonad m => Int -> Block -> LW m Block
elementToBeamer Int
slideLevel (Div (Text
ident,Text
"section":[Text]
dclasses,[(Text, Text)]
dkvs)
                              xs :: [Block]
xs@(h :: Block
h@(Header Int
lvl (Text, [Text], [(Text, Text)])
_ [Inline]
_) : [Block]
ys))
  | Int
lvl forall a. Ord a => a -> a -> Bool
>  Int
slideLevel
    = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident,Text
"block"forall a. a -> [a] -> [a]
:[Text]
dclasses,[(Text, Text)]
dkvs) [Block]
xs
  | Int
lvl forall a. Ord a => a -> a -> Bool
<  Int
slideLevel
    = do let isSlide :: Block -> Bool
isSlide (Div (Text
_,Text
"slide":[Text]
_,[(Text, Text)]
_) [Block]
_)   = Bool
True
             isSlide (Div (Text
_,Text
"section":[Text]
_,[(Text, Text)]
_) [Block]
_) = Bool
True
             isSlide Block
_                         = Bool
False
         let ([Block]
titleBs, [Block]
slideBs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isSlide [Block]
ys
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
           case [Block]
titleBs of
              [] -> (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident,Text
"section"forall a. a -> [a] -> [a]
:[Text]
dclasses,[(Text, Text)]
dkvs) [Block]
xs
              [Div (Text
_,Text
"notes":[Text]
_,[(Text, Text)]
_) [Block]
_] ->  -- see #7857, don't create frame
                    -- just for speaker notes after section heading
                    (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident,Text
"section"forall a. a -> [a] -> [a]
:[Text]
dclasses,[(Text, Text)]
dkvs) [Block]
xs
              [Block]
_  -> (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident,Text
"section"forall a. a -> [a] -> [a]
:[Text]
dclasses,[(Text, Text)]
dkvs)
                     (Block
h forall a. a -> [a] -> [a]
: (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
"",Text
"slide"forall a. a -> [a] -> [a]
:[Text]
dclasses,[(Text, Text)]
dkvs) (Block
hforall a. a -> [a] -> [a]
:[Block]
titleBs) forall a. a -> [a] -> [a]
: [Block]
slideBs)
  | Bool
otherwise
    = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident,Text
"slide"forall a. a -> [a] -> [a]
:[Text]
dclasses,[(Text, Text)]
dkvs) [Block]
xs
elementToBeamer Int
_ Block
x = forall (m :: * -> *) a. Monad m => a -> m a
return Block
x

isListBlock :: Block -> Bool
isListBlock :: Block -> Bool
isListBlock (BulletList [[Block]]
_)     = Bool
True
isListBlock (OrderedList ListAttributes
_ [[Block]]
_)  = Bool
True
isListBlock (DefinitionList [([Inline], [[Block]])]
_) = Bool
True
isListBlock Block
_                  = Bool
False

-- | Convert Pandoc block element to LaTeX.
blockToLaTeX :: PandocMonad m
             => Block     -- ^ Block to convert
             -> LW m (Doc Text)
blockToLaTeX :: forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX (Div attr :: (Text, [Text], [(Text, Text)])
attr@(Text
identifier,Text
"block":[Text]
dclasses,[(Text, Text)]
_)
             (Header Int
_ (Text, [Text], [(Text, Text)])
_ [Inline]
ils : [Block]
bs)) = do
  let blockname :: Doc Text
blockname
        | Text
"example" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
dclasses = Doc Text
"exampleblock"
        | Text
"alert" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
dclasses = Doc Text
"alertblock"
        | Bool
otherwise = Doc Text
"block"
  Doc Text
anchor <- if Text -> Bool
T.null Text
identifier
               then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Doc a
empty
               else (forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
hypertarget Text
identifier
  Doc Text
title' <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
ils
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
bs
  forall (m :: * -> *).
PandocMonad m =>
(Text, [Text], [(Text, Text)]) -> Doc Text -> LW m (Doc Text)
wrapDiv (Text, [Text], [(Text, Text)])
attr forall a b. (a -> b) -> a -> b
$ (Doc Text
"\\begin" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
blockname forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
title' forall a. Semigroup a => a -> a -> a
<> Doc Text
anchor) forall a. Doc a -> Doc a -> Doc a
$$
                 Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\end" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
blockname
blockToLaTeX (Div (Text
identifier,Text
"slide":[Text]
dclasses,[(Text, Text)]
dkvs)
               (Header Int
_ (Text
_,[Text]
hclasses,[(Text, Text)]
hkvs) [Inline]
ils : [Block]
bs)) = do
  -- note: [fragile] is required or verbatim breaks
  let hasCodeBlock :: Block -> [Bool]
hasCodeBlock (CodeBlock (Text, [Text], [(Text, Text)])
_ Text
_) = [Bool
True]
      hasCodeBlock Block
_               = []
  let hasCode :: Inline -> [Bool]
hasCode (Code (Text, [Text], [(Text, Text)])
_ Text
_) = [Bool
True]
      hasCode Inline
_          = []
  let classes :: [Text]
classes = forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ [Text]
dclasses forall a. [a] -> [a] -> [a]
++ [Text]
hclasses
  let kvs :: [(Text, Text)]
kvs = forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
dkvs forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
hkvs
  let fragile :: Bool
fragile = Text
"fragile" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
||
                Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [Bool]
hasCodeBlock [Block]
bs forall a. [a] -> [a] -> [a]
++ forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [Bool]
hasCode [Block]
bs)
  let frameoptions :: [Text]
frameoptions = [Text
"allowdisplaybreaks", Text
"allowframebreaks", Text
"fragile",
                      Text
"b", Text
"c", Text
"t", Text
"environment", Text
"s", Text
"squeeze",
                      Text
"label", Text
"plain", Text
"shrink", Text
"standout",
                      Text
"noframenumbering", Text
"containsverbatim"]
  let optionslist :: [Text]
optionslist = [Text
"fragile" | Bool
fragile
                               , forall a. Maybe a -> Bool
isNothing (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"fragile" [(Text, Text)]
kvs)
                               , Text
"fragile" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes
                               , Text
"containsverbatim" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes] forall a. [a] -> [a] -> [a]
++
                    [Text
k | Text
k <- [Text]
classes, Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
frameoptions] forall a. [a] -> [a] -> [a]
++
                    [Text
k forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> Text
v | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
frameoptions] forall a. [a] -> [a] -> [a]
++
                    [Text
v | (Text
"frameoptions", Text
v) <- [(Text, Text)]
kvs]
  let options :: Doc Text
options = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
optionslist
                   then forall a. Doc a
empty
                   else forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => a -> Doc a
literal (Text -> [Text] -> Text
T.intercalate Text
"," [Text]
optionslist))
  Doc Text
slideTitle <- if [Inline]
ils forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
"\0"] -- marker for hrule
                   then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
                   else forall a. HasChars a => Doc a -> Doc a
braces forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
ils
  Doc Text
slideAnchor <- if Text -> Bool
T.null Text
identifier
                    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Doc a
empty
                    else (forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
hypertarget Text
identifier
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
bs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
(Text, [Text], [(Text, Text)]) -> Doc Text -> LW m (Doc Text)
wrapDiv (Text
identifier,[Text]
classes,[(Text, Text)]
kvs)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Doc Text
"\\begin{frame}" forall a. Semigroup a => a -> a -> a
<> Doc Text
options forall a. Semigroup a => a -> a -> a
<> Doc Text
slideTitle forall a. Semigroup a => a -> a -> a
<> Doc Text
slideAnchor) forall a. Doc a -> Doc a -> Doc a
$$
             Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\end{frame}"
blockToLaTeX (Div (identifier :: Text
identifier@(Text -> Maybe (Char, Text)
T.uncons -> Just (Char
_,Text
_)),[Text]
dclasses,[(Text, Text)]
dkvs)
               (Header Int
lvl (Text
"",[Text]
hclasses,[(Text, Text)]
hkvs) [Inline]
ils : [Block]
bs)) =
  -- move identifier from div to header
  forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX ((Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
"",[Text]
dclasses,[(Text, Text)]
dkvs)
               (Int -> (Text, [Text], [(Text, Text)]) -> [Inline] -> Block
Header Int
lvl (Text
identifier,[Text]
hclasses,[(Text, Text)]
hkvs) [Inline]
ils forall a. a -> [a] -> [a]
: [Block]
bs))
blockToLaTeX (Div (Text
identifier,[Text]
classes,[(Text, Text)]
kvs) [Block]
bs) = do
  Bool
beamer <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  Bool
oldIncremental <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIncremental
  if Bool
beamer Bool -> Bool -> Bool
&& Text
"incremental" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
     then forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stIncremental :: Bool
stIncremental = Bool
True }
     else forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
beamer Bool -> Bool -> Bool
&& Text
"nonincremental" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes) forall a b. (a -> b) -> a -> b
$
             forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stIncremental :: Bool
stIncremental = Bool
False }
  Doc Text
result <- if Text
identifier forall a. Eq a => a -> a -> Bool
== Text
"refs" Bool -> Bool -> Bool
|| -- <- for backwards compatibility
               Text
"csl-bib-body" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
               then 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 }
                 Doc Text
inner <- forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
bs
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Text
"hanging-indent" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes
                               then Doc Text
"\\setlength{\\cslhangindent}{0em}"
                               else forall a. Monoid a => a
mempty)
                          forall a. Doc a -> Doc a -> Doc a
$$ (Doc Text
"\\setlength{\\cslentryspacing}" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces
                               (case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"entry-spacing" [(Text, Text)]
kvs of
                                  Maybe Text
Nothing -> Doc Text
"0em"
                                  Just Text
s  -> (forall a. HasChars a => a -> Doc a
literal Text
s forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\baselineskip")))
                          forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\begin{CSLReferences}"
                          forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
inner
                          forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
"\\end{CSLReferences}"
               else forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
bs
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stIncremental :: Bool
stIncremental = Bool
oldIncremental }
  let wrap :: Doc Text -> StateT WriterState m (Doc Text)
wrap Doc Text
txt
       | Bool
beamer Bool -> Bool -> Bool
&& Text
"notes" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
         = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
"\\note" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
txt) -- speaker notes
       | Text
"ref-" Text -> Text -> Bool
`T.isPrefixOf` Text
identifier
         = do
             Text
lab <- forall (m :: * -> *). PandocMonad m => Text -> LW m Text
toLabel Text
identifier
             forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Doc Text
"\\bibitem" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
"\\citeproctext"
                      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
lab)) forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
txt
         | Bool
otherwise = do
             Doc Text
linkAnchor <- forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
hypertarget Text
identifier
             forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Doc Text
linkAnchor forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
txt
  forall (m :: * -> *).
PandocMonad m =>
(Text, [Text], [(Text, Text)]) -> Doc Text -> LW m (Doc Text)
wrapDiv (Text
identifier,[Text]
classes,[(Text, Text)]
kvs) Doc Text
result forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}.
PandocMonad m =>
Doc Text -> StateT WriterState m (Doc Text)
wrap
blockToLaTeX (Plain [Inline]
lst) =
  forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
-- . . . indicates pause in beamer slides
blockToLaTeX (Para [Str Text
".",Inline
Space,Str Text
".",Inline
Space,Str Text
"."]) = do
  Bool
beamer <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  if Bool
beamer
     then forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX (Format -> Text -> Block
RawBlock Format
"latex" Text
"\\pause")
     else forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Text -> Inline
Str Text
".",Inline
Space,Text -> Inline
Str Text
".",Inline
Space,Text -> Inline
Str Text
"."]
blockToLaTeX (Para [Inline]
lst) =
  forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
blockToLaTeX (LineBlock [[Inline]]
lns) =
  forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToLaTeX (BlockQuote [Block]
lst) = do
  Bool
beamer <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  case [Block]
lst of
       [Block
b] | Bool
beamer Bool -> Bool -> Bool
&& Block -> Bool
isListBlock Block
b -> do
         Bool
oldIncremental <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIncremental
         forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stIncremental :: Bool
stIncremental = Bool -> Bool
not Bool
oldIncremental }
         Doc Text
result <- forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX Block
b
         forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stIncremental :: Bool
stIncremental = Bool
oldIncremental }
         forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
result
       [Block]
_ -> do
         Bool
oldInQuote <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInQuote
         forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{stInQuote :: Bool
stInQuote = Bool
True})
         Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
lst
         forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{stInQuote :: Bool
stInQuote = Bool
oldInQuote})
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\begin{quote}" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\end{quote}"
blockToLaTeX (CodeBlock (Text
identifier,[Text]
classes,[(Text, Text)]
keyvalAttr) Text
str) = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Bool
inNote <- WriterState -> Bool
stInNote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
  Doc Text
linkAnchor <- if Text -> Bool
T.null Text
identifier
                   then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Doc a
empty
                   else ((forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> Doc Text
"%")) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
hypertarget Text
identifier
  let lhsCodeBlock :: LW m (Doc Text)
lhsCodeBlock = do
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stLHS :: Bool
stLHS = Bool
True }
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a -> Doc a
flush (Doc Text
linkAnchor forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\begin{code}" forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
str forall a. Doc a -> Doc a -> Doc a
$$
                            Doc Text
"\\end{code}") forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
cr
  let rawCodeBlock :: LW m (Doc Text)
rawCodeBlock = do
        Text
env <- if Bool
inNote
                  then forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{ stVerbInNote :: Bool
stVerbInNote = Bool
True }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       forall (m :: * -> *) a. Monad m => a -> m a
return Text
"Verbatim"
                  else forall (m :: * -> *) a. Monad m => a -> m a
return Text
"verbatim"
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a -> Doc a
flush (Doc Text
linkAnchor forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal (Text
"\\begin{" forall a. Semigroup a => a -> a -> a
<> Text
env forall a. Semigroup a => a -> a -> a
<> Text
"}") forall a. Doc a -> Doc a -> Doc a
$$
                 forall a. HasChars a => a -> Doc a
literal Text
str forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal (Text
"\\end{" forall a. Semigroup a => a -> a -> a
<> Text
env forall a. Semigroup a => a -> a -> a
<> Text
"}")) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr
  let listingsCodeBlock :: LW m (Doc Text)
listingsCodeBlock = do
        WriterState
st <- forall s (m :: * -> *). MonadState s m => m s
get
        Text
ref <- forall (m :: * -> *). PandocMonad m => Text -> LW m Text
toLabel Text
identifier
        [(Text, Text)]
kvs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Text
k,Text
v) -> (Text
k,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
TextString Text
v) [(Text, Text)]
keyvalAttr
        let params :: [Text]
params = if WriterOptions -> Bool
writerListings (WriterState -> WriterOptions
stOptions WriterState
st)
                     then (case [Text] -> Maybe Text
getListingsLanguage [Text]
classes of
                                Just Text
l  -> [ Text
"language=" forall a. Semigroup a => a -> a -> a
<> Text -> Text
mbBraced Text
l ]
                                Maybe Text
Nothing -> []) forall a. [a] -> [a] -> [a]
++
                          [ Text
"numbers=left" | Text
"numberLines" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                             Bool -> Bool -> Bool
|| Text
"number" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                             Bool -> Bool -> Bool
|| Text
"number-lines" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes ] forall a. [a] -> [a] -> [a]
++
                          [ (if Text
key forall a. Eq a => a -> a -> Bool
== Text
"startFrom"
                                then Text
"firstnumber"
                                else Text
key) forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> Text -> Text
mbBraced Text
attr |
                                (Text
key,Text
attr) <- [(Text, Text)]
kvs,
                                Text
key forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"exports", Text
"tangle", Text
"results"]
                                -- see #4889
                          ] forall a. [a] -> [a] -> [a]
++
                          [Text
"label=" forall a. Semigroup a => a -> a -> a
<> Text
ref | Bool -> Bool
not (Text -> Bool
T.null Text
identifier)]

                     else []
            printParams :: Doc Text
printParams
                | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
params = forall a. Doc a
empty
                | Bool
otherwise   = 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
", "
                      (forall a b. (a -> b) -> [a] -> [b]
map forall a. HasChars a => a -> Doc a
literal [Text]
params))
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a -> Doc a
flush (Doc Text
"\\begin{lstlisting}" forall a. Semigroup a => a -> a -> a
<> Doc Text
printParams forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
str forall a. Doc a -> Doc a -> Doc a
$$
                 Doc Text
"\\end{lstlisting}") forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
cr
  let highlightedCodeBlock :: LW m (Doc Text)
highlightedCodeBlock =
        case forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> (Text, [Text], [(Text, Text)])
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts)
                 FormatOptions -> [SourceLine] -> Text
formatLaTeXBlock (Text
"",[Text]
classes forall a. [a] -> [a] -> [a]
++ [Text
"default"],[(Text, Text)]
keyvalAttr) 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 forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
                 LW m (Doc Text)
rawCodeBlock
               Right Text
h -> do
                  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
inNote forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{ stVerbInNote :: Bool
stVerbInNote = Bool
True })
                  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. Doc a -> Doc a
flush forall a b. (a -> b) -> a -> b
$ Doc Text
linkAnchor forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => String -> Doc a
text (Text -> String
T.unpack Text
h))
  case () of
     ()
_ | forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts Bool -> Bool -> Bool
&& Text
"haskell" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&&
         Text
"literate" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes           -> LW m (Doc Text)
lhsCodeBlock
       | WriterOptions -> Bool
writerListings WriterOptions
opts                 -> LW m (Doc Text)
listingsCodeBlock
       | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes) Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts)
                                             -> LW m (Doc Text)
highlightedCodeBlock
       -- we don't want to use \begin{verbatim} if our code
       -- contains \end{verbatim}:
       | Bool
inNote
       , Text
"\\end{Verbatim}" Text -> Text -> Bool
`T.isInfixOf` Text
str -> LW m (Doc Text)
highlightedCodeBlock
       | Bool -> Bool
not Bool
inNote
       , Text
"\\end{verbatim}" Text -> Text -> Bool
`T.isInfixOf` Text
str -> LW m (Doc Text)
highlightedCodeBlock
       | Bool
otherwise                           -> LW m (Doc Text)
rawCodeBlock
blockToLaTeX b :: Block
b@(RawBlock Format
f Text
x) = do
  Bool
beamer <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  if Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" Bool -> Bool -> Bool
|| 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
"beamer" Bool -> Bool -> Bool
&& Bool
beamer)
     then 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
x
     else do
       forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToLaTeX (BulletList []) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty  -- otherwise latex error
blockToLaTeX (BulletList [[Block]]
lst) = do
  Bool
incremental <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIncremental
  Bool
isFirstInDefinition <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIsFirstInDefinition
  Bool
beamer <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  let inc :: String
inc = if Bool
beamer Bool -> Bool -> Bool
&& Bool
incremental then String
"[<+->]" else String
""
  [Doc Text]
items <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
listItemToLaTeX [[Block]]
lst
  let spacing :: Doc Text
spacing = if [[Block]] -> Bool
isTightList [[Block]]
lst
                   then forall a. HasChars a => String -> Doc a
text String
"\\tightlist"
                   else forall a. Doc a
empty
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text (String
"\\begin{itemize}" forall a. Semigroup a => a -> a -> a
<> String
inc) forall a. Doc a -> Doc a -> Doc a
$$
             Doc Text
spacing forall a. Doc a -> Doc a -> Doc a
$$
             -- force list at beginning of definition to start on new line
             (if Bool
isFirstInDefinition then Doc Text
"\\item[]" else forall a. Monoid a => a
mempty) forall a. Doc a -> Doc a -> Doc a
$$
             forall a. [Doc a] -> Doc a
vcat [Doc Text]
items forall a. Doc a -> Doc a -> Doc a
$$
             Doc Text
"\\end{itemize}"
blockToLaTeX (OrderedList ListAttributes
_ []) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty -- otherwise latex error
blockToLaTeX (OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
numdelim) [[Block]]
lst) = do
  WriterState
st <- forall s (m :: * -> *). MonadState s m => m s
get
  let inc :: String
inc = if WriterState -> Bool
stBeamer WriterState
st Bool -> Bool -> Bool
&& WriterState -> Bool
stIncremental WriterState
st then String
"[<+->]" else String
""
  let oldlevel :: Int
oldlevel = WriterState -> Int
stOLLevel WriterState
st
  Bool
isFirstInDefinition <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIsFirstInDefinition
  forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ WriterState
st {stOLLevel :: Int
stOLLevel = Int
oldlevel forall a. Num a => a -> a -> a
+ Int
1}
  [Doc Text]
items <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
listItemToLaTeX [[Block]]
lst
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s {stOLLevel :: Int
stOLLevel = Int
oldlevel})
  let beamer :: Bool
beamer = WriterState -> Bool
stBeamer WriterState
st
  let tostyle :: Doc a -> Doc a
tostyle Doc a
x = case ListNumberStyle
numstyle of
                       ListNumberStyle
Decimal      -> Doc a
"\\arabic" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
UpperRoman   -> Doc a
"\\Roman" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
LowerRoman   -> Doc a
"\\roman" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
UpperAlpha   -> Doc a
"\\Alph" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
LowerAlpha   -> Doc a
"\\alph" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
Example      -> Doc a
"\\arabic" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
DefaultStyle -> Doc a
"\\arabic" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
  let todelim :: Doc a -> Doc a
todelim Doc a
x = case ListNumberDelim
numdelim of
                       ListNumberDelim
OneParen  -> Doc a
x forall a. Semigroup a => a -> a -> a
<> Doc a
")"
                       ListNumberDelim
TwoParens -> forall a. HasChars a => Doc a -> Doc a
parens Doc a
x
                       ListNumberDelim
Period    -> Doc a
x forall a. Semigroup a => a -> a -> a
<> Doc a
"."
                       ListNumberDelim
_         -> Doc a
x forall a. Semigroup a => a -> a -> a
<> Doc a
"."
  let exemplar :: Doc Text
exemplar = case ListNumberStyle
numstyle of
                       ListNumberStyle
Decimal      -> Doc Text
"1"
                       ListNumberStyle
UpperRoman   -> Doc Text
"I"
                       ListNumberStyle
LowerRoman   -> Doc Text
"i"
                       ListNumberStyle
UpperAlpha   -> Doc Text
"A"
                       ListNumberStyle
LowerAlpha   -> Doc Text
"a"
                       ListNumberStyle
Example      -> Doc Text
"1"
                       ListNumberStyle
DefaultStyle -> Doc Text
"1"
  let enum :: Doc Text
enum = forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text
"enum" forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.toLower (Int -> Text
toRomanNumeral Int
oldlevel)
  let stylecommand :: Doc Text
stylecommand
        | ListNumberStyle
numstyle forall a. Eq a => a -> a -> Bool
== ListNumberStyle
DefaultStyle Bool -> Bool -> Bool
&& ListNumberDelim
numdelim forall a. Eq a => a -> a -> Bool
== ListNumberDelim
DefaultDelim = forall a. Doc a
empty
        | Bool
beamer Bool -> Bool -> Bool
&& ListNumberStyle
numstyle forall a. Eq a => a -> a -> Bool
== ListNumberStyle
Decimal Bool -> Bool -> Bool
&& ListNumberDelim
numdelim forall a. Eq a => a -> a -> Bool
== ListNumberDelim
Period = forall a. Doc a
empty
        | Bool
beamer = forall a. HasChars a => Doc a -> Doc a
brackets (forall a. HasChars a => Doc a -> Doc a
todelim Doc Text
exemplar)
        | Bool
otherwise = Doc Text
"\\def" forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\label" forall a. Semigroup a => a -> a -> a
<> Doc Text
enum forall a. Semigroup a => a -> a -> a
<>
          forall a. HasChars a => Doc a -> Doc a
braces (forall a. HasChars a => Doc a -> Doc a
todelim forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Doc a -> Doc a
tostyle Doc Text
enum)
  let resetcounter :: Doc Text
resetcounter = if Int
start forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
oldlevel forall a. Ord a => a -> a -> Bool
> Int
4
                        then forall a. Doc a
empty
                        else Doc Text
"\\setcounter" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
enum forall a. Semigroup a => a -> a -> a
<>
                              forall a. HasChars a => Doc a -> Doc a
braces (forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
start forall a. Num a => a -> a -> a
- Int
1)
  let spacing :: Doc Text
spacing = if [[Block]] -> Bool
isTightList [[Block]]
lst
                   then forall a. HasChars a => String -> Doc a
text String
"\\tightlist"
                   else forall a. Doc a
empty
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text (String
"\\begin{enumerate}" forall a. Semigroup a => a -> a -> a
<> String
inc)
         forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
stylecommand
         forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
resetcounter
         forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
spacing
         -- force list at beginning of definition to start on new line
         forall a. Doc a -> Doc a -> Doc a
$$ (if Bool
isFirstInDefinition then Doc Text
"\\item[]" else forall a. Monoid a => a
mempty)
         forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
vcat [Doc Text]
items
         forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\end{enumerate}"
blockToLaTeX (DefinitionList []) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToLaTeX (DefinitionList [([Inline], [[Block]])]
lst) = do
  Bool
incremental <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIncremental
  Bool
beamer <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  let inc :: String
inc = if Bool
beamer Bool -> Bool -> Bool
&& Bool
incremental then String
"[<+->]" else String
""
  [Doc Text]
items <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> LW m (Doc Text)
defListItemToLaTeX [([Inline], [[Block]])]
lst
  let spacing :: Doc Text
spacing = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([[Block]] -> Bool
isTightList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [([Inline], [[Block]])]
lst
                   then forall a. HasChars a => String -> Doc a
text String
"\\tightlist"
                   else forall a. Doc a
empty
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text (String
"\\begin{description}" forall a. Semigroup a => a -> a -> a
<> String
inc) forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
spacing forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
vcat [Doc Text]
items forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
"\\end{description}"
blockToLaTeX Block
HorizontalRule =
            forall (m :: * -> *) a. Monad m => a -> m a
return
  Doc Text
"\\begin{center}\\rule{0.5\\linewidth}{0.5pt}\\end{center}"
blockToLaTeX (Header Int
level (Text
id',[Text]
classes,[(Text, Text)]
_) [Inline]
lst) = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInHeading :: Bool
stInHeading = Bool
True}
  Doc Text
hdr <- forall (m :: * -> *).
PandocMonad m =>
[Text] -> Text -> Int -> [Inline] -> LW m (Doc Text)
sectionHeader [Text]
classes Text
id' Int
level [Inline]
lst
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInHeading :: Bool
stInHeading = Bool
False}
  forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
hdr
blockToLaTeX (Table (Text, [Text], [(Text, Text)])
attr Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbodies TableFoot
tfoot) =
  forall (m :: * -> *).
PandocMonad m =>
([Inline] -> LW m (Doc Text))
-> ([Block] -> LW m (Doc Text)) -> Table -> LW m (Doc Text)
tableToLaTeX forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX
               ((Text, [Text], [(Text, Text)])
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Ann.toTable (Text, [Text], [(Text, Text)])
attr Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbodies TableFoot
tfoot)
blockToLaTeX (Figure (Text
ident, [Text]
_, [(Text, Text)]
_) Caption
captnode [Block]
body) = do
  (Doc Text
capt, Doc Text
captForLof, Doc Text
footnotes) <- forall (m :: * -> *).
PandocMonad m =>
([Inline] -> LW m (Doc Text))
-> Bool -> Caption -> LW m (Doc Text, Doc Text, Doc Text)
getCaption forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX Bool
True Caption
captnode
  Doc Text
lab <- forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
labelFor Text
ident
  let caption :: Doc Text
caption = Doc Text
"\\caption" forall a. Semigroup a => a -> a -> a
<> Doc Text
captForLof forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
capt forall a. Semigroup a => a -> a -> a
<> Doc Text
lab

  Bool
isSubfigure <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInFigure
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stInFigure :: Bool
stInFigure = Bool
True }
  Doc Text
contents <- case [Block]
body of
    [Block
b] -> forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX Block
b
    [Block]
bs  -> forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\hfill") 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 =>
Int -> Block -> LW m (Doc Text)
toSubfigure (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Block]
bs)) [Block]
bs
  Doc Text
target <- forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
hypertarget Text
ident
  let innards :: Doc Text
innards = Doc Text
target forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\centering" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st ->
    WriterState
st{ stInFigure :: Bool
stInFigure = Bool
isSubfigure
      , stSubfigure :: Bool
stSubfigure = WriterState -> Bool
stSubfigure WriterState
st Bool -> Bool -> Bool
|| Bool
isSubfigure
      }

  let containsTable :: [Block] -> Bool
containsTable = Any -> Bool
getAny forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query forall a b. (a -> b) -> a -> b
$ \case
        Table {}  -> Bool -> Any
Any Bool
True
        Block
_         -> Bool -> Any
Any Bool
False)
  WriterState
st <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (case () of
    ()
_ | [Block] -> Bool
containsTable [Block]
body ->
          -- placing a longtable in a figure or center environment does
          -- not make sense.
          forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
    ()
_ | WriterState -> Bool
stInMinipage WriterState
st ->
          -- can't have figures in notes or minipage (here, table cell)
          -- http://www.tex.ac.uk/FAQ-ouparmd.html
          forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\begin{center}" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
capt forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\end{center}"
    ()
_ | Bool
isSubfigure ->
          Doc Text
innards
    ()
_ ->  forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\begin{figure}" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
innards forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\end{figure}")
    forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
footnotes

toSubfigure :: PandocMonad m => Int -> Block -> LW m (Doc Text)
toSubfigure :: forall (m :: * -> *).
PandocMonad m =>
Int -> Block -> LW m (Doc Text)
toSubfigure Int
nsubfigs Block
blk = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX Block
blk
  let linewidth :: Text
linewidth = forall a. Show a => a -> Text
tshow @Double (Double
0.9 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nsubfigs) forall a. Semigroup a => a -> a -> a
<> Text
"\\linewidth"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> case Block
blk of
    Figure {}    -> forall a. [Doc a] -> Doc a
vcat
                    [ Doc Text
"\\begin{subfigure}[t]" 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
linewidth)
                    , Doc Text
contents
                    , Doc Text
"\\end{subfigure}"
                    ]
    Block
_            -> forall a. [Doc a] -> Doc a
vcat
                    [ Doc Text
"\\begin{minipage}[t]" 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
linewidth)
                    , Doc Text
contents
                    , Doc Text
"\\end{minipage}"
                    ]

blockListToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX :: forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
lst =
  forall a. [Doc a] -> Doc a
vsep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Block
b -> forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX Block
b) [Block]
lst

listItemToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text)
listItemToLaTeX :: forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
listItemToLaTeX [Block]
lst
  -- we need to put some text before a header if it's the first
  -- element in an item. This will look ugly in LaTeX regardless, but
  -- this will keep the typesetter from throwing an error.
  | (Header{} :[Block]
_) <- [Block]
lst =
    (forall a. HasChars a => String -> Doc a
text String
"\\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] -> LW m (Doc Text)
blockListToLaTeX [Block]
lst
  | Plain (Str Text
"☐":Inline
Space:[Inline]
is) : [Block]
bs <- [Block]
lst = forall {m :: * -> *}.
PandocMonad m =>
Bool -> [Inline] -> [Block] -> StateT WriterState m (Doc Text)
taskListItem Bool
False [Inline]
is [Block]
bs
  | Plain (Str Text
"☒":Inline
Space:[Inline]
is) : [Block]
bs <- [Block]
lst = forall {m :: * -> *}.
PandocMonad m =>
Bool -> [Inline] -> [Block] -> StateT WriterState m (Doc Text)
taskListItem Bool
True  [Inline]
is [Block]
bs
  | Para  (Str Text
"☐":Inline
Space:[Inline]
is) : [Block]
bs <- [Block]
lst = forall {m :: * -> *}.
PandocMonad m =>
Bool -> [Inline] -> [Block] -> StateT WriterState m (Doc Text)
taskListItem Bool
False [Inline]
is [Block]
bs
  | Para  (Str Text
"☒":Inline
Space:[Inline]
is) : [Block]
bs <- [Block]
lst = forall {m :: * -> *}.
PandocMonad m =>
Bool -> [Inline] -> [Block] -> StateT WriterState m (Doc Text)
taskListItem Bool
True  [Inline]
is [Block]
bs
  | Bool
otherwise = (forall a. HasChars a => String -> Doc a
text String
"\\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] -> LW m (Doc Text)
blockListToLaTeX [Block]
lst
  where
    taskListItem :: Bool -> [Inline] -> [Block] -> StateT WriterState m (Doc Text)
taskListItem Bool
checked [Inline]
is [Block]
bs = do
      let checkbox :: Doc Text
checkbox  = if Bool
checked
                      then Doc Text
"$\\boxtimes$"
                      else Doc Text
"$\\square$"
      Doc Text
isContents <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
is
      Doc Text
bsContents <- forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
bs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\item" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
checkbox
        forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc Text
isContents forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
bsContents)

defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m (Doc Text)
defListItemToLaTeX :: forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> LW m (Doc Text)
defListItemToLaTeX ([Inline]
term, [[Block]]
defs) = do
    -- needed to turn off 'listings' because it breaks inside \item[...]:
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInItem :: Bool
stInItem = Bool
True}
    Doc Text
term' <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
term
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInItem :: Bool
stInItem = Bool
False}
    -- put braces around term if it contains an internal link,
    -- since otherwise we get bad bracket interactions: \item[\hyperref[..]
    let isInternalLink :: Inline -> Bool
isInternalLink (Link (Text, [Text], [(Text, Text)])
_ [Inline]
_ (Text
src,Text
_))
          | Just (Char
'#', Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
src = Bool
True
        isInternalLink Inline
_                  = Bool
False
    let term'' :: Doc Text
term'' = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Inline -> Bool
isInternalLink [Inline]
term
                    then forall a. HasChars a => Doc a -> Doc a
braces Doc Text
term'
                    else Doc Text
term'
    Doc Text
def'  <- case forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Block]]
defs of
               [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
               (Block
x:[Block]
xs) -> do
                 forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stIsFirstInDefinition :: Bool
stIsFirstInDefinition = Bool
True }
                 Doc Text
firstitem <- forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX Block
x
                 forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stIsFirstInDefinition :: Bool
stIsFirstInDefinition = Bool
False }
                 Doc Text
rest <- forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
xs
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
firstitem forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
rest
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case [[Block]]
defs of
     ((Header{} : [Block]
_) : [[Block]]
_)    ->
       Doc Text
"\\item" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
term'' forall a. Semigroup a => a -> a -> a
<> Doc Text
" ~ " forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
def'
     ((CodeBlock{} : [Block]
_) : [[Block]]
_) -> -- see #4662
       Doc Text
"\\item" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
term'' forall a. Semigroup a => a -> a -> a
<> Doc Text
" ~ " forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
def'
     [[Block]]
_                       ->
       Doc Text
"\\item" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
term'' forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
def'

-- | Craft the section header, inserting the section reference, if supplied.
sectionHeader :: PandocMonad m
              => [Text]  -- classes
              -> Text
              -> Int
              -> [Inline]
              -> LW m (Doc Text)
sectionHeader :: forall (m :: * -> *).
PandocMonad m =>
[Text] -> Text -> Int -> [Inline] -> LW m (Doc Text)
sectionHeader [Text]
classes Text
ident Int
level [Inline]
lst = do
  let unnumbered :: Bool
unnumbered = Text
"unnumbered" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  let unlisted :: Bool
unlisted = Text
"unlisted" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  Doc Text
txt <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
  Text
plain <- forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
TextString forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Walkable Inline a => a -> Text
stringify [Inline]
lst
  let removeInvalidInline :: Inline -> [Inline]
removeInvalidInline (Note [Block]
_)             = []
      removeInvalidInline (Span (Text
id', [Text]
_, [(Text, Text)]
_) [Inline]
_) | Bool -> Bool
not (Text -> Bool
T.null Text
id') = []
      removeInvalidInline Image{}            = []
      removeInvalidInline Inline
x                    = [Inline
x]
  let lstNoNotes :: [Inline]
lstNoNotes = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Inline
x -> forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Inline -> [Inline]
removeInvalidInline Inline
x)) forall a. Monoid a => a
mempty [Inline]
lst
  Doc Text
txtNoNotes <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lstNoNotes
  -- footnotes in sections don't work (except for starred variants)
  -- unless you specify an optional argument:
  -- \section[mysec]{mysec\footnote{blah}}
  Doc Text
optional <- if Bool
unnumbered Bool -> Bool -> Bool
|| [Inline]
lstNoNotes forall a. Eq a => a -> a -> Bool
== [Inline]
lst Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lstNoNotes
                 then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
                 else
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
txtNoNotes
  let contents :: Doc Text
contents = if forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing Doc Text
txt forall a. Eq a => a -> a -> Bool
== Text
plain
                    then forall a. HasChars a => Doc a -> Doc a
braces Doc Text
txt
                    else forall a. HasChars a => Doc a -> Doc a
braces (forall a. HasChars a => String -> Doc a
text String
"\\texorpdfstring"
                         forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
txt
                         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
plain))
  Bool
book <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHasChapters
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let topLevelDivision :: TopLevelDivision
topLevelDivision = if Bool
book Bool -> Bool -> Bool
&& WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts forall a. Eq a => a -> a -> Bool
== TopLevelDivision
TopLevelDefault
                         then TopLevelDivision
TopLevelChapter
                         else WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts
  Bool
beamer <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  let level' :: Int
level' = if Bool
beamer Bool -> Bool -> Bool
&&
                  TopLevelDivision
topLevelDivision forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TopLevelDivision
TopLevelPart, TopLevelDivision
TopLevelChapter]
               -- beamer has parts but no chapters
               then if Int
level forall a. Eq a => a -> a -> Bool
== Int
1 then -Int
1 else Int
level forall a. Num a => a -> a -> a
- Int
1
               else case TopLevelDivision
topLevelDivision of
                      TopLevelDivision
TopLevelPart    -> Int
level forall a. Num a => a -> a -> a
- Int
2
                      TopLevelDivision
TopLevelChapter -> Int
level forall a. Num a => a -> a -> a
- Int
1
                      TopLevelDivision
TopLevelSection -> Int
level
                      TopLevelDivision
TopLevelDefault -> Int
level
  let sectionType :: String
sectionType = case Int
level' of
                          -1 -> String
"part"
                          Int
0  -> String
"chapter"
                          Int
1  -> String
"section"
                          Int
2  -> String
"subsection"
                          Int
3  -> String
"subsubsection"
                          Int
4  -> String
"paragraph"
                          Int
5  -> String
"subparagraph"
                          Int
_  -> String
""
  Bool
inQuote <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInQuote
  let prefix :: Doc Text
prefix = if Bool
inQuote Bool -> Bool -> Bool
&& Int
level' forall a. Ord a => a -> a -> Bool
>= Int
4
                  then forall a. HasChars a => String -> Doc a
text String
"\\mbox{}%"
                  -- needed for \paragraph, \subparagraph in quote environment
                  -- see http://tex.stackexchange.com/questions/169830/
                  else forall a. Doc a
empty
  Doc Text
lab <- forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
labelFor Text
ident
  let star :: Doc Text
star = if Bool
unnumbered then forall a. HasChars a => String -> Doc a
text String
"*" else forall a. Doc a
empty
  let title :: Doc Text
title = Doc Text
star forall a. Semigroup a => a -> a -> a
<> Doc Text
optional forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Int
level' forall a. Ord a => a -> a -> Bool
> Int
5
              then Doc Text
txt
              else Doc Text
prefix
                   forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => String -> Doc a
text (Char
'\\'forall a. a -> [a] -> [a]
:String
sectionType) forall a. Semigroup a => a -> a -> a
<> Doc Text
title forall a. Semigroup a => a -> a -> a
<> Doc Text
lab
                   forall a. Doc a -> Doc a -> Doc a
$$ if Bool
unnumbered Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
unlisted
                         then Doc Text
"\\addcontentsline{toc}" forall a. Semigroup a => a -> a -> a
<>
                                forall a. HasChars a => Doc a -> Doc a
braces (forall a. HasChars a => String -> Doc a
text String
sectionType) forall a. Semigroup a => a -> a -> a
<>
                                forall a. HasChars a => Doc a -> Doc a
braces Doc Text
txtNoNotes
                         else forall a. Doc a
empty

-- | Convert list of inline elements to LaTeX.
inlineListToLaTeX :: PandocMonad m
                  => [Inline]  -- ^ Inlines to convert
                  -> LW m (Doc Text)
inlineListToLaTeX :: forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst = forall a. [Doc a] -> Doc a
hcat 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 => Inline -> LW m (Doc Text)
inlineToLaTeX ([Inline] -> [Inline]
fixLineInitialSpaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
fixInitialLineBreaks forall a b. (a -> b) -> a -> b
$ [Inline]
lst)
    -- nonbreaking spaces (~) in LaTeX don't work after line breaks,
    -- so we turn nbsps after hard breaks to \hspace commands.
    -- this is mostly used in verse.
 where fixLineInitialSpaces :: [Inline] -> [Inline]
fixLineInitialSpaces [] = []
       fixLineInitialSpaces (Inline
LineBreak : Str Text
s : [Inline]
xs)
         | Just (Char
'\160', Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
s
         = Inline
LineBreak forall a. a -> [a] -> [a]
: Text -> [Inline]
fixNbsps Text
s forall a. Semigroup a => a -> a -> a
<> [Inline] -> [Inline]
fixLineInitialSpaces [Inline]
xs
       fixLineInitialSpaces (Inline
x:[Inline]
xs) = Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixLineInitialSpaces [Inline]
xs
       fixNbsps :: Text -> [Inline]
fixNbsps Text
s = let (Text
ys,Text
zs) = (Char -> Bool) -> Text -> (Text, Text)
T.span (forall a. Eq a => a -> a -> Bool
==Char
'\160') Text
s
                    in  forall a. Int -> a -> [a]
replicate (Text -> Int
T.length Text
ys) Inline
hspace forall a. Semigroup a => a -> a -> a
<> [Text -> Inline
Str Text
zs]
       hspace :: Inline
hspace = Format -> Text -> Inline
RawInline Format
"latex" Text
"\\hspace*{0.333em}"
       -- We need \hfill\break for a line break at the start
       -- of a paragraph. See #5591.
       fixInitialLineBreaks :: [Inline] -> [Inline]
fixInitialLineBreaks (Inline
LineBreak:[Inline]
xs) =
         Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex") Text
"\\hfill\\break\n" forall a. a -> [a] -> [a]
:
           [Inline] -> [Inline]
fixInitialLineBreaks [Inline]
xs
       fixInitialLineBreaks [Inline]
xs = [Inline]
xs

-- | Convert inline element to LaTeX
inlineToLaTeX :: PandocMonad m
              => Inline    -- ^ Inline to convert
              -> LW m (Doc Text)
inlineToLaTeX :: forall (m :: * -> *). PandocMonad m => Inline -> LW m (Doc Text)
inlineToLaTeX (Span (Text
"",[Text
"mark"],[]) [Inline]
lst) = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stStrikeout :: Bool
stStrikeout = Bool
True } -- this gives us the soul package
  Text -> Doc Text -> Doc Text
inCmd Text
"hl" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (Span (Text
id',[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils) = do
  Doc Text
linkAnchor <- forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
hypertarget Text
id'
  Maybe Lang
lang <- forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs
  let classToCmd :: a -> Maybe a
classToCmd a
"csl-no-emph" = forall a. a -> Maybe a
Just a
"textup"
      classToCmd a
"csl-no-strong" = forall a. a -> Maybe a
Just a
"textnormal"
      classToCmd a
"csl-no-smallcaps" = forall a. a -> Maybe a
Just a
"textnormal"
      classToCmd a
"csl-block" = forall a. a -> Maybe a
Just a
"CSLBlock"
      classToCmd a
"csl-left-margin" = forall a. a -> Maybe a
Just a
"CSLLeftMargin"
      classToCmd a
"csl-right-inline" = forall a. a -> Maybe a
Just a
"CSLRightInline"
      classToCmd a
"csl-indent" = forall a. a -> Maybe a
Just a
"CSLIndent"
      classToCmd a
_ = forall a. Maybe a
Nothing
      kvToCmd :: (a, a) -> Maybe a
kvToCmd (a
"dir",a
"rtl") = forall a. a -> Maybe a
Just a
"RL"
      kvToCmd (a
"dir",a
"ltr") = forall a. a -> Maybe a
Just a
"LR"
      kvToCmd (a, a)
_ = forall a. Maybe a
Nothing
      langCmds :: [Text]
langCmds =
        case Maybe Lang
lang forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Lang -> Maybe Text
toBabel of
           Just Text
l  -> [Text
"foreignlanguage{" forall a. Semigroup a => a -> a -> a
<> Text
l forall a. Semigroup a => a -> a -> a
<> Text
"}"]
           Maybe Text
Nothing -> []
  let cmds :: [Text]
cmds = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {a}. (Eq a, IsString a, IsString a) => a -> Maybe a
classToCmd [Text]
classes forall a. [a] -> [a] -> [a]
++ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {a} {a}.
(Eq a, Eq a, IsString a, IsString a, IsString a) =>
(a, a) -> Maybe a
kvToCmd [(Text, Text)]
kvs forall a. [a] -> [a] -> [a]
++ [Text]
langCmds
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
ils
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    (if Text
"csl-right-inline" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
        then (Doc Text
"%" forall a. Semigroup a => a -> a -> a
<>) -- see #7932
        else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
    (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes)
            [Text
"csl-block",Text
"csl-left-margin",Text
"csl-right-inline",Text
"csl-indent"]
        then (forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<>)
        else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
    (if Text -> Bool
T.null Text
id'
        then forall a. Doc a
empty
        else Doc Text
linkAnchor) forall a. Semigroup a => a -> a -> a
<>
    (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cmds
        then forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
        else forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Doc Text -> Doc Text
inCmd Doc Text
contents [Text]
cmds)
inlineToLaTeX (Emph [Inline]
lst) = Text -> Doc Text -> Doc Text
inCmd Text
"emph" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (Underline [Inline]
lst) = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stStrikeout :: Bool
stStrikeout = Bool
True } -- this gives us the soul package
  Text -> Doc Text -> Doc Text
inCmd Text
"ul" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (Strong [Inline]
lst) = Text -> Doc Text -> Doc Text
inCmd Text
"textbf" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (Strikeout [Inline]
lst) = do
  -- we need to protect VERB in an mbox or we get an error
  -- see #1294
  -- with regular texttt we don't get an error, but we get
  -- incorrect results if there is a space, see #5529
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX forall a b. (a -> b) -> a -> b
$ forall a b. Walkable a b => (a -> a) -> b -> b
walk (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
protectCode) [Inline]
lst
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stStrikeout :: Bool
stStrikeout = Bool
True }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
inCmd Text
"st" Doc Text
contents
inlineToLaTeX (Superscript [Inline]
lst) =
  Text -> Doc Text -> Doc Text
inCmd Text
"textsuperscript" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (Subscript [Inline]
lst) =
  Text -> Doc Text -> Doc Text
inCmd Text
"textsubscript" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (SmallCaps [Inline]
lst) =
  Text -> Doc Text -> Doc Text
inCmd Text
"textsc"forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (Cite [Citation]
cits [Inline]
lst) = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stInCite :: Bool
stInCite = Bool
True }
  Doc Text
res <- case WriterOptions -> CiteMethod
writerCiteMethod WriterOptions
opts of
           CiteMethod
Natbib   -> forall (m :: * -> *).
PandocMonad m =>
([Inline] -> LW m (Doc Text)) -> [Citation] -> LW m (Doc Text)
citationsToNatbib forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Citation]
cits
           CiteMethod
Biblatex -> forall (m :: * -> *).
PandocMonad m =>
([Inline] -> LW m (Doc Text)) -> [Citation] -> LW m (Doc Text)
citationsToBiblatex forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Citation]
cits
           CiteMethod
_        -> forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stInCite :: Bool
stInCite = Bool
False }
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
res

inlineToLaTeX (Code (Text
_,[Text]
classes,[(Text, Text)]
kvs) Text
str) = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Bool
inHeading <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInHeading
  Bool
inItem <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInItem
  let listingsCode :: LW m (Doc Text)
listingsCode = do
        let listingsopts :: [(Text, Text)]
listingsopts = (case [Text] -> Maybe Text
getListingsLanguage [Text]
classes of
                                Just Text
l  -> ((Text
"language", Text -> Text
mbBraced Text
l)forall a. a -> [a] -> [a]
:)
                                Maybe Text
Nothing -> forall a. a -> a
id)
                           [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs
                                  , Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"exports",Text
"tangle",Text
"results"]]
        let listingsopt :: Text
listingsopt = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
listingsopts
                             then Text
""
                             else Text
"[" forall a. Semigroup a => a -> a -> a
<>
                                  Text -> [Text] -> Text
T.intercalate Text
", "
                                  (forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Text
v) -> Text
k forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> Text
v)
                                   [(Text, Text)]
listingsopts) forall a. Semigroup a => a -> a -> a
<> Text
"]"
        Bool
inNote <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInNote
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
inNote forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stVerbInNote :: Bool
stVerbInNote = Bool
True }
        let chr :: Char
chr = case String
"!\"'()*,-./:;?@" forall a. Eq a => [a] -> [a] -> [a]
\\ Text -> String
T.unpack Text
str of
                       (Char
c:String
_) -> Char
c
                       []    -> Char
'!'
        let isEscapable :: Char -> Bool
isEscapable Char
'\\' = Bool
True
            isEscapable Char
'{'  = Bool
True
            isEscapable Char
'}'  = Bool
True
            isEscapable Char
'%'  = Bool
True
            isEscapable Char
'~'  = Bool
True
            isEscapable Char
'_'  = Bool
True
            isEscapable Char
'&'  = Bool
True
            isEscapable Char
'#'  = Bool
True
            isEscapable Char
'^'  = Bool
True
            isEscapable Char
_    = Bool
False
        let escChar :: Char -> Text
escChar Char
c | Char -> Bool
isEscapable Char
c = String -> Text
T.pack [Char
'\\',Char
c]
                      | Bool
otherwise     = Char -> Text
T.singleton Char
c
        let str' :: Text
str' = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escChar Text
str
        -- we always put lstinline in a dummy 'passthrough' command
        -- (defined in the default template) so that we don't have
        -- to change the way we escape characters depending on whether
        -- the lstinline is inside another command.  See #1629:
        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
$ Text
"\\passthrough{\\lstinline" forall a. Semigroup a => a -> a -> a
<>
                        Text
listingsopt forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
chr forall a. Semigroup a => a -> a -> a
<> Text
str' forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
chr forall a. Semigroup a => a -> a -> a
<> Text
"}"
  let rawCode :: LW m (Doc Text)
rawCode = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Text
s -> Text
"\\texttt{" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeSpaces Text
s forall a. Semigroup a => a -> a -> a
<> Text
"}"))
                 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
CodeString Text
str
                where escapeSpaces :: Text -> Text
escapeSpaces = (Char -> Text) -> Text -> Text
T.concatMap
                         (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' then Text
"\\ " else Char -> Text
T.singleton Char
c)
  let highlightCode :: LW m (Doc Text)
highlightCode =
        case forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> (Text, [Text], [(Text, Text)])
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts)
                 FormatOptions -> [SourceLine] -> Text
formatLaTeXInline (Text
"",[Text]
classes,[]) 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 forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
                 LW m (Doc Text)
rawCode
               Right Text
h -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stHighlighting :: Bool
stHighlighting = Bool
True }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. HasChars a => String -> Doc a
text (Text -> String
T.unpack Text
h))
  case () of
     ()
_ | Bool
inHeading Bool -> Bool -> Bool
|| Bool
inItem  -> LW m (Doc Text)
rawCode  -- see #5574
       | WriterOptions -> Bool
writerListings WriterOptions
opts  -> LW m (Doc Text)
listingsCode
       | forall a. Maybe a -> Bool
isJust (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes)
                              -> LW m (Doc Text)
highlightCode
       | Bool
otherwise            -> LW m (Doc Text)
rawCode
inlineToLaTeX (Quoted QuoteType
qt [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
  Bool
csquotes <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM WriterState -> Bool
stCsquotes forall s (m :: * -> *). MonadState s m => m s
get
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  if Bool
csquotes
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case QuoteType
qt of
               QuoteType
DoubleQuote -> Doc Text
"\\enquote" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
               QuoteType
SingleQuote -> Doc Text
"\\enquote*" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
     else do
       let s1 :: Doc Text
s1 = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst) Bool -> Bool -> Bool
&& Inline -> Bool
isQuoted (forall a. [a] -> a
head [Inline]
lst)
                   then Doc Text
"\\,"
                   else forall a. Doc a
empty
       let s2 :: Doc Text
s2 = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst) Bool -> Bool -> Bool
&& Inline -> Bool
isQuoted (forall a. [a] -> a
last [Inline]
lst)
                   then Doc Text
"\\,"
                   else forall a. Doc a
empty
       let inner :: Doc Text
inner = Doc Text
s1 forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
s2
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case QuoteType
qt of
                QuoteType
DoubleQuote ->
                   if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
                      then forall a. HasChars a => String -> Doc a
text String
"``" forall a. Semigroup a => a -> a -> a
<> Doc Text
inner forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => String -> Doc a
text String
"''"
                      else forall a. HasChars a => Char -> Doc a
char Char
'\x201C' forall a. Semigroup a => a -> a -> a
<> Doc Text
inner forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'\x201D'
                QuoteType
SingleQuote ->
                   if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
                      then forall a. HasChars a => Char -> Doc a
char Char
'`' forall a. Semigroup a => a -> a -> a
<> Doc Text
inner forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'\''
                      else forall a. HasChars a => Char -> Doc a
char Char
'\x2018' forall a. Semigroup a => a -> a -> a
<> Doc Text
inner forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'\x2019'
    where
      isQuoted :: Inline -> Bool
isQuoted (Span (Text, [Text], [(Text, Text)])
_ (Inline
x:[Inline]
_)) = Inline -> Bool
isQuoted Inline
x
      isQuoted (Quoted QuoteType
_ [Inline]
_)   = Bool
True
      isQuoted Inline
_              = Bool
False
inlineToLaTeX (Str Text
str) = do
  forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
  forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
TextString Text
str
inlineToLaTeX (Math MathType
InlineMath Text
str) = do
  forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
  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 -> Text
handleMathComment Text
str) forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\)"
inlineToLaTeX (Math MathType
DisplayMath Text
str) = do
  forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
  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 -> Text
handleMathComment Text
str) forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\]"
inlineToLaTeX il :: Inline
il@(RawInline Format
f Text
str) = do
  Bool
beamer <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  if Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" Bool -> Bool -> Bool
|| 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
"beamer" Bool -> Bool -> Bool
&& Bool
beamer)
     then do
       forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
       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
     else do
       forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
inlineToLaTeX Inline
LineBreak = do
  Bool
emptyLine <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stEmptyLine
  forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
True
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Bool
emptyLine then Doc Text
"\\strut " else Doc Text
"") forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\\\" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr
inlineToLaTeX 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)
  case WrapOption
wrapText of
       WrapOption
WrapAuto     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
       WrapOption
WrapNone     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
       WrapOption
WrapPreserve -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
cr
inlineToLaTeX Inline
Space = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
inlineToLaTeX (Link (Text
id',[Text]
_,[(Text, Text)]
_) [Inline]
txt (Text
src,Text
_)) =
   (case Text -> Maybe (Char, Text)
T.uncons Text
src of
     Just (Char
'#', Text
ident) -> do
        Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
txt
        Text
lab <- forall (m :: * -> *). PandocMonad m => Text -> LW m Text
toLabel Text
ident
        Bool
inCite <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInCite
        Bool
beamer <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
          if Bool
inCite Bool -> Bool -> Bool
&& Text
"#ref-" Text -> Text -> Bool
`T.isPrefixOf` Text
src
             then Doc Text
"\\citeproc" 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
lab) forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
             else if Bool
beamer
                     then Doc Text
"\\hyperlink" 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
lab) forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
                     else Doc Text
"\\hyperref" 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
lab) forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
     Maybe (Char, Text)
_ -> case [Inline]
txt of
          [Str Text
x] | String -> String
unEscapeString (Text -> String
T.unpack Text
x) forall a. Eq a => a -> a -> Bool
== String -> String
unEscapeString (Text -> String
T.unpack Text
src) ->  -- autolink
               do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stUrl :: Bool
stUrl = Bool
True }
                  Text
src' <- forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
URLString (Text -> Text
escapeURI Text
src)
                  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
$ Text
"\\url{" forall a. Semigroup a => a -> a -> a
<> Text
src' forall a. Semigroup a => a -> a -> a
<> Text
"}"
          [Str Text
x] | Just Text
rest <- Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src,
                    String -> String
unEscapeString (Text -> String
T.unpack Text
x) forall a. Eq a => a -> a -> Bool
== String -> String
unEscapeString (Text -> String
T.unpack Text
rest) -> -- email autolink
               do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stUrl :: Bool
stUrl = Bool
True }
                  Text
src' <- forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
URLString (Text -> Text
escapeURI Text
src)
                  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
txt
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\href" 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
src') forall a. Semigroup a => a -> a -> a
<>
                     forall a. HasChars a => Doc a -> Doc a
braces (Doc Text
"\\nolinkurl" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents)
          [Inline]
_ -> do Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
txt
                  Text
src' <- forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
URLString (Text -> Text
escapeURI Text
src)
                  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
"\\href{" forall a. Semigroup a => a -> a -> a
<> Text
src' forall a. Semigroup a => a -> a -> a
<> Text
"}{") forall a. Semigroup a => a -> a -> a
<>
                           Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'}')
     forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (if Text -> Bool
T.null Text
id'
             then forall (m :: * -> *) a. Monad m => a -> m a
return
             else \Doc Text
x -> do
               Doc Text
linkAnchor <- forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
hypertarget Text
id'
               forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
linkAnchor forall a. Semigroup a => a -> a -> a
<> Doc Text
x))
inlineToLaTeX il :: Inline
il@(Image (Text, [Text], [(Text, Text)])
_ [Inline]
_ (Text
src, Text
_))
  | Just Text
_ <- Text -> Text -> Maybe Text
T.stripPrefix Text
"data:" Text
src = do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
inlineToLaTeX (Image attr :: (Text, [Text], [(Text, Text)])
attr@(Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
_ (Text
source, Text
_)) = do
  forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
  let isSVG :: Bool
isSVG = Text
".svg" Text -> Text -> Bool
`T.isSuffixOf` Text
source Bool -> Bool -> Bool
|| Text
".SVG" Text -> Text -> Bool
`T.isSuffixOf` Text
source
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stGraphics :: Bool
stGraphics = Bool
True
                  , stSVG :: Bool
stSVG = WriterState -> Bool
stSVG WriterState
s Bool -> Bool -> Bool
|| Bool
isSVG }
  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 => String -> Doc a
text (forall a. Show a => a -> String
show Direction
dir) forall a. Semigroup a => a -> a -> a
<> Doc Text
"="
                    in case Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
dir (Text, [Text], [(Text, Text)])
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
<>
                             case Direction
dir of
                                Direction
Width  -> Doc Text
"\\textwidth"
                                Direction
Height -> Doc Text
"\\textheight"
                           ]
                         Just Dimension
dim         ->
                           [Doc Text
d forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => String -> Doc a
text (forall a. Show a => a -> String
show Dimension
dim)]
                         Maybe Dimension
Nothing          ->
                           case Direction
dir of
                                Direction
Width | forall a. Maybe a -> Bool
isJust (Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Height (Text, [Text], [(Text, Text)])
attr) ->
                                  [Doc Text
d forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\textwidth"]
                                Direction
Height | forall a. Maybe a -> Bool
isJust (Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Width (Text, [Text], [(Text, Text)])
attr) ->
                                  [Doc Text
d forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\textheight"]
                                Direction
_ -> []
      optList :: [Doc Text]
optList = Direction -> [Doc Text]
showDim Direction
Width forall a. Semigroup a => a -> a -> a
<> Direction -> [Doc Text]
showDim Direction
Height forall a. Semigroup a => a -> a -> a
<>
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Doc Text
"page=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
x]) (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"page" [(Text, Text)]
kvs) forall a. Semigroup a => a -> a -> a
<>
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Doc Text
"trim=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
x]) (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"trim" [(Text, Text)]
kvs) forall a. Semigroup a => a -> a -> a
<>
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. a -> b -> a
const [Doc Text
"clip"]) (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"clip" [(Text, Text)]
kvs)
      options :: Doc Text
options = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
optList
                   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]
optList)
      source' :: Text
source' = if Text -> Bool
isURI Text
source
                   then Text
source
                   else String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String -> String
unEscapeString forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
source
  Text
source'' <- forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
URLString Text
source'
  Bool
inHeading <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInHeading
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    (if Bool
inHeading then Doc Text
"\\protect" else Doc Text
"") forall a. Semigroup a => a -> a -> a
<>
      (if Bool
isSVG then Doc Text
"\\includesvg" else Doc Text
"\\includegraphics") forall a. Semigroup a => a -> a -> a
<>
    Doc Text
options 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
source'')
inlineToLaTeX (Note [Block]
contents) = do
  forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
  Bool
externalNotes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stExternalNotes
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{stInNote :: Bool
stInNote = Bool
True, stExternalNotes :: Bool
stExternalNotes = Bool
True})
  Doc Text
contents' <- forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
contents
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s {stInNote :: Bool
stInNote = Bool
False, stExternalNotes :: Bool
stExternalNotes = Bool
externalNotes})
  let optnl :: Doc a
optnl = case forall a. [a] -> [a]
reverse [Block]
contents of
                   (CodeBlock (Text, [Text], [(Text, Text)])
_ Text
_ : [Block]
_) -> forall a. Doc a
cr
                   [Block]
_                   -> forall a. Doc a
empty
  let noteContents :: Doc Text
noteContents = forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 Doc Text
contents' forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
optnl
  Bool
beamer <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  -- in beamer slides, display footnote from current overlay forward
  let beamerMark :: Doc Text
beamerMark = if Bool
beamer
                      then forall a. HasChars a => String -> Doc a
text String
"<.->"
                      else forall a. Doc a
empty
  if Bool
externalNotes
     then do
       forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stNotes :: [Doc Text]
stNotes = Doc Text
noteContents forall a. a -> [a] -> [a]
: WriterState -> [Doc Text]
stNotes WriterState
st }
       forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
"\\footnotemark{}"
       -- note: a \n before } needed when note ends with a Verbatim environment
       else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\\footnote" forall a. Semigroup a => a -> a -> a
<> Doc Text
beamerMark forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
braces Doc Text
noteContents

-- A comment at the end of math needs to be followed by a newline,
-- or the closing delimiter gets swallowed.
handleMathComment :: Text -> Text
handleMathComment :: Text -> Text
handleMathComment Text
s =
  let (Text
_, Text
ys) = (Char -> Bool) -> Text -> (Text, Text)
T.break (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'%') forall a b. (a -> b) -> a -> b
$ Text -> Text
T.reverse Text
s -- no T.breakEnd
  in  case Text -> Maybe (Char, Text)
T.uncons Text
ys of
        Just (Char
'%', Text
ys') -> case Text -> Maybe (Char, Text)
T.uncons Text
ys' of
          Just (Char
'\\', Text
_) -> Text
s
          Maybe (Char, Text)
_              -> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Maybe (Char, Text)
_                -> Text
s

protectCode :: Inline -> [Inline]
protectCode :: Inline -> [Inline]
protectCode x :: Inline
x@(Code (Text, [Text], [(Text, Text)])
_ Text
_) = [Text -> Inline
ltx Text
"\\mbox{" , Inline
x , Text -> Inline
ltx Text
"}"]
  where ltx :: Text -> Inline
ltx = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex")
protectCode Inline
x = [Inline
x]

setEmptyLine :: PandocMonad m => Bool -> LW m ()
setEmptyLine :: forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stEmptyLine :: Bool
stEmptyLine = Bool
b }

-- Extract a key from divs and spans
extract :: Text -> Block -> [Text]
extract :: Text -> Block -> [Text]
extract Text
key (Div (Text, [Text], [(Text, Text)])
attr [Block]
_)     = Text -> (Text, [Text], [(Text, Text)]) -> [Text]
lookKey Text
key (Text, [Text], [(Text, Text)])
attr
extract Text
key (Plain [Inline]
ils)      = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (Text -> Inline -> [Text]
extractInline Text
key) [Inline]
ils
extract Text
key (Para [Inline]
ils)       = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (Text -> Inline -> [Text]
extractInline Text
key) [Inline]
ils
extract Text
key (Header Int
_ (Text, [Text], [(Text, Text)])
_ [Inline]
ils) = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (Text -> Inline -> [Text]
extractInline Text
key) [Inline]
ils
extract Text
_ Block
_                  = []

-- Extract a key from spans
extractInline :: Text -> Inline -> [Text]
extractInline :: Text -> Inline -> [Text]
extractInline Text
key (Span (Text, [Text], [(Text, Text)])
attr [Inline]
_) = Text -> (Text, [Text], [(Text, Text)]) -> [Text]
lookKey Text
key (Text, [Text], [(Text, Text)])
attr
extractInline Text
_ Inline
_               = []

-- Look up a key in an attribute and give a list of its values
lookKey :: Text -> Attr -> [Text]
lookKey :: Text -> (Text, [Text], [(Text, Text)]) -> [Text]
lookKey Text
key (Text
_,[Text]
_,[(Text, Text)]
kvs) =  forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
key [(Text, Text)]
kvs