{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}
{- |
   Module      : Text.Pandoc.Writers.LaTeX
   Copyright   : Copyright (C) 2006-2020 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.Applicative ((<|>))
import Control.Monad.State.Strict
import Data.Monoid (Any(..))
import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isSpace,
                  isPunctuation, ord)
import Data.List (foldl', intersperse, nubBy, (\\), uncons)
import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, isNothing)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (unEscapeString)
import Text.DocTemplates (FromContext(lookupContext), renderTemplate,
                          Val(..), Context(..))
import Text.Pandoc.BCP47 (Lang (..), getLang, renderLang)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (formatLaTeXBlock, formatLaTeXInline, highlight,
                                 styleToLaTeX, toListingsLanguage)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Slides
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Shared
import Text.Printf (printf)
import qualified Data.Text.Normalize as Normalize

data WriterState =
  WriterState { WriterState -> Bool
stInNote        :: Bool          -- true if we're in a note
              , WriterState -> Bool
stInQuote       :: Bool          -- true if in a blockquote
              , WriterState -> Bool
stExternalNotes :: Bool          -- true if in context where
                                                 -- we need to store footnotes
              , WriterState -> Bool
stInMinipage    :: Bool          -- true if in minipage
              , WriterState -> Bool
stInHeading     :: Bool          -- true if in a section heading
              , WriterState -> Bool
stInItem        :: Bool          -- true if in \item[..]
              , WriterState -> [Doc Text]
stNotes         :: [Doc Text]    -- notes in a minipage
              , WriterState -> Int
stOLLevel       :: Int           -- level of ordered list nesting
              , WriterState -> WriterOptions
stOptions       :: WriterOptions -- writer options, so they don't have to be parameter
              , WriterState -> Bool
stVerbInNote    :: Bool          -- true if document has verbatim text in note
              , WriterState -> Bool
stTable         :: Bool          -- true if document has a table
              , WriterState -> Bool
stStrikeout     :: Bool          -- true if document has strikeout
              , WriterState -> Bool
stUrl           :: Bool          -- true if document has visible URL link
              , WriterState -> Bool
stGraphics      :: Bool          -- true if document contains images
              , WriterState -> Bool
stLHS           :: Bool          -- true if document has literate haskell code
              , WriterState -> Bool
stHasChapters   :: Bool          -- true if document has chapters
              , WriterState -> Bool
stCsquotes      :: Bool          -- true if document uses csquotes
              , WriterState -> Bool
stHighlighting  :: Bool          -- true if document has highlighted code
              , WriterState -> Bool
stIncremental   :: Bool          -- true if beamer lists should be displayed bit by bit
              , WriterState -> [Text]
stInternalLinks :: [Text]      -- list of internal link targets
              , WriterState -> Bool
stBeamer        :: Bool          -- produce beamer
              , WriterState -> Bool
stEmptyLine     :: Bool          -- true if no content on line
              , WriterState -> Bool
stHasCslRefs    :: Bool          -- has a Div with class refs
              , WriterState -> Bool
stIsFirstInDefinition :: Bool    -- first block in a defn list
              }

startingState :: WriterOptions -> WriterState
startingState :: WriterOptions -> WriterState
startingState WriterOptions
options = WriterState :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> [Doc Text]
-> Int
-> WriterOptions
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> [Text]
-> Bool
-> Bool
-> Bool
-> Bool
-> WriterState
WriterState {
                  stInNote :: Bool
stInNote = Bool
False
                , stInQuote :: Bool
stInQuote = Bool
False
                , stExternalNotes :: Bool
stExternalNotes = Bool
False
                , stInHeading :: Bool
stInHeading = Bool
False
                , stInMinipage :: Bool
stInMinipage = Bool
False
                , stInItem :: Bool
stInItem = Bool
False
                , stNotes :: [Doc Text]
stNotes = []
                , stOLLevel :: Int
stOLLevel = Int
1
                , stOptions :: WriterOptions
stOptions = WriterOptions
options
                , stVerbInNote :: Bool
stVerbInNote = Bool
False
                , stTable :: Bool
stTable = Bool
False
                , stStrikeout :: Bool
stStrikeout = Bool
False
                , stUrl :: Bool
stUrl = Bool
False
                , stGraphics :: Bool
stGraphics = Bool
False
                , stLHS :: Bool
stLHS = Bool
False
                , stHasChapters :: Bool
stHasChapters = case WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
options of
                                    TopLevelDivision
TopLevelPart    -> Bool
True
                                    TopLevelDivision
TopLevelChapter -> Bool
True
                                    TopLevelDivision
_               -> Bool
False
                , stCsquotes :: Bool
stCsquotes = Bool
False
                , stHighlighting :: Bool
stHighlighting = Bool
False
                , stIncremental :: Bool
stIncremental = WriterOptions -> Bool
writerIncremental WriterOptions
options
                , stInternalLinks :: [Text]
stInternalLinks = []
                , stBeamer :: Bool
stBeamer = Bool
False
                , stEmptyLine :: Bool
stEmptyLine = Bool
True
                , stHasCslRefs :: Bool
stHasCslRefs = Bool
False
                , stIsFirstInDefinition :: Bool
stIsFirstInDefinition = Bool
False }

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

type LW m = StateT WriterState m

pandocToLaTeX :: PandocMonad m
              => WriterOptions -> Pandoc -> LW m Text
pandocToLaTeX :: WriterOptions -> Pandoc -> LW m Text
pandocToLaTeX WriterOptions
options (Pandoc Meta
meta [Block]
blocks) = do
  -- Strip off final 'references' header if --natbib or --biblatex
  let method :: CiteMethod
method = WriterOptions -> CiteMethod
writerCiteMethod WriterOptions
options
  let blocks' :: [Block]
blocks' = if CiteMethod
method CiteMethod -> CiteMethod -> Bool
forall a. Eq a => a -> a -> Bool
== CiteMethod
Biblatex Bool -> Bool -> Bool
|| CiteMethod
method CiteMethod -> CiteMethod -> Bool
forall a. Eq a => a -> a -> Bool
== CiteMethod
Natbib
                   then case [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
blocks of
                             Div (Text
"refs",[Text]
_,[(Text, Text)]
_) [Block]
_:[Block]
xs -> [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
xs
                             [Block]
_                     -> [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
_                 = []
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stInternalLinks :: [Text]
stInternalLinks = (Inline -> [Text]) -> [Block] -> [Text]
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 WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
options
                    else Maybe Int
forall a. Maybe a
Nothing
  Context Text
metadata <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
options
              [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX
              ((Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX)
              Meta
meta
  let chaptersClasses :: [Text]
chaptersClasses = [Text
"memoir",Text
"book",Text
"report",Text
"scrreprt",Text
"scrbook",Text
"extreport",Text
"extbook",Text
"tufte-book"]
  let frontmatterClasses :: [Text]
frontmatterClasses = [Text
"memoir",Text
"book",Text
"scrbook",Text
"extbook",Text
"tufte-book"]
  -- these have \frontmatter etc.
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  let documentClass :: Text
documentClass =
        case Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"documentclass" (WriterOptions -> Context Text
writerVariables WriterOptions
options) Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
              (MetaValue -> Text
forall a. Walkable Inline a => a -> Text
stringify (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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"
  Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
documentClass Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
chaptersClasses) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$
     (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stHasChapters :: Bool
stHasChapters = Bool
True }
  case Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"csquotes" (WriterOptions -> Context Text
writerVariables WriterOptions
options) Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
       (MetaValue -> Text
forall a. Walkable Inline a => a -> Text
stringify (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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      -> () -> StateT WriterState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Just Text
"false" -> () -> StateT WriterState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Just Text
_       -> (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stCsquotes :: Bool
stCsquotes = Bool
True}
  let ([Block]
blocks'', [Inline]
lastHeader) = if WriterOptions -> CiteMethod
writerCiteMethod WriterOptions
options CiteMethod -> CiteMethod -> Bool
forall a. Eq a => a -> a -> Bool
== CiteMethod
Citeproc then
                                 ([Block]
blocks', [])
                               else case [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
blocks' of
                                 Header Int
1 (Text, [Text], [(Text, Text)])
_ [Inline]
il : [Block]
_ -> ([Block] -> [Block]
forall a. [a] -> [a]
init [Block]
blocks', [Inline]
il)
                                 [Block]
_                 -> ([Block]
blocks', [])
  [Block]
blocks''' <- if Bool
beamer
                  then [Block] -> LW m [Block]
forall (m :: * -> *). PandocMonad m => [Block] -> LW m [Block]
toSlides [Block]
blocks''
                  else [Block] -> LW m [Block]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> LW m [Block]) -> [Block] -> LW m [Block]
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False Maybe Int
forall a. Maybe a
Nothing [Block]
blocks''
  Doc Text
main <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
blocks'''
  Doc Text
biblioTitle <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lastHeader
  WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
  Text
titleMeta <- StringContext -> Text -> LW m Text
forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
TextString (Text -> LW m Text) -> Text -> LW m Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> [Inline] -> Text
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta
  [Text]
authorsMeta <- ([Inline] -> LW m Text)
-> [[Inline]] -> StateT WriterState m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StringContext -> Text -> LW m Text
forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
TextString (Text -> LW m Text) -> ([Inline] -> Text) -> [Inline] -> LW m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify) ([[Inline]] -> StateT WriterState m [Text])
-> [[Inline]] -> StateT WriterState m [Text]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
  [Lang]
docLangs <- [Maybe Lang] -> [Lang]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Lang] -> [Lang])
-> StateT WriterState m [Maybe Lang] -> StateT WriterState m [Lang]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (Text -> StateT WriterState m (Maybe Lang))
-> [Text] -> StateT WriterState m [Maybe Lang]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe Text -> StateT WriterState m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang (Maybe Text -> StateT WriterState m (Maybe Lang))
-> (Text -> Maybe Text)
-> Text
-> StateT WriterState m (Maybe Lang)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just) ([Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub ((Block -> [Text]) -> [Block] -> [Text]
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 = Maybe (Doc Text) -> Bool
forall a. Maybe a -> Bool
isJust (Text -> Context Text -> Maybe (Doc Text)
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 = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Doc Text
"," :: Doc Text) ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
                            ((Doc Text, Text) -> Maybe (Doc Text))
-> [(Doc Text, Text)] -> [Doc Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Doc Text
x,Text
y) ->
                                ((Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"=") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text) -> Maybe (Doc Text) -> Maybe (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
y Context Text
metadata)
                              [(Doc Text
"lmargin",Text
"margin-left")
                              ,(Doc Text
"rmargin",Text
"margin-right")
                              ,(Doc Text
"tmargin",Text
"margin-top")
                              ,(Doc Text
"bmargin",Text
"margin-bottom")
                              ]
  let toPolyObj :: Lang -> Val Text
      toPolyObj :: Lang -> Val Text
toPolyObj Lang
lang = Context Text -> Val Text
forall a. Context a -> Val a
MapVal (Context Text -> Val Text) -> Context Text -> Val Text
forall a b. (a -> b) -> a -> b
$ Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val Text) -> Context Text)
-> Map Text (Val Text) -> Context Text
forall a b. (a -> b) -> a -> b
$
                        [(Text, Val Text)] -> Map Text (Val Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Text
"name" , Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
name)
                                   , (Text
"options" , Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
opts) ]
        where
          (Text
name, Text
opts) = Lang -> (Text, Text)
toPolyglossia Lang
lang
  Maybe Lang
mblang <- Maybe Text -> StateT WriterState m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang (Maybe Text -> StateT WriterState m (Maybe Lang))
-> Maybe Text -> StateT WriterState m (Maybe Lang)
forall a b. (a -> b) -> a -> b
$ case WriterOptions -> Meta -> Maybe Text
getLang WriterOptions
options Meta
meta of
                          Just Text
l -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l
                          Maybe Text
Nothing | [Lang] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Lang]
docLangs -> Maybe Text
forall a. Maybe a
Nothing
                                  | Bool
otherwise     -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"en"
  -- we need a default here since lang is used in template conditionals

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

  let context :: Context Text
context  =  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
options) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc-depth" (Int -> Text
forall a. Show a => a -> Text
tshow
                                        (WriterOptions -> Int
writerTOCDepth WriterOptions
options Int -> Int -> Int
forall a. Num a => a -> a -> a
-
                                              if WriterState -> Bool
stHasChapters WriterState
st
                                                 then Int
1
                                                 else Int
0)) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"title-meta" Text
titleMeta (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"author-meta"
                        (Text -> [Text] -> Text
T.intercalate Text
"; " [Text]
authorsMeta) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"documentclass" Text
documentClass (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"verbatim-in-note" (WriterState -> Bool
stVerbInNote WriterState
st) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"tables" (WriterState -> Bool
stTable WriterState
st) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"strikeout" (WriterState -> Bool
stStrikeout WriterState
st) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"url" (WriterState -> Bool
stUrl WriterState
st) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"numbersections" (WriterOptions -> Bool
writerNumberSections WriterOptions
options) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"lhs" (WriterState -> Bool
stLHS WriterState
st) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"graphics" (WriterState -> Bool
stGraphics WriterState
st) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"has-chapters" (WriterState -> Bool
stHasChapters WriterState
st) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"has-frontmatter" (Text
documentClass Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
frontmatterClasses) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"listings" (WriterOptions -> Bool
writerListings WriterOptions
options Bool -> Bool -> Bool
|| WriterState -> Bool
stLHS WriterState
st) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"beamer" Bool
beamer (Context Text -> Context Text) -> Context Text -> Context Text
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 ->
                                   Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"highlighting-macros"
                                      (Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Style -> Text
styleToLaTeX Style
sty)
                                Maybe Style
Nothing -> Context Text -> Context Text
forall a. a -> a
id
                      else Context Text -> Context Text
forall a. a -> a
id) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  (case WriterOptions -> CiteMethod
writerCiteMethod WriterOptions
options of
                         CiteMethod
Natbib   -> Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"biblio-title" Doc Text
biblioTitle (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"natbib" Bool
True
                         CiteMethod
Biblatex -> Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"biblio-title" Doc Text
biblioTitle (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"biblatex" Bool
True
                         CiteMethod
_        -> Context Text -> Context Text
forall a. a -> a
id) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"colorlinks" ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
hasStringValue
                           [Text
"citecolor", Text
"urlcolor", Text
"linkcolor", Text
"toccolor",
                            Text
"filecolor"]) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  (if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
dirs
                     then Context Text -> Context Text
forall a. a -> a
id
                     else Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"dir" (Text
"ltr" :: Text)) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"section-titles" Bool
True (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"csl-refs" (WriterState -> Bool
stHasCslRefs WriterState
st) (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"geometry" Doc Text
geometryFromMargins (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  (case Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text))
-> (Doc Text -> Text) -> Doc Text -> Maybe (Char, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Maybe (Char, Text))
-> Maybe (Doc Text) -> Maybe (Maybe (Char, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"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
                          -> Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"papersize" (Text
"a" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ds)
                      Maybe (Maybe (Char, Text))
_   -> Context Text -> Context 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:
          (Context Text -> Context Text)
-> (Lang -> Context Text -> Context Text)
-> Maybe Lang
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (\Lang
l -> Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"lang"
                      (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Lang -> Text
renderLang Lang
l)) Maybe Lang
mblang
        (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (Context Text -> Context Text)
-> (Lang -> Context Text -> Context Text)
-> Maybe Lang
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (\Lang
l -> Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"babel-lang"
                      (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Lang -> Text
toBabel Lang
l)) Maybe Lang
mblang
        (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> [Doc Text] -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"babel-otherlangs"
             ((Lang -> Doc Text) -> [Lang] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Lang -> Text) -> Lang -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lang -> Text
toBabel) [Lang]
docLangs)
        (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"babel-newcommands" ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$
           ((Text, Text) -> Doc Text) -> [(Text, Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
poly, Text
babel) -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
            -- \textspanish and \textgalician are already used by babel
            -- save them as \oritext... and let babel use that
            if Text
poly Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"spanish", Text
"galician"]
               then Text
"\\let\\oritext" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
poly Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\text" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
poly Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"\\AddBabelHook{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
poly Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}{beforeextras}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                      Text
"{\\renewcommand{\\text" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
poly Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}{\\oritext"
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
poly Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}}\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"\\AddBabelHook{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
poly Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}{afterextras}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                      Text
"{\\renewcommand{\\text" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
poly Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}[2][]{\\foreignlanguage{"
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
poly Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}{##2}}}"
               else (if Text
poly Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"latin" -- see #4161
                        then Text
"\\providecommand{\\textlatin}{}\n\\renewcommand"
                        else Text
"\\newcommand") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{\\text" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
poly Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"}[2][]{\\foreignlanguage{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
babel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}{#2}}\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"\\newenvironment{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
poly Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"}[2][]{\\begin{otherlanguage}{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
babel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}}{\\end{otherlanguage}}"
            )
            -- eliminate duplicates that have same polyglossia name
            ([(Text, Text)] -> [Doc Text]) -> [(Text, Text)] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> (Text, Text) -> Bool)
-> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(Text, Text)
a (Text, Text)
b -> (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
b)
            -- find polyglossia and babel names of languages used in the document
            ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (Lang -> (Text, Text)) -> [Lang] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\Lang
l -> ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Lang -> (Text, Text)
toPolyglossia Lang
l, Lang -> Text
toBabel Lang
l)) [Lang]
docLangs
          )
        (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (Context Text -> Context Text)
-> (Lang -> Context Text -> Context Text)
-> Maybe Lang
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (Text -> Val Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"polyglossia-lang" (Val Text -> Context Text -> Context Text)
-> (Lang -> Val Text) -> Lang -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lang -> Val Text
toPolyObj) Maybe Lang
mblang
        (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Val Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"polyglossia-otherlangs"
             ([Val Text] -> Val Text
forall a. [Val a] -> Val a
ListVal ((Lang -> Val Text) -> [Lang] -> [Val Text]
forall a b. (a -> b) -> [a] -> [b]
map Lang -> Val Text
toPolyObj [Lang]
docLangs :: [Val Text]))
        (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
                  Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"latex-dir-rtl"
           ((Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> Maybe (Doc Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Context Text -> Maybe (Doc Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"dir" Context Text
context) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
==
               Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"rtl" :: Text)) Context Text
context
  Text -> LW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> LW m Text) -> Text -> LW m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
options of
       Maybe (Template Text)
Nothing  -> Doc Text
main
       Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context'

data StringContext = TextString
                   | URLString
                   | CodeString
                   deriving (StringContext -> StringContext -> Bool
(StringContext -> StringContext -> Bool)
-> (StringContext -> StringContext -> Bool) -> Eq StringContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringContext -> StringContext -> Bool
$c/= :: StringContext -> StringContext -> Bool
== :: StringContext -> StringContext -> Bool
$c== :: StringContext -> StringContext -> Bool
Eq)

-- escape things as needed for LaTeX
stringToLaTeX :: PandocMonad m => StringContext -> Text -> LW m Text
stringToLaTeX :: StringContext -> Text -> LW m Text
stringToLaTeX StringContext
context Text
zs = do
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Text -> LW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> LW m Text) -> Text -> LW m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
    (Char -> String -> String) -> String -> String -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (WriterOptions -> StringContext -> Char -> String -> String
go WriterOptions
opts StringContext
context) String
forall a. Monoid a => a
mempty (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
    if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
       then NormalizationMode -> Text -> Text
Normalize.normalize NormalizationMode
Normalize.NFD Text
zs
       else Text
zs
 where
  go :: WriterOptions -> StringContext -> Char -> String -> String
  go :: WriterOptions -> StringContext -> Char -> String -> String
go WriterOptions
opts StringContext
ctx Char
x String
xs   =
    let ligatures :: Bool
ligatures = Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts Bool -> Bool -> Bool
&& StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
TextString
        isUrl :: Bool
isUrl = StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
URLString
        mbAccentCmd :: Maybe String
mbAccentCmd =
          if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts Bool -> Bool -> Bool
&& StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
TextString
             then String -> Maybe (Char, String)
forall a. [a] -> Maybe (a, [a])
uncons String
xs Maybe (Char, String)
-> ((Char, String) -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Char
c,String
_) -> Char -> Map Char String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Char
c Map Char String
accents
             else Maybe String
forall a. Maybe a
Nothing
        emits :: String -> String
emits String
s =
          case Maybe String
mbAccentCmd of
               Just String
cmd ->
                 String
cmd String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"{" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
xs -- drop combining accent
               Maybe String
Nothing  -> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs
        emitc :: Char -> String
emitc Char
c =
          case Maybe String
mbAccentCmd of
               Just String
cmd ->
                 String
cmd String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"{" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
c] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
xs -- drop combining accent
               Maybe String
Nothing  -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
        emitcseq :: String -> String
emitcseq String
cs =
          case String
xs of
            Char
c:String
_ | Char -> Bool
isLetter Char
c
                , StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
TextString
                             -> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs
                | Char -> Bool
isSpace Char
c  -> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"{}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs
                | StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
TextString
                             -> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs
            String
_ -> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"{}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs
        emitquote :: String -> String
emitquote String
cs =
          case String
xs of
            Char
'`':String
_  -> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\\," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs -- add thin space
            Char
'\'':String
_ -> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\\," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs -- add thin space
            String
_      -> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs
    in case Char
x of
         Char
'?' | Bool
ligatures ->  -- avoid ?` ligature
           case String
xs of
             Char
'`':String
_ -> String -> String
emits String
"?{}"
             String
_     -> Char -> String
emitc Char
x
         Char
'!' | Bool
ligatures ->  -- avoid !` ligature
           case String
xs of
             Char
'`':String
_ -> String -> String
emits String
"!{}"
             String
_     -> Char -> String
emitc Char
x
         Char
'{' -> String -> String
emits String
"\\{"
         Char
'}' -> String -> String
emits String
"\\}"
         Char
'`' | StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
CodeString -> String -> String
emitcseq String
"\\textasciigrave"
         Char
'$' | Bool -> Bool
not Bool
isUrl -> String -> String
emits String
"\\$"
         Char
'%' -> String -> String
emits String
"\\%"
         Char
'&' -> String -> String
emits String
"\\&"
         Char
'_' | Bool -> Bool
not Bool
isUrl -> String -> String
emits String
"\\_"
         Char
'#' -> String -> String
emits String
"\\#"
         Char
'-' | Bool -> Bool
not Bool
isUrl -> case String
xs of
                     -- prevent adjacent hyphens from forming ligatures
                     (Char
'-':String
_) -> String -> String
emits String
"-\\/"
                     String
_       -> Char -> String
emitc Char
'-'
         Char
'~' | Bool -> Bool
not Bool
isUrl -> String -> String
emitcseq String
"\\textasciitilde"
         Char
'^' -> String -> String
emits String
"\\^{}"
         Char
'\\'| Bool
isUrl     -> Char -> String
emitc Char
'/' -- NB. / works as path sep even on Windows
             | Bool
otherwise -> String -> String
emitcseq String
"\\textbackslash"
         Char
'|' | Bool -> Bool
not Bool
isUrl -> String -> String
emitcseq String
"\\textbar"
         Char
'<' -> String -> String
emitcseq String
"\\textless"
         Char
'>' -> String -> String
emitcseq String
"\\textgreater"
         Char
'[' -> String -> String
emits String
"{[}"  -- to avoid interpretation as
         Char
']' -> String -> String
emits String
"{]}"  -- optional arguments
         Char
'\'' | StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
CodeString -> String -> String
emitcseq String
"\\textquotesingle"
         Char
'\160' -> String -> String
emits String
"~"
         Char
'\x200B' -> String -> String
emits String
"\\hspace{0pt}"  -- zero-width space
         Char
'\x202F' -> String -> String
emits String
"\\,"
         Char
'\x2026' -> String -> String
emitcseq String
"\\ldots"
         Char
'\x2018' | Bool
ligatures -> String -> String
emitquote String
"`"
         Char
'\x2019' | Bool
ligatures -> String -> String
emitquote String
"'"
         Char
'\x201C' | Bool
ligatures -> String -> String
emitquote String
"``"
         Char
'\x201D' | Bool
ligatures -> String -> String
emitquote String
"''"
         Char
'\x2014' | Bool
ligatures -> String -> String
emits String
"---"
         Char
'\x2013' | Bool
ligatures -> String -> String
emits String
"--"
         Char
_ | WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
             -> case Char
x of
                  Char
'ı' -> String -> String
emitcseq String
"\\i"
                  Char
'ȷ' -> String -> String
emitcseq String
"\\j"
                  Char
'å' -> String -> String
emitcseq String
"\\aa"
                  Char
'Å' -> String -> String
emitcseq String
"\\AA"
                  Char
'ß' -> String -> String
emitcseq String
"\\ss"
                  Char
'ø' -> String -> String
emitcseq String
"\\o"
                  Char
'Ø' -> String -> String
emitcseq String
"\\O"
                  Char
'Ł' -> String -> String
emitcseq String
"\\L"
                  Char
'ł' -> String -> String
emitcseq String
"\\l"
                  Char
'æ' -> String -> String
emitcseq String
"\\ae"
                  Char
'Æ' -> String -> String
emitcseq String
"\\AE"
                  Char
'œ' -> String -> String
emitcseq String
"\\oe"
                  Char
'Œ' -> String -> String
emitcseq String
"\\OE"
                  Char
'£' -> String -> String
emitcseq String
"\\pounds"
                  Char
'€' -> String -> String
emitcseq String
"\\euro"
                  Char
'©' -> String -> String
emitcseq String
"\\copyright"
                  Char
_   -> Char -> String
emitc Char
x
           | Bool
otherwise -> Char -> String
emitc Char
x

accents :: M.Map Char String
accents :: Map Char String
accents = [(Char, String)] -> Map Char String
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Char
'\779' , String
"\\H")
  , (Char
'\768' , String
"\\`")
  , (Char
'\769' , String
"\\'")
  , (Char
'\770' , String
"\\^")
  , (Char
'\771' , String
"\\~")
  , (Char
'\776' , String
"\\\"")
  , (Char
'\775' , String
"\\.")
  , (Char
'\772' , String
"\\=")
  , (Char
'\781' , String
"\\|")
  , (Char
'\817' , String
"\\b")
  , (Char
'\807' , String
"\\c")
  , (Char
'\783' , String
"\\G")
  , (Char
'\777' , String
"\\h")
  , (Char
'\803' , String
"\\d")
  , (Char
'\785' , String
"\\f")
  , (Char
'\778' , String
"\\r")
  , (Char
'\865' , String
"\\t")
  , (Char
'\782' , String
"\\U")
  , (Char
'\780' , String
"\\v")
  , (Char
'\774' , String
"\\u")
  , (Char
'\808' , String
"\\k")
  , (Char
'\785' , String
"\\newtie")
  , (Char
'\8413', String
"\\textcircled")
  ]

toLabel :: PandocMonad m => Text -> LW m Text
toLabel :: Text -> LW m Text
toLabel Text
z = Text -> Text
go (Text -> Text) -> LW m Text -> LW m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` StringContext -> Text -> LW m Text
forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
URLString Text
z
 where
   go :: Text -> Text
go = (Char -> Text) -> Text -> Text
T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
x -> case Char
x of
     Char
_ | (Char -> Bool
isLetter Char
x Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
x) Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
x -> Char -> Text
T.singleton Char
x
       | Char
x Char -> Text -> Bool
`elemText` Text
"_-+=:;." -> Char -> Text
T.singleton Char
x
       | Bool
otherwise -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"ux" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%x" (Char -> Int
ord Char
x)

-- | Puts contents into LaTeX command.
inCmd :: Text -> Doc Text -> Doc Text
inCmd :: Text -> Doc Text -> Doc Text
inCmd Text
cmd Doc Text
contents = Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'\\' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
cmd Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents

toSlides :: PandocMonad m => [Block] -> LW m [Block]
toSlides :: [Block] -> LW m [Block]
toSlides [Block]
bs = do
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let slideLevel :: Int
slideLevel = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Block] -> Int
getSlideLevel [Block]
bs) (Maybe Int -> Int) -> Maybe Int -> Int
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
  (Block -> StateT WriterState m Block) -> [Block] -> LW m [Block]
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM (Int -> Block -> StateT WriterState m Block
forall (m :: * -> *). PandocMonad m => Int -> Block -> LW m Block
elementToBeamer Int
slideLevel) ([Block] -> LW m [Block]) -> [Block] -> LW m [Block]
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False Maybe Int
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 :: 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
slideLevel
    = Block -> LW m Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> LW m Block) -> Block -> LW m Block
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident,Text
"block"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
dclasses,[(Text, Text)]
dkvs) [Block]
xs
  | Int
lvl Int -> Int -> Bool
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) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isSlide [Block]
ys
         Block -> LW m Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> LW m Block) -> Block -> LW m Block
forall a b. (a -> b) -> a -> b
$
           if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
titleBs
              then (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident,Text
"section"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
dclasses,[(Text, Text)]
dkvs) [Block]
xs
              else (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident,Text
"section"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
dclasses,[(Text, Text)]
dkvs)
                    (Block
h Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
"",Text
"slide"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
dclasses,[(Text, Text)]
dkvs) (Block
hBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
titleBs) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
slideBs)
  | Bool
otherwise
    = Block -> LW m Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> LW m Block) -> Block -> LW m Block
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident,Text
"slide"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
dclasses,[(Text, Text)]
dkvs) [Block]
xs
elementToBeamer Int
_ Block
x = Block -> LW m Block
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 :: Block -> LW m (Doc Text)
blockToLaTeX Block
Null = Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToLaTeX (Div attr :: (Text, [Text], [(Text, Text)])
attr@(Text
identifier,Text
"block":[Text]
_,[(Text, Text)]
_) (Header Int
_ (Text, [Text], [(Text, Text)])
_ [Inline]
ils : [Block]
bs)) = do
  Text
ref <- Text -> LW m Text
forall (m :: * -> *). PandocMonad m => Text -> LW m Text
toLabel Text
identifier
  let anchor :: Doc Text
anchor = if Text -> Bool
T.null Text
identifier
                  then Doc Text
forall a. Doc a
empty
                  else Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\protect\\hypertarget" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                       Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ref) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
forall a. Doc a
empty
  Doc Text
title' <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
ils
  Doc Text
contents <- [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
bs
  (Text, [Text], [(Text, Text)]) -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
(Text, [Text], [(Text, Text)]) -> Doc Text -> LW m (Doc Text)
wrapDiv (Text, [Text], [(Text, Text)])
attr (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Doc Text
"\\begin{block}" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
title' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
anchor) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                 Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\end{block}"
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 = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
dclasses [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
hclasses
  let kvs :: [(Text, Text)]
kvs = [(Text, Text)] -> [(Text, Text)]
forall a. Ord a => [a] -> [a]
ordNub ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
dkvs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
hkvs
  let fragile :: Bool
fragile = Text
"fragile" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
||
                Bool -> Bool
not ([Bool] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Block -> [Bool]) -> [Block] -> [Bool]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [Bool]
hasCodeBlock [Block]
bs [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ (Inline -> [Bool]) -> [Block] -> [Bool]
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
"label", Text
"plain", Text
"shrink", Text
"standout",
                      Text
"noframenumbering"]
  let optionslist :: [Text]
optionslist = [Text
"fragile" | Bool
fragile
                               , Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"fragile" [(Text, Text)]
kvs)
                               , Text
"fragile" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                    [Text
k | Text
k <- [Text]
classes, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
frameoptions] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                    [Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
frameoptions]
  let options :: Doc Text
options = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
optionslist
                   then Doc Text
forall a. Doc a
empty
                   else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> [Text] -> Text
T.intercalate Text
"," [Text]
optionslist))
  Doc Text
slideTitle <- if [Inline]
ils [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
"\0"] -- marker for hrule
                   then Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
                   else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
ils
  Text
ref <- Text -> LW m Text
forall (m :: * -> *). PandocMonad m => Text -> LW m Text
toLabel Text
identifier
  let slideAnchor :: Doc Text
slideAnchor = if Text -> Bool
T.null Text
identifier
                       then Doc Text
forall a. Doc a
empty
                       else Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\protect\\hypertarget" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                            Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ref) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
forall a. Doc a
empty
  Doc Text
contents <- [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
bs LW m (Doc Text) -> (Doc Text -> LW m (Doc Text)) -> LW m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text, [Text], [(Text, Text)]) -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
(Text, [Text], [(Text, Text)]) -> Doc Text -> LW m (Doc Text)
wrapDiv (Text
identifier,[Text]
classes,[(Text, Text)]
kvs)
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Doc Text
"\\begin{frame}" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
options Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
slideTitle Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
slideAnchor) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
             Doc Text
contents Doc Text -> Doc Text -> Doc Text
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
  Block -> LW m (Doc Text)
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 Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs))
blockToLaTeX (Div (Text
identifier,[Text]
classes,[(Text, Text)]
kvs) [Block]
bs) = do
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  Bool
oldIncremental <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIncremental
  if Bool
beamer Bool -> Bool -> Bool
&& Text
"incremental" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
     then (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stIncremental :: Bool
stIncremental = Bool
True }
     else Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
beamer Bool -> Bool -> Bool
&& Text
"nonincremental" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$
             (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stIncremental :: Bool
stIncremental = Bool
False }
  Doc Text
result <- if Text
identifier Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"refs" Bool -> Bool -> Bool
|| -- <- for backwards compatibility
               Text
"csl-bib-body" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
               then do
                 (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasCslRefs :: Bool
stHasCslRefs = Bool
True }
                 Doc Text
inner <- [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
bs
                 Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\\begin{CSLReferences}" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                          (if Text
"hanging-indent" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                              then Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
"1"
                              else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
"0") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                          (case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"entry-spacing" [(Text, Text)]
kvs of
                             Maybe Text
Nothing -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
"0"
                             Just Text
s  -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
s))
                          Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
inner
                          Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
"\\end{CSLReferences}"
               else if Text
"csl-entry" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                       then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> LW m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
cslEntryToLaTeX [Block]
bs
                       else [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
bs
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stIncremental :: Bool
stIncremental = Bool
oldIncremental }
  Doc Text
linkAnchor' <- Bool -> Text -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> Text -> Doc Text -> LW m (Doc Text)
hypertarget Bool
True Text
identifier Doc Text
forall a. Doc a
empty
  -- see #2704 for the motivation for adding \leavevmode:
  let linkAnchor :: Doc Text
linkAnchor =
        case [Block]
bs of
          Para [Inline]
_ : [Block]
_
            | Bool -> Bool
not (Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
linkAnchor')
              -> Doc Text
"\\leavevmode" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linkAnchor' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"%"
          [Block]
_ -> Doc Text
linkAnchor'
      wrapNotes :: Doc Text -> Doc Text
wrapNotes Doc Text
txt = if Bool
beamer Bool -> Bool -> Bool
&& Text
"notes" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                         then Doc Text
"\\note" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
txt -- speaker notes
                         else Doc Text
linkAnchor Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
txt
  Doc Text -> Doc Text
wrapNotes (Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text, [Text], [(Text, Text)]) -> Doc Text -> LW m (Doc Text)
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
blockToLaTeX (Plain [Inline]
lst) =
  [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
-- title beginning with fig: indicates that the image is a figure
blockToLaTeX (Para [Image attr :: (Text, [Text], [(Text, Text)])
attr@(Text
ident, [Text]
_, [(Text, Text)]
_) [Inline]
txt (Text
src,Text
tgt)])
  | Just Text
tit <- Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" Text
tgt
  = do
      (Doc Text
capt, Doc Text
captForLof, Doc Text
footnotes) <- Bool -> [Inline] -> LW m (Doc Text, Doc Text, Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> [Inline] -> LW m (Doc Text, Doc Text, Doc Text)
getCaption Bool
True [Inline]
txt
      Doc Text
lab <- Text -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
labelFor Text
ident
      let caption :: Doc Text
caption = Doc Text
"\\caption" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
captForLof Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
lab
      Doc Text
img <- Inline -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> LW m (Doc Text)
inlineToLaTeX ((Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text, [Text], [(Text, Text)])
attr [Inline]
txt (Text
src,Text
tit))
      Doc Text
innards <- Bool -> Text -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> Text -> Doc Text -> LW m (Doc Text)
hypertarget Bool
True Text
ident (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$
                   Doc Text
"\\centering" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
img Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
      let figure :: Doc Text
figure = Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\begin{figure}" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
innards Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\end{figure}"
      WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
      Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if WriterState -> Bool
stInMinipage WriterState
st
                 -- can't have figures in notes or minipage (here, table cell)
                 -- http://www.tex.ac.uk/FAQ-ouparmd.html
                then Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\begin{center}" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
img Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                       Doc Text
"\\end{center}"
                else Doc Text
figure) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
footnotes
-- . . . indicates pause in beamer slides
blockToLaTeX (Para [Str Text
".",Inline
Space,Str Text
".",Inline
Space,Str Text
"."]) = do
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  if Bool
beamer
     then Block -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX (Format -> Text -> Block
RawBlock Format
"latex" Text
"\\pause")
     else [Inline] -> LW m (Doc Text)
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) =
  [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
blockToLaTeX (LineBlock [[Inline]]
lns) =
  Block -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX (Block -> LW m (Doc Text)) -> Block -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToLaTeX (BlockQuote [Block]
lst) = do
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
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 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIncremental
         (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stIncremental :: Bool
stIncremental = Bool -> Bool
not Bool
oldIncremental }
         Doc Text
result <- Block -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX Block
b
         (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stIncremental :: Bool
stIncremental = Bool
oldIncremental }
         Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
result
       [Block]
_ -> do
         Bool
oldInQuote <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInQuote
         (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{stInQuote :: Bool
stInQuote = Bool
True})
         Doc Text
contents <- [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
lst
         (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{stInQuote :: Bool
stInQuote = Bool
oldInQuote})
         Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\\begin{quote}" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
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 <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Doc Text
lab <- Text -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
labelFor Text
identifier
  Doc Text
linkAnchor' <- Bool -> Text -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> Text -> Doc Text -> LW m (Doc Text)
hypertarget Bool
True Text
identifier Doc Text
lab
  let linkAnchor :: Doc Text
linkAnchor = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
linkAnchor'
                      then Doc Text
forall a. Doc a
empty
                      else Doc Text
linkAnchor' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"%"
  let lhsCodeBlock :: LW m (Doc Text)
lhsCodeBlock = do
        (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stLHS :: Bool
stLHS = Bool
True }
        Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Doc Text
linkAnchor Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\begin{code}" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                            Doc Text
"\\end{code}") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
cr
  let rawCodeBlock :: LW m (Doc Text)
rawCodeBlock = do
        WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
        Text
env <- if WriterState -> Bool
stInNote WriterState
st
                  then (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{ stVerbInNote :: Bool
stVerbInNote = Bool
True }) StateT WriterState m () -> LW m Text -> LW m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       Text -> LW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"Verbatim"
                  else Text -> LW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"verbatim"
        Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Doc Text
linkAnchor Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"\\begin{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
env Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                 Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"\\end{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
env Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}")) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
  let listingsCodeBlock :: LW m (Doc Text)
listingsCodeBlock = do
        WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
        Text
ref <- Text -> LW m Text
forall (m :: * -> *). PandocMonad m => Text -> LW m Text
toLabel Text
identifier
        [(Text, Text)]
kvs <- ((Text, Text) -> StateT WriterState m (Text, Text))
-> [(Text, Text)] -> StateT WriterState m [(Text, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Text
k,Text
v) -> (Text
k,) (Text -> (Text, Text))
-> LW m Text -> StateT WriterState m (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       StringContext -> Text -> LW m Text
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=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
mbBraced Text
l ]
                                Maybe Text
Nothing -> []) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                          [ Text
"numbers=left" | Text
"numberLines" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                             Bool -> Bool -> Bool
|| Text
"number" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                             Bool -> Bool -> Bool
|| Text
"number-lines" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                          [ (if Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"startFrom"
                                then Text
"firstnumber"
                                else Text
key) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
mbBraced Text
attr |
                                (Text
key,Text
attr) <- [(Text, Text)]
kvs,
                                Text
key Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"exports", Text
"tangle", Text
"results"]
                                -- see #4889
                          ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                          [Text
"label=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref | Bool -> Bool
not (Text -> Bool
T.null Text
identifier)]

                     else []
            printParams :: Doc Text
printParams
                | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
params = Doc Text
forall a. Doc a
empty
                | Bool
otherwise   = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
", "
                      ((Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal [Text]
params))
        Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Doc Text
"\\begin{lstlisting}" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
printParams Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                 Doc Text
"\\end{lstlisting}") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
cr
  let highlightedCodeBlock :: LW m (Doc Text)
highlightedCodeBlock =
        case SyntaxMap
-> (FormatOptions -> [SourceLine] -> Text)
-> (Text, [Text], [(Text, Text)])
-> Text
-> Either Text Text
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,[(Text, Text)]
keyvalAttr) Text
str of
               Left Text
msg -> do
                 Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$
                   LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
                 LW m (Doc Text)
rawCodeBlock
               Right Text
h -> do
                  WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
                  Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WriterState -> Bool
stInNote WriterState
st) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{ stVerbInNote :: Bool
stVerbInNote = Bool
True })
                  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s{ stHighlighting :: Bool
stHighlighting = Bool
True })
                  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
linkAnchor Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Text -> String
T.unpack Text
h))
  case () of
     ()
_ | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_literate_haskell WriterOptions
opts Bool -> Bool -> Bool
&& Text
"haskell" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
&&
         Text
"literate" Text -> [Text] -> Bool
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 ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes) Bool -> Bool -> Bool
&& Maybe Style -> Bool
forall a. Maybe a -> Bool
isJust (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts)
                                             -> LW m (Doc Text)
highlightedCodeBlock
       | Bool
otherwise                           -> LW m (Doc Text)
rawCodeBlock
blockToLaTeX b :: Block
b@(RawBlock Format
f Text
x) = do
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  if Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex" Bool -> Bool -> Bool
||
       (Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"beamer" Bool -> Bool -> Bool
&& Bool
beamer)
     then Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
x
     else do
       LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
       Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToLaTeX (BulletList []) = Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty  -- otherwise latex error
blockToLaTeX (BulletList [[Block]]
lst) = do
  Bool
incremental <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIncremental
  Bool
isFirstInDefinition <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIsFirstInDefinition
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
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 <- ([Block] -> LW m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
listItemToLaTeX [[Block]]
lst
  let spacing :: Doc Text
spacing = if [[Block]] -> Bool
isTightList [[Block]]
lst
                   then String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\tightlist"
                   else Doc Text
forall a. Doc a
empty
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String
"\\begin{itemize}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
inc) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
             Doc Text
spacing Doc Text -> Doc Text -> Doc Text
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 Doc Text
forall a. Monoid a => a
mempty) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
             [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
             Doc Text
"\\end{itemize}"
blockToLaTeX (OrderedList ListAttributes
_ []) = Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty -- otherwise latex error
blockToLaTeX (OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
numdelim) [[Block]]
lst) = do
  WriterState
st <- StateT WriterState m WriterState
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 <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIsFirstInDefinition
  WriterState -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (WriterState -> StateT WriterState m ())
-> WriterState -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ WriterState
st {stOLLevel :: Int
stOLLevel = Int
oldlevel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}
  [Doc Text]
items <- ([Block] -> LW m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
listItemToLaTeX [[Block]]
lst
  (WriterState -> WriterState) -> StateT WriterState m ()
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" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
UpperRoman   -> Doc a
"\\Roman" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
LowerRoman   -> Doc a
"\\roman" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
UpperAlpha   -> Doc a
"\\Alph" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
LowerAlpha   -> Doc a
"\\alph" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
Example      -> Doc a
"\\arabic" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
                       ListNumberStyle
DefaultStyle -> Doc a
"\\arabic" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
braces Doc a
x
  let todelim :: Doc a -> Doc a
todelim Doc a
x = case ListNumberDelim
numdelim of
                       ListNumberDelim
OneParen  -> Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
")"
                       ListNumberDelim
TwoParens -> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
parens Doc a
x
                       ListNumberDelim
Period    -> Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
"."
                       ListNumberDelim
_         -> Doc a
x Doc a -> Doc a -> Doc a
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 = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"enum" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.toLower (Int -> Text
toRomanNumeral Int
oldlevel)
  let stylecommand :: Doc Text
stylecommand
        | ListNumberStyle
numstyle ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
DefaultStyle Bool -> Bool -> Bool
&& ListNumberDelim
numdelim ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
DefaultDelim = Doc Text
forall a. Doc a
empty
        | Bool
beamer Bool -> Bool -> Bool
&& ListNumberStyle
numstyle ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
Decimal Bool -> Bool -> Bool
&& ListNumberDelim
numdelim ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
Period = Doc Text
forall a. Doc a
empty
        | Bool
beamer = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
todelim Doc Text
exemplar)
        | Bool
otherwise = Doc Text
"\\def" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\label" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
enum Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
          Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
todelim (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
tostyle Doc Text
enum)
  let resetcounter :: Doc Text
resetcounter = if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
oldlevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4
                        then Doc Text
forall a. Doc a
empty
                        else Doc Text
"\\setcounter" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
enum Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                              Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  let spacing :: Doc Text
spacing = if [[Block]] -> Bool
isTightList [[Block]]
lst
                   then String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\tightlist"
                   else Doc Text
forall a. Doc a
empty
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String
"\\begin{enumerate}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
inc)
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
stylecommand
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
resetcounter
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
spacing
         -- force list at beginning of definition to start on new line
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ (if Bool
isFirstInDefinition then Doc Text
"\\item[]" else Doc Text
forall a. Monoid a => a
mempty)
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\end{enumerate}"
blockToLaTeX (DefinitionList []) = Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToLaTeX (DefinitionList [([Inline], [[Block]])]
lst) = do
  Bool
incremental <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stIncremental
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
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 <- (([Inline], [[Block]]) -> LW m (Doc Text))
-> [([Inline], [[Block]])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Inline], [[Block]]) -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> LW m (Doc Text)
defListItemToLaTeX [([Inline], [[Block]])]
lst
  let spacing :: Doc Text
spacing = if (([Inline], [[Block]]) -> Bool) -> [([Inline], [[Block]])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([[Block]] -> Bool
isTightList ([[Block]] -> Bool)
-> (([Inline], [[Block]]) -> [[Block]])
-> ([Inline], [[Block]])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline], [[Block]]) -> [[Block]]
forall a b. (a, b) -> b
snd) [([Inline], [[Block]])]
lst
                   then String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\tightlist"
                   else Doc Text
forall a. Doc a
empty
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String
"\\begin{description}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
inc) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
spacing Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
               Doc Text
"\\end{description}"
blockToLaTeX Block
HorizontalRule =
            Doc Text -> LW m (Doc Text)
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
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInHeading :: Bool
stInHeading = Bool
True}
  Doc Text
hdr <- [Text] -> Text -> Int -> [Inline] -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Text -> Int -> [Inline] -> LW m (Doc Text)
sectionHeader [Text]
classes Text
id' Int
level [Inline]
lst
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInHeading :: Bool
stInHeading = Bool
False}
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
hdr
blockToLaTeX (Table (Text, [Text], [(Text, Text)])
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
  let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
heads, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
  (Doc Text
captionText, Doc Text
captForLof, Doc Text
captNotes) <- Bool -> [Inline] -> LW m (Doc Text, Doc Text, Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> [Inline] -> LW m (Doc Text, Doc Text, Doc Text)
getCaption Bool
False [Inline]
caption
  let toHeaders :: [[Block]] -> StateT WriterState m (Doc Text)
toHeaders [[Block]]
hs = do Doc Text
contents <- Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> [Alignment] -> [Double] -> [[Block]] -> LW m (Doc Text)
tableRowToLaTeX Bool
True [Alignment]
aligns [Double]
widths [[Block]]
hs
                        Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
"\\toprule" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\midrule")
  let removeNote :: Inline -> Inline
removeNote (Note [Block]
_) = (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text
"", [], []) []
      removeNote Inline
x        = Inline
x
  Doc Text
firsthead <- if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
captionText Bool -> Bool -> Bool
|| ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
heads
                  then Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
                  else (Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\endfirsthead") (Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Block]] -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> StateT WriterState m (Doc Text)
toHeaders [[Block]]
heads
  Doc Text
head' <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
heads
              then Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
"\\toprule"
              -- avoid duplicate notes in head and firsthead:
              else [[Block]] -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> StateT WriterState m (Doc Text)
toHeaders (if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
firsthead
                                 then [[Block]]
heads
                                 else (Inline -> Inline) -> [[Block]] -> [[Block]]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNote [[Block]]
heads)
  let capt :: Doc Text
capt = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
captionText
                then Doc Text
forall a. Doc a
empty
                else Doc Text
"\\caption" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
captForLof Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
captionText
                         Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\tabularnewline"
  [Doc Text]
rows' <- ([[Block]] -> LW m (Doc Text))
-> [[[Block]]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> [Alignment] -> [Double] -> [[Block]] -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> [Alignment] -> [Double] -> [[Block]] -> LW m (Doc Text)
tableRowToLaTeX Bool
False [Alignment]
aligns [Double]
widths) [[[Block]]]
rows
  let colDescriptors :: Doc Text
colDescriptors = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Alignment -> Text) -> [Alignment] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Alignment -> Text
toColDescriptor [Alignment]
aligns
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stTable :: Bool
stTable = Bool
True }
  Doc Text
notes <- [Doc Text] -> Doc Text
notesToLaTeX ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> [Doc Text]) -> StateT WriterState m [Doc Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stNotes
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\\begin{longtable}[]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
              Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text
"@{}" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
colDescriptors Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"@{}")
              -- the @{} removes extra space at beginning and end
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
capt
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
firsthead
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
head'
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\endhead"
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows'
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\bottomrule"
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\end{longtable}"
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
captNotes
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
notes

getCaption :: PandocMonad m
           => Bool -> [Inline] -> LW m (Doc Text, Doc Text, Doc Text)
getCaption :: Bool -> [Inline] -> LW m (Doc Text, Doc Text, Doc Text)
getCaption Bool
externalNotes [Inline]
txt = do
  Bool
oldExternalNotes <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stExternalNotes
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stExternalNotes :: Bool
stExternalNotes = Bool
externalNotes, stNotes :: [Doc Text]
stNotes = [] }
  Doc Text
capt <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
txt
  Doc Text
footnotes <- if Bool
externalNotes
                  then [Doc Text] -> Doc Text
notesToLaTeX ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> [Doc Text]) -> StateT WriterState m [Doc Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stNotes
                  else Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stExternalNotes :: Bool
stExternalNotes = Bool
oldExternalNotes, stNotes :: [Doc Text]
stNotes = [] }
  -- We can't have footnotes in the list of figures/tables, so remove them:
  let getNote :: Inline -> Any
getNote (Note [Block]
_) = Bool -> Any
Any Bool
True
      getNote Inline
_        = Bool -> Any
Any Bool
False
  let hasNotes :: [Inline] -> Bool
hasNotes = Any -> Bool
getAny (Any -> Bool) -> ([Inline] -> Any) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Any) -> [Inline] -> Any
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Any
getNote
  Doc Text
captForLof <- if [Inline] -> Bool
hasNotes [Inline]
txt
                   then Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX ((Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
deNote [Inline]
txt)
                   else Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
  (Doc Text, Doc Text, Doc Text)
-> LW m (Doc Text, Doc Text, Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
capt, Doc Text
captForLof, Doc Text
footnotes)

toColDescriptor :: Alignment -> Text
toColDescriptor :: Alignment -> Text
toColDescriptor Alignment
align =
  case Alignment
align of
         Alignment
AlignLeft    -> Text
"l"
         Alignment
AlignRight   -> Text
"r"
         Alignment
AlignCenter  -> Text
"c"
         Alignment
AlignDefault -> Text
"l"

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

tableRowToLaTeX :: PandocMonad m
                => Bool
                -> [Alignment]
                -> [Double]
                -> [[Block]]
                -> LW m (Doc Text)
tableRowToLaTeX :: Bool -> [Alignment] -> [Double] -> [[Block]] -> LW m (Doc Text)
tableRowToLaTeX Bool
header [Alignment]
aligns [Double]
widths [[Block]]
cols = do
  let isSimple :: [Block] -> Bool
isSimple [Plain [Inline]
_] = Bool
True
      isSimple [Para  [Inline]
_] = Bool
True
      isSimple []        = Bool
True
      isSimple [Block]
_         = Bool
False
  -- simple tables have to have simple cells:
  let widths' :: [Double]
widths' = if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths Bool -> Bool -> Bool
&& Bool -> Bool
not (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isSimple [[Block]]
cols)
                   then Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate ([Alignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns)
                          (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Alignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns))
                   else [Double]
widths
  let numcols :: Int
numcols = [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths'
  [Doc Text]
cells <- ((Double, Alignment, [Block]) -> LW m (Doc Text))
-> [(Double, Alignment, [Block])]
-> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Int -> (Double, Alignment, [Block]) -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> Int -> (Double, Alignment, [Block]) -> LW m (Doc Text)
tableCellToLaTeX Bool
header Int
numcols) ([(Double, Alignment, [Block])] -> StateT WriterState m [Doc Text])
-> [(Double, Alignment, [Block])]
-> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ [Double]
-> [Alignment] -> [[Block]] -> [(Double, Alignment, [Block])]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Double]
widths' [Alignment]
aligns [[Block]]
cols
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
"&" [Doc Text]
cells) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\tabularnewline"

-- For simple latex tables (without minipages or parboxes),
-- we need to go to some lengths to get line breaks working:
-- as LineBreak bs = \vtop{\hbox{\strut as}\hbox{\strut bs}}.
fixLineBreaks :: Block -> Block
fixLineBreaks :: Block -> Block
fixLineBreaks (Para [Inline]
ils)  = [Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
fixLineBreaks' [Inline]
ils
fixLineBreaks (Plain [Inline]
ils) = [Inline] -> Block
Plain ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
fixLineBreaks' [Inline]
ils
fixLineBreaks Block
x           = Block
x

fixLineBreaks' :: [Inline] -> [Inline]
fixLineBreaks' :: [Inline] -> [Inline]
fixLineBreaks' [Inline]
ils = case (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
LineBreak) [Inline]
ils of
                       []     -> []
                       [[Inline]
xs]   -> [Inline]
xs
                       [[Inline]]
chunks -> Format -> Text -> Inline
RawInline Format
"tex" Text
"\\vtop{" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:
                                 ([Inline] -> [Inline]) -> [[Inline]] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Inline] -> [Inline]
tohbox [[Inline]]
chunks [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<>
                                 [Format -> Text -> Inline
RawInline Format
"tex" Text
"}"]
  where tohbox :: [Inline] -> [Inline]
tohbox [Inline]
ys = Format -> Text -> Inline
RawInline Format
"tex" Text
"\\hbox{\\strut " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ys [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<>
                    [Format -> Text -> Inline
RawInline Format
"tex" Text
"}"]

-- We also change display math to inline math, since display
-- math breaks in simple tables.
displayMathToInline :: Inline -> Inline
displayMathToInline :: Inline -> Inline
displayMathToInline (Math MathType
DisplayMath Text
x) = MathType -> Text -> Inline
Math MathType
InlineMath Text
x
displayMathToInline Inline
x                    = Inline
x

tableCellToLaTeX :: PandocMonad m
                 => Bool -> Int -> (Double, Alignment, [Block])
                 -> LW m (Doc Text)
tableCellToLaTeX :: Bool -> Int -> (Double, Alignment, [Block]) -> LW m (Doc Text)
tableCellToLaTeX Bool
_ Int
_    (Double
0,     Alignment
_,     [Block]
blocks) =
  [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX ([Block] -> LW m (Doc Text)) -> [Block] -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Block -> Block) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
fixLineBreaks ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
displayMathToInline [Block]
blocks
tableCellToLaTeX Bool
header Int
numcols (Double
width, Alignment
align, [Block]
blocks) = do
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  Bool
externalNotes <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stExternalNotes
  Bool
inMinipage <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInMinipage
  -- See #5367 -- footnotehyper/footnote don't work in beamer,
  -- so we need to produce the notes outside the table...
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stExternalNotes :: Bool
stExternalNotes = Bool
beamer,
                      stInMinipage :: Bool
stInMinipage = Bool
True }
  Doc Text
cellContents <- [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
blocks
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stExternalNotes :: Bool
stExternalNotes = Bool
externalNotes,
                      stInMinipage :: Bool
stInMinipage = Bool
inMinipage }
  let valign :: Doc Text
valign = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ if Bool
header then String
"[b]" else String
"[t]"
  let halign :: Doc Text
halign = case Alignment
align of
               Alignment
AlignLeft    -> Doc Text
"\\raggedright"
               Alignment
AlignRight   -> Doc Text
"\\raggedleft"
               Alignment
AlignCenter  -> Doc Text
"\\centering"
               Alignment
AlignDefault -> Doc Text
"\\raggedright"
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\\begin{minipage}" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
valign Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
           Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Int -> Double -> String
forall r. PrintfType r => String -> r
printf
              String
"(\\columnwidth - %d\\tabcolsep) * \\real{%.2f}"
              (Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Double
width)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
           Doc Text
halign Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
cellContents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\strut" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
           Doc Text
"\\end{minipage}"
-- (\columnwidth - 8\tabcolsep) * \real{0.15}

notesToLaTeX :: [Doc Text] -> Doc Text
notesToLaTeX :: [Doc Text] -> Doc Text
notesToLaTeX [] = Doc Text
forall a. Doc a
empty
notesToLaTeX [Doc Text]
ns = (case [Doc Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc Text]
ns of
                              Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> Doc Text
"\\addtocounter" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                           Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
"footnote" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                           Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
                                | Bool
otherwise -> Doc Text
forall a. Doc a
empty)
                   Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                   [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse
                     (Doc Text
"\\addtocounter" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
"footnote" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
"1")
                     ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Doc Text
x -> Doc Text
"\\footnotetext" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
x)
                     ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> [Doc Text]
forall a. [a] -> [a]
reverse [Doc Text]
ns)

listItemToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text)
listItemToLaTeX :: [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 =
    (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\item ~" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
lst
  | Plain (Str Text
"☐":Inline
Space:[Inline]
is) : [Block]
bs <- [Block]
lst = Bool -> [Inline] -> [Block] -> LW m (Doc Text)
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 = Bool -> [Inline] -> [Block] -> LW m (Doc Text)
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 = Bool -> [Inline] -> [Block] -> LW m (Doc Text)
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 = Bool -> [Inline] -> [Block] -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> [Inline] -> [Block] -> StateT WriterState m (Doc Text)
taskListItem Bool
True  [Inline]
is [Block]
bs
  | Bool
otherwise = (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\item" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> LW m (Doc Text)
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 <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
is
      Doc Text
bsContents <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
bs
      Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\\item" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
checkbox
        Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc Text
isContents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
bsContents)

defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m (Doc Text)
defListItemToLaTeX :: ([Inline], [[Block]]) -> LW m (Doc Text)
defListItemToLaTeX ([Inline]
term, [[Block]]
defs) = do
    -- needed to turn off 'listings' because it breaks inside \item[...]:
    (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stInItem :: Bool
stInItem = Bool
True}
    Doc Text
term' <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
term
    (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
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 (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Inline -> Bool
isInternalLink [Inline]
term
                    then Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
term'
                    else Doc Text
term'
    Doc Text
def'  <- case [[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Block]]
defs of
               [] -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
               (Block
x:[Block]
xs) -> do
                 (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stIsFirstInDefinition :: Bool
stIsFirstInDefinition = Bool
True }
                 Doc Text
firstitem <- Block -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX Block
x
                 (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{stIsFirstInDefinition :: Bool
stIsFirstInDefinition = Bool
False }
                 Doc Text
rest <- [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
xs
                 Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
firstitem Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
rest
    Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ case [[Block]]
defs of
     ((Header{} : [Block]
_) : [[Block]]
_)    ->
       Doc Text
"\\item" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
term'' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" ~ " Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
def'
     ((CodeBlock{} : [Block]
_) : [[Block]]
_) -> -- see #4662
       Doc Text
"\\item" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
term'' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" ~ " Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
def'
     [[Block]]
_                       ->
       Doc Text
"\\item" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
term'' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
def'

-- | Craft the section header, inserting the secton reference, if supplied.
sectionHeader :: PandocMonad m
              => [Text]  -- classes
              -> Text
              -> Int
              -> [Inline]
              -> LW m (Doc Text)
sectionHeader :: [Text] -> Text -> Int -> [Inline] -> LW m (Doc Text)
sectionHeader [Text]
classes Text
ident Int
level [Inline]
lst = do
  let unnumbered :: Bool
unnumbered = Text
"unnumbered" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  let unlisted :: Bool
unlisted = Text
"unlisted" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  Doc Text
txt <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
  Text
plain <- StringContext -> Text -> LW m Text
forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
TextString (Text -> LW m Text) -> Text -> LW m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Inline -> Text) -> [Inline] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
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 = (Inline -> [Inline] -> [Inline])
-> [Inline] -> [Inline] -> [Inline]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Inline] -> [Inline] -> [Inline]
forall a. Monoid a => a -> a -> a
mappend ([Inline] -> [Inline] -> [Inline])
-> (Inline -> [Inline]) -> Inline -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Inline
x -> (Inline -> [Inline]) -> Inline -> [Inline]
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)) [Inline]
forall a. Monoid a => a
mempty [Inline]
lst
  Doc Text
txtNoNotes <- [Inline] -> LW m (Doc Text)
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 [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Inline]
lst Bool -> Bool -> Bool
|| [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lstNoNotes
                 then Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
                 else
                   Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
txtNoNotes
  let contents :: Doc Text
contents = if Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
plain
                    then Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
txt
                    else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\texorpdfstring"
                         Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
txt
                         Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
plain))
  Bool
book <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHasChapters
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
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 TopLevelDivision -> TopLevelDivision -> Bool
forall a. Eq a => a -> a -> Bool
== TopLevelDivision
TopLevelDefault
                         then TopLevelDivision
TopLevelChapter
                         else WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
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 TopLevelDivision -> [TopLevelDivision] -> Bool
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then -Int
1 else Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
               else case TopLevelDivision
topLevelDivision of
                      TopLevelDivision
TopLevelPart    -> Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
                      TopLevelDivision
TopLevelChapter -> Int
level Int -> Int -> Int
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 <- (WriterState -> Bool) -> StateT WriterState m Bool
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' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4
                  then String -> Doc Text
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 Doc Text
forall a. Doc a
empty
  Doc Text
lab <- Text -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
labelFor Text
ident
  let star :: Doc Text
star = if Bool
unnumbered then String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"*" else Doc Text
forall a. Doc a
empty
  let stuffing :: Doc Text
stuffing = Doc Text
star Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
optional Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
  Doc Text
stuffing' <- Bool -> Text -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> Text -> Doc Text -> LW m (Doc Text)
hypertarget Bool
True Text
ident (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$
                  String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String
sectionType) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
stuffing Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
lab
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if Int
level' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5
              then Doc Text
txt
              else Doc Text
prefix Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
stuffing'
                   Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ if Bool
unnumbered Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
unlisted
                         then Doc Text
"\\addcontentsline{toc}" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
sectionType) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
txtNoNotes
                         else Doc Text
forall a. Doc a
empty

mapAlignment :: Text -> Text
mapAlignment :: Text -> Text
mapAlignment Text
a = case Text
a of
                   Text
"top" -> Text
"T"
                   Text
"top-baseline" -> Text
"t"
                   Text
"bottom" -> Text
"b"
                   Text
"center" -> Text
"c"
                   Text
_ -> Text
a 

wrapDiv :: PandocMonad m => Attr -> Doc Text -> LW m (Doc Text)
wrapDiv :: (Text, [Text], [(Text, Text)]) -> Doc Text -> LW m (Doc Text)
wrapDiv (Text
_,[Text]
classes,[(Text, Text)]
kvs) Doc Text
t = do
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  let align :: Doc Text -> Doc Text -> Doc Text
align Doc Text
dir Doc Text
txt = Text -> Doc Text -> Doc Text
inCmd Text
"begin" Doc Text
dir Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
txt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text -> Doc Text
inCmd Text
"end" Doc Text
dir
  Maybe Lang
lang <- Maybe Text -> StateT WriterState m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang (Maybe Text -> StateT WriterState m (Maybe Lang))
-> Maybe Text -> StateT WriterState m (Maybe Lang)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs
  let wrapColumns :: Doc Text -> Doc Text
wrapColumns = if Bool
beamer Bool -> Bool -> Bool
&& Text
"columns" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                    then \Doc Text
contents ->
                           let valign :: Text
valign = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"T" Text -> Text
mapAlignment (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"align" [(Text, Text)]
kvs)
                               totalwidth :: [Text]
totalwidth = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Text
"totalwidth=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x])
                                 (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"totalwidth" [(Text, Text)]
kvs)
                               onlytextwidth :: [Text]
onlytextwidth = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text
"onlytextwidth" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) [Text]
classes
                               options :: Doc Text
options = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                                 Text
valign Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
totalwidth [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
onlytextwidth 
                           in Text -> Doc Text -> Doc Text
inCmd Text
"begin" Doc Text
"columns" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
options
                              Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
                              Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text -> Doc Text
inCmd Text
"end" Doc Text
"columns"
                    else Doc Text -> Doc Text
forall a. a -> a
id
      wrapColumn :: Doc Text -> Doc Text
wrapColumn  = if Bool
beamer Bool -> Bool -> Bool
&& Text
"column" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                    then \Doc Text
contents ->
                           let valign :: Doc Text
valign =
                                 Doc Text -> (Text -> Doc Text) -> Maybe Text -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
""
                                 (Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text) -> (Text -> Doc Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> (Text -> String) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
mapAlignment)
                                 (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"align" [(Text, Text)]
kvs)
                               w :: Text
w = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"0.48" Text -> Text
fromPct (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [(Text, Text)]
kvs) 
                           in  Text -> Doc Text -> Doc Text
inCmd Text
"begin" Doc Text
"column" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> 
                               Doc Text
valign Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                               Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
w Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\textwidth")
                               Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
                               Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text -> Doc Text
inCmd Text
"end" Doc Text
"column"
                    else Doc Text -> Doc Text
forall a. a -> a
id
      fromPct :: Text -> Text
fromPct Text
xs =
        case Text -> Maybe (Text, Char)
T.unsnoc Text
xs of
          Just (Text
ds, Char
'%') -> case Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
ds of
                              Just Double
digits -> Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double
digits Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100 :: Double)
                              Maybe Double
Nothing -> Text
xs
          Maybe (Text, Char)
_              -> Text
xs
      wrapDir :: Doc Text -> Doc Text
wrapDir = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
                  Just Text
"rtl" -> Doc Text -> Doc Text -> Doc Text
align Doc Text
"RTL"
                  Just Text
"ltr" -> Doc Text -> Doc Text -> Doc Text
align Doc Text
"LTR"
                  Maybe Text
_          -> Doc Text -> Doc Text
forall a. a -> a
id
      wrapLang :: Doc Text -> Doc Text
wrapLang Doc Text
txt = case Maybe Lang
lang of
                       Just Lang
lng -> let (Text
l, Text
o) = Lang -> (Text, Text)
toPolyglossiaEnv Lang
lng
                                       ops :: Doc Text
ops = if Text -> Bool
T.null Text
o
                                             then Doc Text
""
                                             else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
o
                                   in  Text -> Doc Text -> Doc Text
inCmd Text
"begin" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
l) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
ops
                                       Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
txt Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
                                       Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text -> Doc Text
inCmd Text
"end" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
l)
                       Maybe Lang
Nothing  -> Doc Text
txt
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
wrapColumns (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
wrapColumn (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
wrapDir (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
wrapLang (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
t

hypertarget :: PandocMonad m => Bool -> Text -> Doc Text -> LW m (Doc Text)
hypertarget :: Bool -> Text -> Doc Text -> LW m (Doc Text)
hypertarget Bool
_ Text
"" Doc Text
x    = Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
x
hypertarget Bool
addnewline Text
ident Doc Text
x = do
  Doc Text
ref <- Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> StateT WriterState m Text -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> StateT WriterState m Text
forall (m :: * -> *). PandocMonad m => Text -> LW m Text
toLabel Text
ident
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\hypertarget"
              Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
ref
              Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces ((if Bool
addnewline Bool -> Bool -> Bool
&& Bool -> Bool
not (Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
x)
                             then Doc Text
"%" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
                             else Doc Text
forall a. Doc a
empty) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x)

labelFor :: PandocMonad m => Text -> LW m (Doc Text)
labelFor :: Text -> LW m (Doc Text)
labelFor Text
""    = Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
labelFor Text
ident = do
  Doc Text
ref <- Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> StateT WriterState m Text -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> StateT WriterState m Text
forall (m :: * -> *). PandocMonad m => Text -> LW m Text
toLabel Text
ident
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\label" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
ref

-- | Convert list of inline elements to LaTeX.
inlineListToLaTeX :: PandocMonad m
                  => [Inline]  -- ^ Inlines to convert
                  -> LW m (Doc Text)
inlineListToLaTeX :: [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Inline -> LW m (Doc Text))
-> [Inline] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> LW m (Doc Text)
inlineToLaTeX ([Inline] -> [Inline]
fixLineInitialSpaces ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
fixInitialLineBreaks ([Inline] -> [Inline]) -> [Inline] -> [Inline]
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 Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> [Inline]
fixNbsps Text
s [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline] -> [Inline]
fixLineInitialSpaces [Inline]
xs
       fixLineInitialSpaces (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\160') Text
s
                    in  Int -> Inline -> [Inline]
forall a. Int -> a -> [a]
replicate (Text -> Int
T.length Text
ys) Inline
hspace [Inline] -> [Inline] -> [Inline]
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" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:
           [Inline] -> [Inline]
fixInitialLineBreaks [Inline]
xs
       fixInitialLineBreaks [Inline]
xs = [Inline]
xs

isQuoted :: Inline -> Bool
isQuoted :: Inline -> Bool
isQuoted (Quoted QuoteType
_ [Inline]
_) = Bool
True
isQuoted Inline
_            = Bool
False

cslEntryToLaTeX :: PandocMonad m
                => Block
                -> LW m (Doc Text)
cslEntryToLaTeX :: Block -> LW m (Doc Text)
cslEntryToLaTeX (Para [Inline]
xs) =
  [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> LW m (Doc Text))
-> [Inline] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> LW m (Doc Text)
go [Inline]
xs
 where
   go :: Inline -> StateT WriterState m (Doc Text)
go (Span (Text
"",[Text
"csl-block"],[]) [Inline]
ils) =
     (Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Doc Text
inCmd Text
"CSLBlock" (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
ils
   go (Span (Text
"",[Text
"csl-left-margin"],[]) [Inline]
ils) =
     Text -> Doc Text -> Doc Text
inCmd Text
"CSLLeftMargin" (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
ils
   go (Span (Text
"",[Text
"csl-right-inline"],[]) [Inline]
ils) =
     (Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Doc Text
inCmd Text
"CSLRightInline" (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
ils
   go (Span (Text
"",[Text
"csl-indent"],[]) [Inline]
ils) =
     (Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Doc Text
inCmd Text
"CSLIndent" (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
ils
   go Inline
il = Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> LW m (Doc Text)
inlineToLaTeX Inline
il
cslEntryToLaTeX Block
x = Block -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> LW m (Doc Text)
blockToLaTeX Block
x

-- | Convert inline element to LaTeX
inlineToLaTeX :: PandocMonad m
              => Inline    -- ^ Inline to convert
              -> LW m (Doc Text)
inlineToLaTeX :: Inline -> LW m (Doc Text)
inlineToLaTeX (Span (Text
id',[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils) = do
  Doc Text
linkAnchor <- Bool -> Text -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> Text -> Doc Text -> LW m (Doc Text)
hypertarget Bool
False Text
id' Doc Text
forall a. Doc a
empty
  Maybe Lang
lang <- Maybe Text -> StateT WriterState m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang (Maybe Text -> StateT WriterState m (Maybe Lang))
-> Maybe Text -> StateT WriterState m (Maybe Lang)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs
  let cmds :: [Text]
cmds = [Text
"textup" | Text
"csl-no-emph" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
             [Text
"textnormal" | Text
"csl-no-strong" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes Bool -> Bool -> Bool
||
                             Text
"csl-no-smallcaps" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
             [Text
"RL" | (Text
"dir", Text
"rtl") (Text, Text) -> [(Text, Text)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Text, Text)]
kvs] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
             [Text
"LR" | (Text
"dir", Text
"ltr") (Text, Text) -> [(Text, Text)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Text, Text)]
kvs] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
             (case Maybe Lang
lang of
                Just Lang
lng -> let (Text
l, Text
o) = Lang -> (Text, Text)
toPolyglossia Lang
lng
                                ops :: Text
ops = if Text -> Bool
T.null Text
o then Text
"" else Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
                            in  [Text
"text" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ops]
                Maybe Lang
Nothing  -> [])
  Doc Text
contents <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
ils
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if Text -> Bool
T.null Text
id'
               then Doc Text
forall a. Doc a
empty
               else Doc Text
"\\protect" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linkAnchor) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
           (if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cmds
               then Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
               else (Text -> Doc Text -> Doc Text) -> Doc Text -> [Text] -> Doc Text
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" (Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (Underline [Inline]
lst) = Text -> Doc Text -> Doc Text
inCmd Text
"underline" (Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (Strong [Inline]
lst) = Text -> Doc Text -> Doc Text
inCmd Text
"textbf" (Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> LW m (Doc Text)
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 <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX ([Inline] -> LW m (Doc Text)) -> [Inline] -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk ((Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
protectCode) [Inline]
lst
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stStrikeout :: Bool
stStrikeout = Bool
True }
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
inCmd Text
"sout" Doc Text
contents
inlineToLaTeX (Superscript [Inline]
lst) =
  Text -> Doc Text -> Doc Text
inCmd Text
"textsuperscript" (Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (Subscript [Inline]
lst) =
  Text -> Doc Text -> Doc Text
inCmd Text
"textsubscript" (Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (SmallCaps [Inline]
lst) =
  Text -> Doc Text -> Doc Text
inCmd Text
"textsc"(Doc Text -> Doc Text) -> LW m (Doc Text) -> LW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
inlineToLaTeX (Cite [Citation]
cits [Inline]
lst) = do
  WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
  let opts :: WriterOptions
opts = WriterState -> WriterOptions
stOptions WriterState
st
  case WriterOptions -> CiteMethod
writerCiteMethod WriterOptions
opts of
     CiteMethod
Natbib   -> [Citation] -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Citation] -> LW m (Doc Text)
citationsToNatbib [Citation]
cits
     CiteMethod
Biblatex -> [Citation] -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Citation] -> LW m (Doc Text)
citationsToBiblatex [Citation]
cits
     CiteMethod
_        -> [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst

inlineToLaTeX (Code (Text
_,[Text]
classes,[(Text, Text)]
kvs) Text
str) = do
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  Bool
inHeading <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInHeading
  Bool
inItem <- (WriterState -> Bool) -> StateT WriterState m Bool
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)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:)
                                Maybe Text
Nothing -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> a
id)
                           [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs
                                  , Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"exports",Text
"tangle",Text
"results"]]
        let listingsopt :: Text
listingsopt = if [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
listingsopts
                             then Text
""
                             else Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                  Text -> [Text] -> Text
T.intercalate Text
", "
                                  (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Text
v) -> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v)
                                   [(Text, Text)]
listingsopts) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
        Bool
inNote <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInNote
        Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
inNote (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stVerbInNote :: Bool
stVerbInNote = Bool
True }
        let chr :: Char
chr = case String
"!\"'()*,-./:;?@" String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
\\ Text -> String
T.unpack Text
str of
                       (Char
c:String
_) -> Char
c
                       []    -> Char
'!'
        let str' :: Text
str' = [(Char, Text)] -> Text -> Text
escapeStringUsing (String -> [(Char, Text)]
backslashEscapes String
"\\{}%~_&#^") 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:
        Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"\\passthrough{\\lstinline" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                        Text
listingsopt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
chr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
chr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
  let rawCode :: LW m (Doc Text)
rawCode = (Text -> Doc Text) -> StateT WriterState m Text -> LW m (Doc Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Text
s -> Text
"\\texttt{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeSpaces Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"))
                 (StateT WriterState m Text -> LW m (Doc Text))
-> StateT WriterState m Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ StringContext -> Text -> StateT WriterState m Text
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 Char -> Char -> Bool
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 SyntaxMap
-> (FormatOptions -> [SourceLine] -> Text)
-> (Text, [Text], [(Text, Text)])
-> Text
-> Either Text Text
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
                 Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
                 LW m (Doc Text)
rawCode
               Right Text
h -> (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stHighlighting :: Bool
stHighlighting = Bool
True }) StateT WriterState m () -> LW m (Doc Text) -> LW m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Doc Text
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
       | Maybe Style -> Bool
forall a. Maybe a -> Bool
isJust (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
opts) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Text] -> Bool
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 <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
lst
  Bool
csquotes <- (WriterState -> Bool)
-> StateT WriterState m WriterState -> StateT WriterState m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM WriterState -> Bool
stCsquotes StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  if Bool
csquotes
     then Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ case QuoteType
qt of
               QuoteType
DoubleQuote -> Doc Text
"\\enquote" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
               QuoteType
SingleQuote -> Doc Text
"\\enquote*" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
     else do
       let s1 :: Doc Text
s1 = if Bool -> Bool
not ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst) Bool -> Bool -> Bool
&& Inline -> Bool
isQuoted ([Inline] -> Inline
forall a. [a] -> a
head [Inline]
lst)
                   then Doc Text
"\\,"
                   else Doc Text
forall a. Doc a
empty
       let s2 :: Doc Text
s2 = if Bool -> Bool
not ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst) Bool -> Bool -> Bool
&& Inline -> Bool
isQuoted ([Inline] -> Inline
forall a. [a] -> a
last [Inline]
lst)
                   then Doc Text
"\\,"
                   else Doc Text
forall a. Doc a
empty
       let inner :: Doc Text
inner = Doc Text
s1 Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
s2
       Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ case QuoteType
qt of
                QuoteType
DoubleQuote ->
                   if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
                      then String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"``" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
inner Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"''"
                      else Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'\x201C' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
inner Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'\x201D'
                QuoteType
SingleQuote ->
                   if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
                      then Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'`' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
inner Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'\''
                      else Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'\x2018' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
inner Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'\x2019'
inlineToLaTeX (Str Text
str) = do
  Bool -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
  (Text -> Doc Text) -> StateT WriterState m Text -> LW m (Doc Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (StateT WriterState m Text -> LW m (Doc Text))
-> StateT WriterState m Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ StringContext -> Text -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
TextString Text
str
inlineToLaTeX (Math MathType
InlineMath Text
str) = do
  Bool -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\\(" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
handleMathComment Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\)"
inlineToLaTeX (Math MathType
DisplayMath Text
str) = do
  Bool -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\\[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
handleMathComment Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\]"
inlineToLaTeX il :: Inline
il@(RawInline Format
f Text
str) = do
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  if Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex" Bool -> Bool -> Bool
||
        (Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"beamer" Bool -> Bool -> Bool
&& Bool
beamer)
     then do
       Bool -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
       Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
     else do
       LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
       Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToLaTeX Inline
LineBreak = do
  Bool
emptyLine <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stEmptyLine
  Bool -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
True
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if Bool
emptyLine then Doc Text
"~" else Doc Text
"") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\\\" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToLaTeX Inline
SoftBreak = do
  WrapOption
wrapText <- (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions)
  case WrapOption
wrapText of
       WrapOption
WrapAuto     -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
       WrapOption
WrapNone     -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
       WrapOption
WrapPreserve -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
inlineToLaTeX Inline
Space = Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
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 <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
txt
        Text
lab <- Text -> StateT WriterState m Text
forall (m :: * -> *). PandocMonad m => Text -> LW m Text
toLabel Text
ident
        Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\protect\\hyperlink" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
lab) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents
     Maybe (Char, Text)
_ -> case [Inline]
txt of
          [Str Text
x] | String -> String
unEscapeString (Text -> String
T.unpack Text
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> String
unEscapeString (Text -> String
T.unpack Text
src) ->  -- autolink
               do (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stUrl :: Bool
stUrl = Bool
True }
                  Text
src' <- StringContext -> Text -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
URLString (Text -> Text
escapeURI Text
src)
                  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"\\url{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src' Text -> Text -> Text
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) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> String
unEscapeString (Text -> String
T.unpack Text
rest) -> -- email autolink
               do (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stUrl :: Bool
stUrl = Bool
True }
                  Text
src' <- StringContext -> Text -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
URLString (Text -> Text
escapeURI Text
src)
                  Doc Text
contents <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
txt
                  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\\href" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
src') Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                     Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text
"\\nolinkurl" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents)
          [Inline]
_ -> do Doc Text
contents <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
txt
                  Text
src' <- StringContext -> Text -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
URLString (Text -> Text
escapeURI Text
src)
                  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"\\href{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}{") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                           Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'}')
     LW m (Doc Text) -> (Doc Text -> LW m (Doc Text)) -> LW m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (if Text -> Bool
T.null Text
id'
             then Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return
             else \Doc Text
x -> do
               Doc Text
linkAnchor <- Bool -> Text -> Doc Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Bool -> Text -> Doc Text -> LW m (Doc Text)
hypertarget Bool
False Text
id' Doc Text
x
               Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
"\\protect" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linkAnchor))
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
      LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToLaTeX (Image (Text, [Text], [(Text, Text)])
attr [Inline]
_ (Text
source, Text
_)) = do
  Bool -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stGraphics :: Bool
stGraphics = Bool
True }
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let showDim :: Direction -> [Doc Text]
showDim Direction
dir = let d :: Doc Text
d = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Direction -> String
forall a. Show a => a -> String
show Direction
dir) Doc Text -> Doc Text -> Doc Text
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 Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Dimension -> Text
showInInch WriterOptions
opts (Integer -> Dimension
Pixel Integer
a)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"in"]
                         Just (Percent Double
a) ->
                           [Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                             case Direction
dir of
                                Direction
Width  -> Doc Text
"\\textwidth"
                                Direction
Height -> Doc Text
"\\textheight"
                           ]
                         Just Dimension
dim         ->
                           [Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Dimension -> String
forall a. Show a => a -> String
show Dimension
dim)]
                         Maybe Dimension
Nothing          ->
                           case Direction
dir of
                                Direction
Width | Maybe Dimension -> Bool
forall a. Maybe a -> Bool
isJust (Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Height (Text, [Text], [(Text, Text)])
attr) ->
                                  [Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\textwidth"]
                                Direction
Height | Maybe Dimension -> Bool
forall a. Maybe a -> Bool
isJust (Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Width (Text, [Text], [(Text, Text)])
attr) ->
                                  [Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\textheight"]
                                Direction
_ -> []
      dimList :: [Doc Text]
dimList = Direction -> [Doc Text]
showDim Direction
Width [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. Semigroup a => a -> a -> a
<> Direction -> [Doc Text]
showDim Direction
Height
      dims :: Doc Text
dims = if [Doc Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
dimList
                then Doc Text
forall a. Doc a
empty
                else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
"," [Doc Text]
dimList)
      source' :: Text
source' = if Text -> Bool
isURI Text
source
                   then Text
source
                   else String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
unEscapeString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
source
  Text
source'' <- StringContext -> Text -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
URLString Text
source'
  Bool
inHeading <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInHeading
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$
    (if Bool
inHeading then Doc Text
"\\protect\\includegraphics" else Doc Text
"\\includegraphics") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
    Doc Text
dims Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
source'')
inlineToLaTeX (Note [Block]
contents) = do
  Bool -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => Bool -> LW m ()
setEmptyLine Bool
False
  Bool
externalNotes <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stExternalNotes
  (WriterState -> WriterState) -> StateT WriterState m ()
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' <- [Block] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> LW m (Doc Text)
blockListToLaTeX [Block]
contents
  (WriterState -> WriterState) -> StateT WriterState m ()
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 [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
contents of
                   (CodeBlock (Text, [Text], [(Text, Text)])
_ Text
_ : [Block]
_) -> Doc a
forall a. Doc a
cr
                   [Block]
_                   -> Doc a
forall a. Doc a
empty
  let noteContents :: Doc Text
noteContents = Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 Doc Text
contents' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
optnl
  Bool
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
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 String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"<.->"
                      else Doc Text
forall a. Doc a
empty
  if Bool
externalNotes
     then do
       (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stNotes :: [Doc Text]
stNotes = Doc Text
noteContents Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
: WriterState -> [Doc Text]
stNotes WriterState
st }
       Doc Text -> LW m (Doc Text)
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 Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\\footnote" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
beamerMark Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%') (Text -> (Text, Text)) -> Text -> (Text, Text)
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 Text -> Text -> Text
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 :: Bool -> LW m ()
setEmptyLine Bool
b = (WriterState -> WriterState) -> LW m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> LW m ())
-> (WriterState -> WriterState) -> LW m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stEmptyLine :: Bool
stEmptyLine = Bool
b }

citationsToNatbib :: PandocMonad m => [Citation] -> LW m (Doc Text)
citationsToNatbib :: [Citation] -> LW m (Doc Text)
citationsToNatbib
            [Citation
one]
  = Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeCommand Text
c [Inline]
p [Inline]
s Text
k
  where
    Citation { citationId :: Citation -> Text
citationId = Text
k
             , citationPrefix :: Citation -> [Inline]
citationPrefix = [Inline]
p
             , citationSuffix :: Citation -> [Inline]
citationSuffix = [Inline]
s
             , citationMode :: Citation -> CitationMode
citationMode = CitationMode
m
             }
      = Citation
one
    c :: Text
c = case CitationMode
m of
             CitationMode
AuthorInText   -> Text
"citet"
             CitationMode
SuppressAuthor -> Text
"citeyearpar"
             CitationMode
NormalCitation -> Text
"citep"

citationsToNatbib [Citation]
cits
  | [Citation] -> Bool
noPrefix ([Citation] -> [Citation]
forall a. [a] -> [a]
tail [Citation]
cits) Bool -> Bool -> Bool
&& [Citation] -> Bool
noSuffix ([Citation] -> [Citation]
forall a. [a] -> [a]
init [Citation]
cits) Bool -> Bool -> Bool
&& CitationMode -> [Citation] -> Bool
forall (t :: * -> *).
Foldable t =>
CitationMode -> t Citation -> Bool
ismode CitationMode
NormalCitation [Citation]
cits
  = Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeCommand Text
"citep" [Inline]
p [Inline]
s Text
ks
  where
     noPrefix :: [Citation] -> Bool
noPrefix  = (Citation -> Bool) -> [Citation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Inline] -> Bool) -> (Citation -> [Inline]) -> Citation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [Inline]
citationPrefix)
     noSuffix :: [Citation] -> Bool
noSuffix  = (Citation -> Bool) -> [Citation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Inline] -> Bool) -> (Citation -> [Inline]) -> Citation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [Inline]
citationSuffix)
     ismode :: CitationMode -> t Citation -> Bool
ismode CitationMode
m  = (Citation -> Bool) -> t Citation -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
(==) CitationMode
m  (CitationMode -> Bool)
-> (Citation -> CitationMode) -> Citation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> CitationMode
citationMode)
     p :: [Inline]
p         = Citation -> [Inline]
citationPrefix  (Citation -> [Inline]) -> Citation -> [Inline]
forall a b. (a -> b) -> a -> b
$
                 [Citation] -> Citation
forall a. [a] -> a
head [Citation]
cits
     s :: [Inline]
s         = Citation -> [Inline]
citationSuffix  (Citation -> [Inline]) -> Citation -> [Inline]
forall a b. (a -> b) -> a -> b
$
                 [Citation] -> Citation
forall a. [a] -> a
last [Citation]
cits
     ks :: Text
ks        = Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Citation -> Text) -> [Citation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Citation -> Text
citationId [Citation]
cits

citationsToNatbib (Citation
c:[Citation]
cs) | Citation -> CitationMode
citationMode Citation
c CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
AuthorInText = do
     Doc Text
author <- Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeCommand Text
"citeauthor" [] [] (Citation -> Text
citationId Citation
c)
     Doc Text
cits   <- [Citation] -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Citation] -> LW m (Doc Text)
citationsToNatbib (Citation
c { citationMode :: CitationMode
citationMode = CitationMode
SuppressAuthor } Citation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
: [Citation]
cs)
     Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
author Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
cits

citationsToNatbib [Citation]
cits = do
  [Doc Text]
cits' <- (Citation -> LW m (Doc Text))
-> [Citation] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Citation -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Citation -> LW m (Doc Text)
convertOne [Citation]
cits
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\citetext{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (Doc Text -> Doc Text -> Doc Text)
-> Doc Text -> [Doc Text] -> Doc Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Doc Text -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a -> Doc a
combineTwo Doc Text
forall a. Doc a
empty [Doc Text]
cits' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"}"
  where
    combineTwo :: Doc a -> Doc a -> Doc a
combineTwo Doc a
a Doc a
b | Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
a = Doc a
b
                   | Bool
otherwise = Doc a
a Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> String -> Doc a
forall a. HasChars a => String -> Doc a
text String
"; " Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
b
    convertOne :: Citation -> LW m (Doc Text)
convertOne Citation { citationId :: Citation -> Text
citationId = Text
k
                        , citationPrefix :: Citation -> [Inline]
citationPrefix = [Inline]
p
                        , citationSuffix :: Citation -> [Inline]
citationSuffix = [Inline]
s
                        , citationMode :: Citation -> CitationMode
citationMode = CitationMode
m
                        }
        = case CitationMode
m of
               CitationMode
AuthorInText   -> Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeCommand Text
"citealt"  [Inline]
p [Inline]
s Text
k
               CitationMode
SuppressAuthor -> Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeCommand Text
"citeyear" [Inline]
p [Inline]
s Text
k
               CitationMode
NormalCitation -> Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeCommand Text
"citealp"  [Inline]
p [Inline]
s Text
k

citeCommand :: PandocMonad m
            => Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeCommand :: Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeCommand Text
c [Inline]
p [Inline]
s Text
k = do
  Doc Text
args <- [Inline] -> [Inline] -> Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeArguments [Inline]
p [Inline]
s Text
k
  Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
args

type Prefix = [Inline]
type Suffix = [Inline]
type CiteId = Text
data CiteGroup = CiteGroup Prefix Suffix [CiteId]

citeArgumentsList :: PandocMonad m
              => CiteGroup -> LW m (Doc Text)
citeArgumentsList :: CiteGroup -> LW m (Doc Text)
citeArgumentsList (CiteGroup [Inline]
_ [Inline]
_ []) = Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
citeArgumentsList (CiteGroup [Inline]
pfxs [Inline]
sfxs [Text]
ids) = do
      Doc Text
pdoc <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
pfxs
      Doc Text
sdoc <- [Inline] -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> LW m (Doc Text)
inlineListToLaTeX [Inline]
sfxs'
      Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a -> Doc a
optargs Doc Text
pdoc Doc Text
sdoc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
              Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
ids)))
      where sfxs' :: [Inline]
sfxs' = [Inline] -> [Inline]
stripLocatorBraces ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ case [Inline]
sfxs of
                (Str Text
t : [Inline]
r) -> case Text -> Maybe (Char, Text)
T.uncons Text
t of
                  Just (Char
x, Text
xs)
                    | Text -> Bool
T.null Text
xs
                    , Char -> Bool
isPunctuation Char
x -> (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
Space) [Inline]
r
                    | Char -> Bool
isPunctuation Char
x -> Text -> Inline
Str Text
xs Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
r
                  Maybe (Char, Text)
_ -> [Inline]
sfxs
                [Inline]
_   -> [Inline]
sfxs
            optargs :: Doc a -> Doc a -> Doc a
optargs Doc a
pdoc Doc a
sdoc = case (Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
pdoc, Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
sdoc) of
                 (Bool
True, Bool
True ) -> Doc a
forall a. Doc a
empty
                 (Bool
True, Bool
False) -> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
brackets Doc a
sdoc
                 (Bool
_   , Bool
_    ) -> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
brackets Doc a
pdoc Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
brackets Doc a
sdoc

citeArguments :: PandocMonad m
              => [Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeArguments :: [Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeArguments [Inline]
p [Inline]
s Text
k = CiteGroup -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => CiteGroup -> LW m (Doc Text)
citeArgumentsList ([Inline] -> [Inline] -> [Text] -> CiteGroup
CiteGroup [Inline]
p [Inline]
s [Text
k])

-- strip off {} used to define locator in pandoc-citeproc; see #5722
stripLocatorBraces :: [Inline] -> [Inline]
stripLocatorBraces :: [Inline] -> [Inline]
stripLocatorBraces = (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
go
  where go :: Inline -> Inline
go (Str Text
xs) = Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'{' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') Text
xs
        go Inline
x        = Inline
x

citationsToBiblatex :: PandocMonad m => [Citation] -> LW m (Doc Text)
citationsToBiblatex :: [Citation] -> LW m (Doc Text)
citationsToBiblatex
            [Citation
one]
  = Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text)
citeCommand Text
cmd [Inline]
p [Inline]
s Text
k
    where
       Citation { citationId :: Citation -> Text
citationId = Text
k
                , citationPrefix :: Citation -> [Inline]
citationPrefix = [Inline]
p
                , citationSuffix :: Citation -> [Inline]
citationSuffix = [Inline]
s
                , citationMode :: Citation -> CitationMode
citationMode = CitationMode
m
                } = Citation
one
       cmd :: Text
cmd = case CitationMode
m of
                  CitationMode
SuppressAuthor -> Text
"autocite*"
                  CitationMode
AuthorInText   -> Text
"textcite"
                  CitationMode
NormalCitation -> Text
"autocite"

citationsToBiblatex (Citation
c:[Citation]
cs)
  | (Citation -> Bool) -> [Citation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Citation
cit -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Citation -> [Inline]
citationPrefix Citation
cit) Bool -> Bool -> Bool
&& [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Citation -> [Inline]
citationSuffix Citation
cit)) (Citation
cCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cs)
    = do
      let cmd :: String
cmd = case Citation -> CitationMode
citationMode Citation
c of
                    CitationMode
SuppressAuthor -> String
"\\autocite*"
                    CitationMode
AuthorInText   -> String
"\\textcite"
                    CitationMode
NormalCitation -> String
"\\autocite"
      Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
cmd Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
               Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> [Text] -> Text
T.intercalate Text
"," ((Citation -> Text) -> [Citation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Citation -> Text
citationId (Citation
cCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cs))))
  | Bool
otherwise
    = do
      let cmd :: String
cmd = case Citation -> CitationMode
citationMode Citation
c of
                    CitationMode
SuppressAuthor -> String
"\\autocites*"
                    CitationMode
AuthorInText   -> String
"\\textcites"
                    CitationMode
NormalCitation -> String
"\\autocites"

      [Doc Text]
groups <- (CiteGroup -> LW m (Doc Text))
-> [CiteGroup] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CiteGroup -> LW m (Doc Text)
forall (m :: * -> *). PandocMonad m => CiteGroup -> LW m (Doc Text)
citeArgumentsList ([CiteGroup] -> [CiteGroup]
forall a. [a] -> [a]
reverse (([CiteGroup] -> Citation -> [CiteGroup])
-> [CiteGroup] -> [Citation] -> [CiteGroup]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [CiteGroup] -> Citation -> [CiteGroup]
grouper [] (Citation
cCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cs)))

      Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
cmd Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Doc Text]
groups

  where grouper :: [CiteGroup] -> Citation -> [CiteGroup]
grouper [CiteGroup]
prev Citation
cit = case [CiteGroup]
prev of
         ((CiteGroup [Inline]
oPfx [Inline]
oSfx [Text]
ids):[CiteGroup]
rest)
             | [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
oSfx Bool -> Bool -> Bool
&& [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
pfx -> [Inline] -> [Inline] -> [Text] -> CiteGroup
CiteGroup [Inline]
oPfx [Inline]
sfx (Text
cidText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ids) CiteGroup -> [CiteGroup] -> [CiteGroup]
forall a. a -> [a] -> [a]
: [CiteGroup]
rest
         [CiteGroup]
_ -> [Inline] -> [Inline] -> [Text] -> CiteGroup
CiteGroup [Inline]
pfx [Inline]
sfx [Text
cid] CiteGroup -> [CiteGroup] -> [CiteGroup]
forall a. a -> [a] -> [a]
: [CiteGroup]
prev
         where pfx :: [Inline]
pfx = Citation -> [Inline]
citationPrefix Citation
cit
               sfx :: [Inline]
sfx = Citation -> [Inline]
citationSuffix Citation
cit
               cid :: Text
cid = Citation -> Text
citationId Citation
cit

citationsToBiblatex [Citation]
_ = Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty

-- Determine listings language from list of class attributes.
getListingsLanguage :: [Text] -> Maybe Text
getListingsLanguage :: [Text] -> Maybe Text
getListingsLanguage [Text]
xs
  = (Text -> Maybe Text -> Maybe Text)
-> Maybe Text -> [Text] -> Maybe Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Maybe Text -> Maybe Text -> Maybe Text)
-> (Text -> Maybe Text) -> Text -> Maybe Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
toListingsLanguage) Maybe Text
forall a. Maybe a
Nothing [Text]
xs

mbBraced :: Text -> Text
mbBraced :: Text -> Text
mbBraced Text
x = if Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlphaNum Text
x)
                then Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
                else Text
x

-- 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)      = (Inline -> [Text]) -> [Inline] -> [Text]
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)       = (Inline -> [Text]) -> [Inline] -> [Text]
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) = (Inline -> [Text]) -> [Inline] -> [Text]
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) =  [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
T.words (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
key [(Text, Text)]
kvs

-- In environments \Arabic instead of \arabic is used
toPolyglossiaEnv :: Lang -> (Text, Text)
toPolyglossiaEnv :: Lang -> (Text, Text)
toPolyglossiaEnv Lang
l =
  case Lang -> (Text, Text)
toPolyglossia Lang
l of
    (Text
"arabic", Text
o) -> (Text
"Arabic", Text
o)
    (Text, Text)
x             -> (Text, Text)
x

-- Takes a list of the constituents of a BCP 47 language code and
-- converts it to a Polyglossia (language, options) tuple
-- http://mirrors.ctan.org/macros/latex/contrib/polyglossia/polyglossia.pdf
toPolyglossia :: Lang -> (Text, Text)
toPolyglossia :: Lang -> (Text, Text)
toPolyglossia (Lang Text
"ar" Text
_ Text
"DZ" [Text]
_)        = (Text
"arabic", Text
"locale=algeria")
toPolyglossia (Lang Text
"ar" Text
_ Text
"IQ" [Text]
_)        = (Text
"arabic", Text
"locale=mashriq")
toPolyglossia (Lang Text
"ar" Text
_ Text
"JO" [Text]
_)        = (Text
"arabic", Text
"locale=mashriq")
toPolyglossia (Lang Text
"ar" Text
_ Text
"LB" [Text]
_)        = (Text
"arabic", Text
"locale=mashriq")
toPolyglossia (Lang Text
"ar" Text
_ Text
"LY" [Text]
_)        = (Text
"arabic", Text
"locale=libya")
toPolyglossia (Lang Text
"ar" Text
_ Text
"MA" [Text]
_)        = (Text
"arabic", Text
"locale=morocco")
toPolyglossia (Lang Text
"ar" Text
_ Text
"MR" [Text]
_)        = (Text
"arabic", Text
"locale=mauritania")
toPolyglossia (Lang Text
"ar" Text
_ Text
"PS" [Text]
_)        = (Text
"arabic", Text
"locale=mashriq")
toPolyglossia (Lang Text
"ar" Text
_ Text
"SY" [Text]
_)        = (Text
"arabic", Text
"locale=mashriq")
toPolyglossia (Lang Text
"ar" Text
_ Text
"TN" [Text]
_)        = (Text
"arabic", Text
"locale=tunisia")
toPolyglossia (Lang Text
"de" Text
_ Text
_ [Text]
vars)
  | Text
"1901" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
vars                    = (Text
"german", Text
"spelling=old")
toPolyglossia (Lang Text
"de" Text
_ Text
"AT" [Text]
vars)
  | Text
"1901" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
vars                    = (Text
"german", Text
"variant=austrian, spelling=old")
toPolyglossia (Lang Text
"de" Text
_ Text
"AT" [Text]
_)        = (Text
"german", Text
"variant=austrian")
toPolyglossia (Lang Text
"de" Text
_ Text
"CH" [Text]
vars)
  | Text
"1901" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
vars                    = (Text
"german", Text
"variant=swiss, spelling=old")
toPolyglossia (Lang Text
"de" Text
_ Text
"CH" [Text]
_)        = (Text
"german", Text
"variant=swiss")
toPolyglossia (Lang Text
"de" Text
_ Text
_ [Text]
_)           = (Text
"german", Text
"")
toPolyglossia (Lang Text
"dsb" Text
_ Text
_ [Text]
_)          = (Text
"lsorbian", Text
"")
toPolyglossia (Lang Text
"el" Text
_ Text
"polyton" [Text]
_)   = (Text
"greek",   Text
"variant=poly")
toPolyglossia (Lang Text
"en" Text
_ Text
"AU" [Text]
_)        = (Text
"english", Text
"variant=australian")
toPolyglossia (Lang Text
"en" Text
_ Text
"CA" [Text]
_)        = (Text
"english", Text
"variant=canadian")
toPolyglossia (Lang Text
"en" Text
_ Text
"GB" [Text]
_)        = (Text
"english", Text
"variant=british")
toPolyglossia (Lang Text
"en" Text
_ Text
"NZ" [Text]
_)        = (Text
"english", Text
"variant=newzealand")
toPolyglossia (Lang Text
"en" Text
_ Text
"UK" [Text]
_)        = (Text
"english", Text
"variant=british")
toPolyglossia (Lang Text
"en" Text
_ Text
"US" [Text]
_)        = (Text
"english", Text
"variant=american")
toPolyglossia (Lang Text
"grc" Text
_ Text
_ [Text]
_)          = (Text
"greek",   Text
"variant=ancient")
toPolyglossia (Lang Text
"hsb" Text
_ Text
_  [Text]
_)         = (Text
"usorbian", Text
"")
toPolyglossia (Lang Text
"la" Text
_ Text
_ [Text]
vars)
  | Text
"x-classic" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
vars               = (Text
"latin", Text
"variant=classic")
toPolyglossia (Lang Text
"pt" Text
_ Text
"BR" [Text]
_)        = (Text
"portuguese", Text
"variant=brazilian")
toPolyglossia (Lang Text
"sl" Text
_ Text
_ [Text]
_)           = (Text
"slovenian", Text
"")
toPolyglossia Lang
x                           = (Lang -> Text
commonFromBcp47 Lang
x, Text
"")

-- Takes a list of the constituents of a BCP 47 language code and
-- converts it to a Babel language string.
-- http://mirrors.ctan.org/macros/latex/required/babel/base/babel.pdf
-- List of supported languages (slightly outdated):
-- http://tug.ctan.org/language/hyph-utf8/doc/generic/hyph-utf8/hyphenation.pdf
toBabel :: Lang -> Text
toBabel :: Lang -> Text
toBabel (Lang Text
"de" Text
_ Text
"AT" [Text]
vars)
  | Text
"1901" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
vars                  = Text
"austrian"
  | Bool
otherwise                           = Text
"naustrian"
toBabel (Lang Text
"de" Text
_ Text
"CH" [Text]
vars)
  | Text
"1901" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
vars                  = Text
"swissgerman"
  | Bool
otherwise                           = Text
"nswissgerman"
toBabel (Lang Text
"de" Text
_ Text
_ [Text]
vars)
  | Text
"1901" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
vars                  = Text
"german"
  | Bool
otherwise                           = Text
"ngerman"
toBabel (Lang Text
"dsb" Text
_ Text
_ [Text]
_)              = Text
"lowersorbian"
toBabel (Lang Text
"el" Text
_ Text
_ [Text]
vars)
  | Text
"polyton" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
vars               = Text
"polutonikogreek"
toBabel (Lang Text
"en" Text
_ Text
"AU" [Text]
_)            = Text
"australian"
toBabel (Lang Text
"en" Text
_ Text
"CA" [Text]
_)            = Text
"canadian"
toBabel (Lang Text
"en" Text
_ Text
"GB" [Text]
_)            = Text
"british"
toBabel (Lang Text
"en" Text
_ Text
"NZ" [Text]
_)            = Text
"newzealand"
toBabel (Lang Text
"en" Text
_ Text
"UK" [Text]
_)            = Text
"british"
toBabel (Lang Text
"en" Text
_ Text
"US" [Text]
_)            = Text
"american"
toBabel (Lang Text
"fr" Text
_ Text
"CA" [Text]
_)            = Text
"canadien"
toBabel (Lang Text
"fra" Text
_ Text
_ [Text]
vars)
  | Text
"aca" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
vars                   = Text
"acadian"
toBabel (Lang Text
"grc" Text
_ Text
_ [Text]
_)              = Text
"polutonikogreek"
toBabel (Lang Text
"hsb" Text
_ Text
_ [Text]
_)              = Text
"uppersorbian"
toBabel (Lang Text
"la" Text
_ Text
_ [Text]
vars)
  | Text
"x-classic" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
vars             = Text
"classiclatin"
toBabel (Lang Text
"pt" Text
_ Text
"BR" [Text]
_)            = Text
"brazilian"
toBabel (Lang Text
"sl" Text
_ Text
_ [Text]
_)               = Text
"slovene"
toBabel Lang
x                               = Lang -> Text
commonFromBcp47 Lang
x

-- Takes a list of the constituents of a BCP 47 language code
-- and converts it to a string shared by Babel and Polyglossia.
-- https://tools.ietf.org/html/bcp47#section-2.1
commonFromBcp47 :: Lang -> Text
commonFromBcp47 :: Lang -> Text
commonFromBcp47 (Lang Text
"sr" Text
"Cyrl" Text
_ [Text]
_)          = Text
"serbianc"
commonFromBcp47 (Lang Text
"zh" Text
"Latn" Text
_ [Text]
vars)
  | Text
"pinyin" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
vars                        = Text
"pinyin"
commonFromBcp47 (Lang Text
l Text
_ Text
_ [Text]
_) = Text -> Text
forall a p. (Eq a, IsString a, IsString p) => a -> p
fromIso Text
l
  where
    fromIso :: a -> p
fromIso a
"af"  = p
"afrikaans"
    fromIso a
"am"  = p
"amharic"
    fromIso a
"ar"  = p
"arabic"
    fromIso a
"as"  = p
"assamese"
    fromIso a
"ast" = p
"asturian"
    fromIso a
"bg"  = p
"bulgarian"
    fromIso a
"bn"  = p
"bengali"
    fromIso a
"bo"  = p
"tibetan"
    fromIso a
"br"  = p
"breton"
    fromIso a
"ca"  = p
"catalan"
    fromIso a
"cy"  = p
"welsh"
    fromIso a
"cs"  = p
"czech"
    fromIso a
"cop" = p
"coptic"
    fromIso a
"da"  = p
"danish"
    fromIso a
"dv"  = p
"divehi"
    fromIso a
"el"  = p
"greek"
    fromIso a
"en"  = p
"english"
    fromIso a
"eo"  = p
"esperanto"
    fromIso a
"es"  = p
"spanish"
    fromIso a
"et"  = p
"estonian"
    fromIso a
"eu"  = p
"basque"
    fromIso a
"fa"  = p
"farsi"
    fromIso a
"fi"  = p
"finnish"
    fromIso a
"fr"  = p
"french"
    fromIso a
"fur" = p
"friulan"
    fromIso a
"ga"  = p
"irish"
    fromIso a
"gd"  = p
"scottish"
    fromIso a
"gez" = p
"ethiopic"
    fromIso a
"gl"  = p
"galician"
    fromIso a
"he"  = p
"hebrew"
    fromIso a
"hi"  = p
"hindi"
    fromIso a
"hr"  = p
"croatian"
    fromIso a
"hu"  = p
"magyar"
    fromIso a
"hy"  = p
"armenian"
    fromIso a
"ia"  = p
"interlingua"
    fromIso a
"id"  = p
"indonesian"
    fromIso a
"ie"  = p
"interlingua"
    fromIso a
"is"  = p
"icelandic"
    fromIso a
"it"  = p
"italian"
    fromIso a
"jp"  = p
"japanese"
    fromIso a
"km"  = p
"khmer"
    fromIso a
"kmr" = p
"kurmanji"
    fromIso a
"kn"  = p
"kannada"
    fromIso a
"ko"  = p
"korean"
    fromIso a
"la"  = p
"latin"
    fromIso a
"lo"  = p
"lao"
    fromIso a
"lt"  = p
"lithuanian"
    fromIso a
"lv"  = p
"latvian"
    fromIso a
"ml"  = p
"malayalam"
    fromIso a
"mn"  = p
"mongolian"
    fromIso a
"mr"  = p
"marathi"
    fromIso a
"nb"  = p
"norsk"
    fromIso a
"nl"  = p
"dutch"
    fromIso a
"nn"  = p
"nynorsk"
    fromIso a
"no"  = p
"norsk"
    fromIso a
"nqo" = p
"nko"
    fromIso a
"oc"  = p
"occitan"
    fromIso a
"pa"  = p
"panjabi"
    fromIso a
"pl"  = p
"polish"
    fromIso a
"pms" = p
"piedmontese"
    fromIso a
"pt"  = p
"portuguese"
    fromIso a
"rm"  = p
"romansh"
    fromIso a
"ro"  = p
"romanian"
    fromIso a
"ru"  = p
"russian"
    fromIso a
"sa"  = p
"sanskrit"
    fromIso a
"se"  = p
"samin"
    fromIso a
"sk"  = p
"slovak"
    fromIso a
"sq"  = p
"albanian"
    fromIso a
"sr"  = p
"serbian"
    fromIso a
"sv"  = p
"swedish"
    fromIso a
"syr" = p
"syriac"
    fromIso a
"ta"  = p
"tamil"
    fromIso a
"te"  = p
"telugu"
    fromIso a
"th"  = p
"thai"
    fromIso a
"ti"  = p
"ethiopic"
    fromIso a
"tk"  = p
"turkmen"
    fromIso a
"tr"  = p
"turkish"
    fromIso a
"uk"  = p
"ukrainian"
    fromIso a
"ur"  = p
"urdu"
    fromIso a
"vi"  = p
"vietnamese"
    fromIso a
_     = p
""