{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Readers.LaTeX ( readLaTeX,
applyMacros,
rawLaTeXInline,
rawLaTeXBlock,
inlineCommand,
tokenize,
untokenize
) where
import Control.Applicative (many, optional, (<|>))
import Control.Monad
import Control.Monad.Except (throwError)
import Data.Char (isDigit, isLetter, toUpper, chr)
import Data.Default
import Data.Functor (($>))
import Data.List (intercalate)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, maybeToList)
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as T
import System.FilePath (addExtension, replaceExtension, takeExtension)
import Text.Pandoc.BCP47 (Lang (..), renderLang)
import Text.Pandoc.Builder
import Text.Pandoc.Class.PandocPure (PandocPure)
import Text.Pandoc.Class.PandocMonad (PandocMonad (..), getResourcePath,
readFileFromDirs, report, setResourcePath,
setTranslations, translateTerm)
import Text.Pandoc.Error (PandocError (PandocParseError, PandocParsecError))
import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
import Text.Pandoc.ImageSize (numUnit, showFl)
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,
optional, space, spaces, withRaw, (<|>))
import Text.Pandoc.Readers.LaTeX.Types (ExpansionPoint (..), Macro (..),
ArgSpec (..), Tok (..), TokType (..))
import Text.Pandoc.Readers.LaTeX.Parsing
import Text.Pandoc.Readers.LaTeX.Lang (polyglossiaLangToBCP47,
babelLangToBCP47)
import Text.Pandoc.Readers.LaTeX.SIunitx
import Text.Pandoc.Shared
import qualified Text.Pandoc.Translations as Translations
import Text.Pandoc.Walk
import qualified Text.Pandoc.Builder as B
import qualified Data.Text.Normalize as Normalize
import Safe
readLaTeX :: PandocMonad m
=> ReaderOptions
-> Text
-> m Pandoc
readLaTeX :: ReaderOptions -> Text -> m Pandoc
readLaTeX ReaderOptions
opts Text
ltx = do
Either ParseError Pandoc
parsed <- ParsecT [Tok] LaTeXState m Pandoc
-> LaTeXState
-> SourceName
-> [Tok]
-> m (Either ParseError Pandoc)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
runParserT ParsecT [Tok] LaTeXState m Pandoc
forall (m :: * -> *). PandocMonad m => LP m Pandoc
parseLaTeX LaTeXState
forall a. Default a => a
def{ sOptions :: ReaderOptions
sOptions = ReaderOptions
opts } SourceName
"source"
(SourceName -> Text -> [Tok]
tokenize SourceName
"source" (Text -> Text
crFilter Text
ltx))
case Either ParseError Pandoc
parsed of
Right Pandoc
result -> Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
result
Left ParseError
e -> PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Pandoc) -> PandocError -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Text -> ParseError -> PandocError
PandocParsecError Text
ltx ParseError
e
parseLaTeX :: PandocMonad m => LP m Pandoc
parseLaTeX :: LP m Pandoc
parseLaTeX = do
Blocks
bs <- LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
LaTeXState
st <- ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let meta :: Meta
meta = LaTeXState -> Meta
sMeta LaTeXState
st
let doc' :: Pandoc
doc' = Blocks -> Pandoc
doc Blocks
bs
let headerLevel :: Block -> [Int]
headerLevel (Header Int
n Attr
_ [Inline]
_) = [Int
n]
headerLevel Block
_ = []
#if MIN_VERSION_safe(0,3,18)
let bottomLevel :: Int
bottomLevel = Int -> [Int] -> Int
forall a. Ord a => a -> [a] -> a
minimumBound Int
1 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Block -> [Int]) -> Pandoc -> [Int]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [Int]
headerLevel Pandoc
doc'
#else
let bottomLevel = minimumDef 1 $ query headerLevel doc'
#endif
let adjustHeaders :: Int -> Block -> Block
adjustHeaders Int
m (Header Int
n Attr
attr [Inline]
ils) = Int -> Attr -> [Inline] -> Block
Header (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m) Attr
attr [Inline]
ils
adjustHeaders Int
_ Block
x = Block
x
let (Pandoc Meta
_ [Block]
bs') =
(if Int
bottomLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
then (Block -> Block) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Int -> Block -> Block
adjustHeaders (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bottomLevel))
else Pandoc -> Pandoc
forall a. a -> a
id) (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$
(Inline -> Inline) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Map Text [Inline] -> Inline -> Inline
resolveRefs (LaTeXState -> Map Text [Inline]
sLabels LaTeXState
st)) Pandoc
doc'
Pandoc -> LP m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> LP m Pandoc) -> Pandoc -> LP m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs'
resolveRefs :: M.Map Text [Inline] -> Inline -> Inline
resolveRefs :: Map Text [Inline] -> Inline -> Inline
resolveRefs Map Text [Inline]
labels x :: Inline
x@(Link (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
_ (Text, Text)
_) =
case (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"reference-type" [(Text, Text)]
kvs,
Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"reference" [(Text, Text)]
kvs) of
(Just Text
"ref", Just Text
lab) ->
case Text -> Map Text [Inline] -> Maybe [Inline]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
lab Map Text [Inline]
labels of
Just [Inline]
txt -> Attr -> [Inline] -> (Text, Text) -> Inline
Link (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
txt (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lab, Text
"")
Maybe [Inline]
Nothing -> Inline
x
(Maybe Text, Maybe Text)
_ -> Inline
x
resolveRefs Map Text [Inline]
_ Inline
x = Inline
x
rawLaTeXBlock :: (PandocMonad m, HasMacros s, HasReaderOptions s)
=> ParserT Text s m Text
rawLaTeXBlock :: ParserT Text s m Text
rawLaTeXBlock = do
ParsecT Text s m Char -> ParsecT Text s m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text s m Char -> ParsecT Text s m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Text s m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT Text s m Char
-> ParsecT Text s m Char -> ParsecT Text s m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text s m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter))
Text
inp <- ParserT Text s m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
let toks :: [Tok]
toks = SourceName -> Text -> [Tok]
tokenize SourceName
"source" Text
inp
(Blocks, Text) -> Text
forall a b. (a, b) -> b
snd ((Blocks, Text) -> Text)
-> ParsecT Text s m (Blocks, Text) -> ParserT Text s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Tok]
-> Bool
-> LP m Blocks
-> LP m Blocks
-> ParsecT Text s m (Blocks, Text)
forall (m :: * -> *) s a.
(PandocMonad m, HasMacros s, HasReaderOptions s) =>
[Tok] -> Bool -> LP m a -> LP m a -> ParserT Text s m (a, Text)
rawLaTeXParser [Tok]
toks Bool
False ((Text -> Blocks) -> LP m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Text -> a) -> LP m a
macroDef (Blocks -> Text -> Blocks
forall a b. a -> b -> a
const Blocks
forall a. Monoid a => a
mempty)) LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
ParsecT Text s m (Blocks, Text)
-> ParsecT Text s m (Blocks, Text)
-> ParsecT Text s m (Blocks, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Tok]
-> Bool
-> LP m Blocks
-> LP m Blocks
-> ParsecT Text s m (Blocks, Text)
forall (m :: * -> *) s a.
(PandocMonad m, HasMacros s, HasReaderOptions s) =>
[Tok] -> Bool -> LP m a -> LP m a -> ParserT Text s m (a, Text)
rawLaTeXParser [Tok]
toks Bool
True
(do [ParsecT [Tok] LaTeXState m Tok] -> ParsecT [Tok] LaTeXState m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ((Text -> ParsecT [Tok] LaTeXState m Tok)
-> [Text] -> [ParsecT [Tok] LaTeXState m Tok]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq
[Text
"include", Text
"input", Text
"subfile", Text
"usepackage"])
ParsecT [Tok] LaTeXState m Inlines -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt
LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty) LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
ParsecT Text s m (Blocks, Text)
-> ParsecT Text s m (Blocks, Text)
-> ParsecT Text s m (Blocks, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Tok]
-> Bool
-> LP m Blocks
-> LP m Blocks
-> ParsecT Text s m (Blocks, Text)
forall (m :: * -> *) s a.
(PandocMonad m, HasMacros s, HasReaderOptions s) =>
[Tok] -> Bool -> LP m a -> LP m a -> ParserT Text s m (a, Text)
rawLaTeXParser [Tok]
toks Bool
True
(LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
environment LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blockCommand)
([Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [Tok] LaTeXState m [Blocks] -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Blocks -> ParsecT [Tok] LaTeXState m [Blocks]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
beginOrEndCommand)))
beginOrEndCommand :: PandocMonad m => LP m Blocks
beginOrEndCommand :: LP m Blocks
beginOrEndCommand = LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ do
Tok SourcePos
_ (CtrlSeq Text
name) Text
txt <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyControlSeq
Bool -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] LaTeXState m ())
-> Bool -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"begin" Bool -> Bool -> Bool
|| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"end"
([Tok]
envname, [Tok]
rawargs) <- LP m [Tok] -> LP m ([Tok], [Tok])
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m (a, [Tok])
withRaw LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
if Text -> Map Text (LP PandocPure Inlines) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member ([Tok] -> Text
untokenize [Tok]
envname)
(Map Text (LP PandocPure Inlines)
forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
inlineEnvironments :: M.Map Text (LP PandocPure Inlines))
then LP m Blocks
forall (m :: * -> *) a. MonadPlus m => m a
mzero
else Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
rawBlock Text
"latex"
(Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
rawargs)
rawLaTeXInline :: (PandocMonad m, HasMacros s, HasReaderOptions s)
=> ParserT Text s m Text
rawLaTeXInline :: ParserT Text s m Text
rawLaTeXInline = do
ParsecT Text s m Char -> ParsecT Text s m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text s m Char -> ParsecT Text s m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Text s m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT Text s m Char
-> ParsecT Text s m Char -> ParsecT Text s m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text s m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter))
Text
inp <- ParserT Text s m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
let toks :: [Tok]
toks = SourceName -> Text -> [Tok]
tokenize SourceName
"source" Text
inp
Text
raw <- (Inlines, Text) -> Text
forall a b. (a, b) -> b
snd ((Inlines, Text) -> Text)
-> ParsecT Text s m (Inlines, Text) -> ParserT Text s m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
( [Tok]
-> Bool
-> LP m Inlines
-> LP m Inlines
-> ParsecT Text s m (Inlines, Text)
forall (m :: * -> *) s a.
(PandocMonad m, HasMacros s, HasReaderOptions s) =>
[Tok] -> Bool -> LP m a -> LP m a -> ParserT Text s m (a, Text)
rawLaTeXParser [Tok]
toks Bool
True
(Inlines
forall a. Monoid a => a
mempty Inlines -> ParsecT [Tok] LaTeXState m [Tok] -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"input" LP m Tok
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m Inlines -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced))
LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines
ParsecT Text s m (Inlines, Text)
-> ParsecT Text s m (Inlines, Text)
-> ParsecT Text s m (Inlines, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Tok]
-> Bool
-> LP m Inlines
-> LP m Inlines
-> ParsecT Text s m (Inlines, Text)
forall (m :: * -> *) s a.
(PandocMonad m, HasMacros s, HasReaderOptions s) =>
[Tok] -> Bool -> LP m a -> LP m a -> ParserT Text s m (a, Text)
rawLaTeXParser [Tok]
toks Bool
True (LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlineEnvironment LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlineCommand')
LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines
)
SourceName
finalbraces <- [SourceName] -> SourceName
forall a. Monoid a => [a] -> a
mconcat ([SourceName] -> SourceName)
-> ParsecT Text s m [SourceName] -> ParsecT Text s m SourceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text s m SourceName -> ParsecT Text s m [SourceName]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Text s m SourceName -> ParsecT Text s m SourceName
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (SourceName -> ParsecT Text s m SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
"{}"))
Text -> ParserT Text s m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParserT Text s m Text) -> Text -> ParserT Text s m Text
forall a b. (a -> b) -> a -> b
$ Text
raw Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
T.pack SourceName
finalbraces
inlineCommand :: PandocMonad m => ParserT Text ParserState m Inlines
inlineCommand :: ParserT Text ParserState m Inlines
inlineCommand = do
ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT Text ParserState m Char -> ParsecT Text ParserState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Text ParserState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
-> ParsecT Text ParserState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text ParserState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter))
Text
inp <- ParsecT Text ParserState m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
let toks :: [Tok]
toks = SourceName -> Text -> [Tok]
tokenize SourceName
"source" Text
inp
(Inlines, Text) -> Inlines
forall a b. (a, b) -> a
fst ((Inlines, Text) -> Inlines)
-> ParsecT Text ParserState m (Inlines, Text)
-> ParserT Text ParserState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tok]
-> Bool
-> LP m Inlines
-> LP m Inlines
-> ParsecT Text ParserState m (Inlines, Text)
forall (m :: * -> *) s a.
(PandocMonad m, HasMacros s, HasReaderOptions s) =>
[Tok] -> Bool -> LP m a -> LP m a -> ParserT Text s m (a, Text)
rawLaTeXParser [Tok]
toks Bool
True (LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlineEnvironment LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlineCommand')
LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines
word :: PandocMonad m => LP m Inlines
word :: LP m Inlines
word = Text -> Inlines
str (Text -> Inlines) -> (Tok -> Text) -> Tok -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> Text
untoken (Tok -> Inlines) -> ParsecT [Tok] LaTeXState m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tok -> Bool) -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok Tok -> Bool
isWordTok
regularSymbol :: PandocMonad m => LP m Inlines
regularSymbol :: LP m Inlines
regularSymbol = Text -> Inlines
str (Text -> Inlines) -> (Tok -> Text) -> Tok -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> Text
untoken (Tok -> Inlines) -> ParsecT [Tok] LaTeXState m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tok -> Bool) -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok Tok -> Bool
isRegularSymbol
where isRegularSymbol :: Tok -> Bool
isRegularSymbol (Tok SourcePos
_ TokType
Symbol Text
t) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isSpecial Text
t
isRegularSymbol Tok
_ = Bool
False
isSpecial :: Char -> Bool
isSpecial Char
c = Char
c Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
specialChars
inlineGroup :: PandocMonad m => LP m Inlines
inlineGroup :: LP m Inlines
inlineGroup = do
Inlines
ils <- LP m Inlines -> LP m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline
if Inlines -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
ils
then Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
else Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith Attr
nullAttr Inlines
ils
doLHSverb :: PandocMonad m => LP m Inlines
doLHSverb :: LP m Inlines
doLHSverb =
Attr -> Text -> Inlines
codeWith (Text
"",[Text
"haskell"],[]) (Text -> Inlines) -> ([Tok] -> Text) -> [Tok] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize
([Tok] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Tok] -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ((Tok -> Bool) -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok (Bool -> Bool
not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> Bool
isNewlineTok)) (Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'|')
mkImage :: PandocMonad m => [(Text, Text)] -> Text -> LP m Inlines
mkImage :: [(Text, Text)] -> Text -> LP m Inlines
mkImage [(Text, Text)]
options (Text -> SourceName
T.unpack -> SourceName
src) = do
let replaceTextwidth :: (a, Text) -> (a, Text)
replaceTextwidth (a
k,Text
v) =
case Text -> Maybe (Double, Text)
numUnit Text
v of
Just (Double
num, Text
"\\textwidth") -> (a
k, Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double
num Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%")
Maybe (Double, Text)
_ -> (a
k, Text
v)
let kvs :: [(Text, Text)]
kvs = ((Text, Text) -> (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> (Text, Text)
forall a. (a, Text) -> (a, Text)
replaceTextwidth
([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k,Text
_) -> Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"width", Text
"height"]) [(Text, Text)]
options
let attr :: (Text, [a], [(Text, Text)])
attr = (Text
"",[], [(Text, Text)]
kvs)
let alt :: Inlines
alt = Text -> Inlines
str Text
"image"
Text
defaultExt <- (ReaderOptions -> Text) -> ParserT [Tok] LaTeXState m Text
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Text
readerDefaultImageExtension
let exts' :: [SourceName]
exts' = [SourceName
".pdf", SourceName
".png", SourceName
".jpg", SourceName
".mps", SourceName
".jpeg", SourceName
".jbig2", SourceName
".jb2"]
let exts :: [SourceName]
exts = [SourceName]
exts' [SourceName] -> [SourceName] -> [SourceName]
forall a. [a] -> [a] -> [a]
++ (SourceName -> SourceName) -> [SourceName] -> [SourceName]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> SourceName -> SourceName
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper) [SourceName]
exts'
let findFile :: SourceName -> [SourceName] -> m SourceName
findFile SourceName
s [] = SourceName -> m SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
s
findFile SourceName
s (SourceName
e:[SourceName]
es) = do
let s' :: SourceName
s' = SourceName -> SourceName -> SourceName
addExtension SourceName
s SourceName
e
Bool
exists <- SourceName -> m Bool
forall (m :: * -> *). PandocMonad m => SourceName -> m Bool
fileExists SourceName
s'
if Bool
exists
then SourceName -> m SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
s'
else SourceName -> [SourceName] -> m SourceName
findFile SourceName
s [SourceName]
es
SourceName
src' <- case SourceName -> SourceName
takeExtension SourceName
src of
SourceName
"" | Bool -> Bool
not (Text -> Bool
T.null Text
defaultExt) -> SourceName -> ParsecT [Tok] LaTeXState m SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceName -> ParsecT [Tok] LaTeXState m SourceName)
-> SourceName -> ParsecT [Tok] LaTeXState m SourceName
forall a b. (a -> b) -> a -> b
$ SourceName -> SourceName -> SourceName
addExtension SourceName
src (SourceName -> SourceName) -> SourceName -> SourceName
forall a b. (a -> b) -> a -> b
$ Text -> SourceName
T.unpack Text
defaultExt
| Bool
otherwise -> SourceName -> [SourceName] -> ParsecT [Tok] LaTeXState m SourceName
forall (m :: * -> *).
PandocMonad m =>
SourceName -> [SourceName] -> m SourceName
findFile SourceName
src [SourceName]
exts
SourceName
_ -> SourceName -> ParsecT [Tok] LaTeXState m SourceName
forall (m :: * -> *) a. Monad m => a -> m a
return SourceName
src
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith Attr
forall a. (Text, [a], [(Text, Text)])
attr (SourceName -> Text
T.pack SourceName
src') Text
"" Inlines
alt
doxspace :: PandocMonad m => LP m Inlines
doxspace :: LP m Inlines
doxspace =
(Inlines
space Inlines -> ParsecT [Tok] LaTeXState m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ((Tok -> Bool) -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok Tok -> Bool
startsWithLetter)) LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
where startsWithLetter :: Tok -> Bool
startsWithLetter (Tok SourcePos
_ TokType
Word Text
t) =
case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
c, Text
_) | Char -> Bool
isLetter Char
c -> Bool
True
Maybe (Char, Text)
_ -> Bool
False
startsWithLetter Tok
_ = Bool
False
lit :: Text -> LP m Inlines
lit :: Text -> LP m Inlines
lit = Inlines -> LP m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> LP m Inlines)
-> (Text -> Inlines) -> Text -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
str
removeDoubleQuotes :: Text -> Text
removeDoubleQuotes :: Text -> Text
removeDoubleQuotes Text
t =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe Text
t (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"\"" Text
t Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> Maybe Text
T.stripSuffix Text
"\""
doubleQuote :: PandocMonad m => LP m Inlines
doubleQuote :: LP m Inlines
doubleQuote =
(Inlines -> Inlines) -> LP m [Tok] -> LP m () -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> LP m [Tok] -> LP m () -> LP m Inlines
quoted' Inlines -> Inlines
doubleQuoted (LP m [Tok] -> LP m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m [Tok] -> LP m [Tok]) -> LP m [Tok] -> LP m [Tok]
forall a b. (a -> b) -> a -> b
$ Int -> ParsecT [Tok] LaTeXState m Tok -> LP m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
2 (ParsecT [Tok] LaTeXState m Tok -> LP m [Tok])
-> ParsecT [Tok] LaTeXState m Tok -> LP m [Tok]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'`')
(LP m [Tok] -> LP m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LP m [Tok] -> LP m ()) -> LP m [Tok] -> LP m ()
forall a b. (a -> b) -> a -> b
$ LP m [Tok] -> LP m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m [Tok] -> LP m [Tok]) -> LP m [Tok] -> LP m [Tok]
forall a b. (a -> b) -> a -> b
$ Int -> ParsecT [Tok] LaTeXState m Tok -> LP m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
2 (ParsecT [Tok] LaTeXState m Tok -> LP m [Tok])
-> ParsecT [Tok] LaTeXState m Tok -> LP m [Tok]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'\'')
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines -> Inlines) -> LP m [Tok] -> LP m () -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> LP m [Tok] -> LP m () -> LP m Inlines
quoted' Inlines -> Inlines
doubleQuoted ((Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[]) (Tok -> [Tok]) -> ParsecT [Tok] LaTeXState m Tok -> LP m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'“') (ParsecT [Tok] LaTeXState m Tok -> LP m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT [Tok] LaTeXState m Tok -> LP m ())
-> ParsecT [Tok] LaTeXState m Tok -> LP m ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'”')
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines -> Inlines) -> LP m [Tok] -> LP m () -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> LP m [Tok] -> LP m () -> LP m Inlines
quoted' Inlines -> Inlines
doubleQuoted (LP m [Tok] -> LP m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m [Tok] -> LP m [Tok]) -> LP m [Tok] -> LP m [Tok]
forall a b. (a -> b) -> a -> b
$ [ParsecT [Tok] LaTeXState m Tok] -> LP m [Tok]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'"', Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'`'])
(LP m [Tok] -> LP m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LP m [Tok] -> LP m ()) -> LP m [Tok] -> LP m ()
forall a b. (a -> b) -> a -> b
$ LP m [Tok] -> LP m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m [Tok] -> LP m [Tok]) -> LP m [Tok] -> LP m [Tok]
forall a b. (a -> b) -> a -> b
$ [ParsecT [Tok] LaTeXState m Tok] -> LP m [Tok]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'"', Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'\''])
singleQuote :: PandocMonad m => LP m Inlines
singleQuote :: LP m Inlines
singleQuote =
(Inlines -> Inlines) -> LP m [Tok] -> LP m () -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> LP m [Tok] -> LP m () -> LP m Inlines
quoted' Inlines -> Inlines
singleQuoted ((Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[]) (Tok -> [Tok]) -> ParsecT [Tok] LaTeXState m Tok -> LP m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'`')
(LP m () -> LP m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m () -> LP m ()) -> LP m () -> LP m ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'\'' ParsecT [Tok] LaTeXState m Tok -> LP m () -> LP m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
ParsecT [Tok] LaTeXState m Tok -> LP m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ((Tok -> Bool) -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok Tok -> Bool
startsWithLetter))
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines -> Inlines) -> LP m [Tok] -> LP m () -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> LP m [Tok] -> LP m () -> LP m Inlines
quoted' Inlines -> Inlines
singleQuoted ((Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[]) (Tok -> [Tok]) -> ParsecT [Tok] LaTeXState m Tok -> LP m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'‘')
(LP m () -> LP m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m () -> LP m ()) -> LP m () -> LP m ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'’' ParsecT [Tok] LaTeXState m Tok -> LP m () -> LP m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
ParsecT [Tok] LaTeXState m Tok -> LP m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ((Tok -> Bool) -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok Tok -> Bool
startsWithLetter))
where startsWithLetter :: Tok -> Bool
startsWithLetter (Tok SourcePos
_ TokType
Word Text
t) =
case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
c, Text
_) | Char -> Bool
isLetter Char
c -> Bool
True
Maybe (Char, Text)
_ -> Bool
False
startsWithLetter Tok
_ = Bool
False
quoted' :: PandocMonad m
=> (Inlines -> Inlines)
-> LP m [Tok]
-> LP m ()
-> LP m Inlines
quoted' :: (Inlines -> Inlines) -> LP m [Tok] -> LP m () -> LP m Inlines
quoted' Inlines -> Inlines
f LP m [Tok]
starter LP m ()
ender = do
Text
startchs <- [Tok] -> Text
untokenize ([Tok] -> Text) -> LP m [Tok] -> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m [Tok]
starter
Bool
smart <- Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_smart (Extensions -> Bool)
-> ParsecT [Tok] LaTeXState m Extensions
-> ParsecT [Tok] LaTeXState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderOptions -> Extensions)
-> ParsecT [Tok] LaTeXState m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
if Bool
smart
then do
[Inlines]
ils <- LP m Inlines -> ParsecT [Tok] LaTeXState m [Inlines]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (LP m () -> LP m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy LP m ()
ender LP m () -> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline)
(LP m ()
ender LP m () -> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> Inlines
f ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat [Inlines]
ils))) LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat [Inlines]
ils) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit (case Text
startchs of
Text
"``" -> Text
"“"
Text
"`" -> Text
"‘"
Text
cs -> Text
cs)
else Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
startchs
enquote :: PandocMonad m => Bool -> Maybe Text -> LP m Inlines
enquote :: Bool -> Maybe Text -> LP m Inlines
enquote Bool
starred Maybe Text
mblang = do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
let lang :: Maybe Lang
lang = Maybe Text
mblang Maybe Text -> (Text -> Maybe Lang) -> Maybe Lang
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Lang
babelLangToBCP47
let langspan :: Inlines -> Inlines
langspan = case Maybe Lang
lang of
Maybe Lang
Nothing -> Inlines -> Inlines
forall a. a -> a
id
Just Lang
l -> Attr -> Inlines -> Inlines
spanWith (Text
"",[],[(Text
"lang", Lang -> Text
renderLang Lang
l)])
QuoteContext
quoteContext <- LaTeXState -> QuoteContext
sQuoteContext (LaTeXState -> QuoteContext)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m QuoteContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
if Bool
starred Bool -> Bool -> Bool
|| QuoteContext
quoteContext QuoteContext -> QuoteContext -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteContext
InDoubleQuote
then Inlines -> Inlines
singleQuoted (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
langspan (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QuoteContext -> LP m Inlines -> LP m Inlines
forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
InSingleQuote LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
else Inlines -> Inlines
doubleQuoted (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
langspan (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QuoteContext -> LP m Inlines -> LP m Inlines
forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
InDoubleQuote LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
blockquote :: PandocMonad m => Bool -> Maybe Text -> LP m Blocks
blockquote :: Bool -> Maybe Text -> LP m Blocks
blockquote Bool
cvariant Maybe Text
mblang = do
Blocks
citepar <- if Bool
cvariant
then (\[Citation]
xs -> Inlines -> Blocks
para ([Citation] -> Inlines -> Inlines
cite [Citation]
xs Inlines
forall a. Monoid a => a
mempty))
([Citation] -> Blocks)
-> ParsecT [Tok] LaTeXState m [Citation] -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CitationMode -> Bool -> ParsecT [Tok] LaTeXState m [Citation]
forall (m :: * -> *).
PandocMonad m =>
CitationMode -> Bool -> LP m [Citation]
cites CitationMode
NormalCitation Bool
False
else Blocks -> LP m Blocks -> LP m Blocks
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Blocks
forall a. Monoid a => a
mempty (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para (Inlines -> Blocks)
-> ParsecT [Tok] LaTeXState m Inlines -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
bracketed ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline
let lang :: Maybe Lang
lang = Maybe Text
mblang Maybe Text -> (Text -> Maybe Lang) -> Maybe Lang
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Lang
babelLangToBCP47
let langdiv :: Blocks -> Blocks
langdiv = case Maybe Lang
lang of
Maybe Lang
Nothing -> Blocks -> Blocks
forall a. a -> a
id
Just Lang
l -> Attr -> Blocks -> Blocks
divWith (Text
"",[],[(Text
"lang", Lang -> Text
renderLang Lang
l)])
Inlines
_closingPunct <- Inlines
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
forall a. Monoid a => a
mempty (ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines)
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
bracketed ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline
Blocks
bs <- LP m Blocks -> LP m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block
ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m (Maybe Tok)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m (Maybe Tok))
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m (Maybe Tok)
forall a b. (a -> b) -> a -> b
$ SourceName -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => SourceName -> LP m Tok
symbolIn (SourceName
".:;?!" :: [Char])
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
langdiv (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ (Blocks
bs Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
citepar)
doAcronym :: PandocMonad m => Text -> LP m Inlines
doAcronym :: Text -> LP m Inlines
doAcronym Text
form = do
[Tok]
acro <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> LP m Inlines) -> [Inlines] -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ [Attr -> Inlines -> Inlines
spanWith (Text
"",[],[(Text
"acronym-label", [Tok] -> Text
untokenize [Tok]
acro),
(Text
"acronym-form", Text
"singular+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
form)])
(Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize [Tok]
acro]
doAcronymPlural :: PandocMonad m => Text -> LP m Inlines
doAcronymPlural :: Text -> LP m Inlines
doAcronymPlural Text
form = do
[Tok]
acro <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Inlines
plural <- Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"s"
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> LP m Inlines) -> [Inlines] -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ [Attr -> Inlines -> Inlines
spanWith (Text
"",[],[(Text
"acronym-label", [Tok] -> Text
untokenize [Tok]
acro),
(Text
"acronym-form", Text
"plural+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
form)]) (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$
[Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat [Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize [Tok]
acro, Inlines
plural]]
doverb :: PandocMonad m => LP m Inlines
doverb :: LP m Inlines
doverb = do
Tok SourcePos
_ TokType
Symbol Text
t <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anySymbol
Char
marker <- case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
c, Text
ts) | Text -> Bool
T.null Text
ts -> Char -> ParsecT [Tok] LaTeXState m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
Maybe (Char, Text)
_ -> ParsecT [Tok] LaTeXState m Char
forall (m :: * -> *) a. MonadPlus m => m a
mzero
LP m Inlines -> LP m Inlines
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m a
withVerbatimMode (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$
Text -> Inlines
code (Text -> Inlines) -> ([Tok] -> Text) -> [Tok] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Tok] -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
LP m Tok -> LP m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
newlineTok ParsecT [Tok] LaTeXState m () -> LP m Tok -> LP m Tok
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
verbTok Char
marker) (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
marker)
verbTok :: PandocMonad m => Char -> LP m Tok
verbTok :: Char -> LP m Tok
verbTok Char
stopchar = do
t :: Tok
t@(Tok SourcePos
pos TokType
toktype Text
txt) <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok
case (Char -> Bool) -> Text -> Maybe Int
T.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
stopchar) Text
txt of
Maybe Int
Nothing -> Tok -> LP m Tok
forall (m :: * -> *) a. Monad m => a -> m a
return Tok
t
Just Int
i -> do
let (Text
t1, Text
t2) = Int -> Text -> (Text, Text)
T.splitAt Int
i Text
txt
[Tok]
inp <- ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
[Tok] -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput ([Tok] -> ParsecT [Tok] LaTeXState m ())
-> [Tok] -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ SourcePos -> TokType -> Text -> Tok
Tok (SourcePos -> Int -> SourcePos
incSourceColumn SourcePos
pos Int
i) TokType
Symbol (Char -> Text
T.singleton Char
stopchar)
Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: SourcePos -> Text -> [Tok]
totoks (SourcePos -> Int -> SourcePos
incSourceColumn SourcePos
pos (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (Int -> Text -> Text
T.drop Int
1 Text
t2) [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
inp
Tok -> LP m Tok
forall (m :: * -> *) a. Monad m => a -> m a
return (Tok -> LP m Tok) -> Tok -> LP m Tok
forall a b. (a -> b) -> a -> b
$ SourcePos -> TokType -> Text -> Tok
Tok SourcePos
pos TokType
toktype Text
t1
listingsLanguage :: [(Text, Text)] -> Maybe Text
listingsLanguage :: [(Text, Text)] -> Maybe Text
listingsLanguage [(Text, Text)]
opts =
case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"language" [(Text, Text)]
opts of
Maybe Text
Nothing -> Maybe Text
forall a. Maybe a
Nothing
Just Text
l -> Text -> Maybe Text
fromListingsLanguage Text
l Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l
dolstinline :: PandocMonad m => LP m Inlines
dolstinline :: LP m Inlines
dolstinline = do
[(Text, Text)]
options <- [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] LaTeXState m [(Text, Text)]
forall (m :: * -> *). PandocMonad m => LP m [(Text, Text)]
keyvals
let classes :: [Text]
classes = Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Maybe Text
listingsLanguage [(Text, Text)]
options
[Text] -> LP m Inlines
forall (m :: * -> *). PandocMonad m => [Text] -> LP m Inlines
doinlinecode [Text]
classes
domintinline :: PandocMonad m => LP m Inlines
domintinline :: LP m Inlines
domintinline = do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
Text
cls <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
[Text] -> LP m Inlines
forall (m :: * -> *). PandocMonad m => [Text] -> LP m Inlines
doinlinecode [Text
cls]
doinlinecode :: PandocMonad m => [Text] -> LP m Inlines
doinlinecode :: [Text] -> LP m Inlines
doinlinecode [Text]
classes = do
Tok SourcePos
_ TokType
Symbol Text
t <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anySymbol
Char
marker <- case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
c, Text
ts) | Text -> Bool
T.null Text
ts -> Char -> ParsecT [Tok] LaTeXState m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
Maybe (Char, Text)
_ -> ParsecT [Tok] LaTeXState m Char
forall (m :: * -> *) a. MonadPlus m => m a
mzero
let stopchar :: Char
stopchar = if Char
marker Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{' then Char
'}' else Char
marker
LP m Inlines -> LP m Inlines
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m a
withVerbatimMode (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$
Attr -> Text -> Inlines
codeWith (Text
"",[Text]
classes,[]) (Text -> Inlines) -> ([Tok] -> Text) -> [Tok] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
nlToSpace (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Tok] -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
LP m Tok -> LP m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
verbTok Char
stopchar) (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
stopchar)
nlToSpace :: Char -> Char
nlToSpace :: Char -> Char
nlToSpace Char
'\n' = Char
' '
nlToSpace Char
x = Char
x
mathDisplay :: Text -> Inlines
mathDisplay :: Text -> Inlines
mathDisplay = Text -> Inlines
displayMath (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimMath
mathInline :: Text -> Inlines
mathInline :: Text -> Inlines
mathInline = Text -> Inlines
math (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimMath
dollarsMath :: PandocMonad m => LP m Inlines
dollarsMath :: LP m Inlines
dollarsMath = do
Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'$'
Bool
display <- Bool
-> ParsecT [Tok] LaTeXState m Bool
-> ParsecT [Tok] LaTeXState m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (Bool
True Bool -> LP m Tok -> ParsecT [Tok] LaTeXState m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'$')
(do Text
contents <- ParsecT [Tok] LaTeXState m Text -> ParsecT [Tok] LaTeXState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text)
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath Int
0
if Bool
display
then Text -> Inlines
mathDisplay Text
contents Inlines -> LP m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'$'
else Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
mathInline Text
contents)
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
display ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
mathInline Text
""))
pDollarsMath :: PandocMonad m => Int -> LP m [Tok]
pDollarsMath :: Int -> LP m [Tok]
pDollarsMath Int
n = do
tk :: Tok
tk@(Tok SourcePos
_ TokType
toktype Text
t) <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok
case TokType
toktype of
TokType
Symbol | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"$"
, Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> [Tok] -> LP m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\\" -> do
Tok
tk' <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok
(Tok
tk Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tok
tk' Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> LP m [Tok] -> LP m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> LP m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath Int
n
| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"{" -> (Tok
tk Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> LP m [Tok] -> LP m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> LP m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"}" ->
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then (Tok
tk Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> LP m [Tok] -> LP m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> LP m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
else LP m [Tok]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
TokType
_ -> (Tok
tk Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:) ([Tok] -> [Tok]) -> LP m [Tok] -> LP m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> LP m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> LP m [Tok]
pDollarsMath Int
n
addPrefix :: [Inline] -> [Citation] -> [Citation]
addPrefix :: [Inline] -> [Citation] -> [Citation]
addPrefix [Inline]
p (Citation
k:[Citation]
ks) = Citation
k {citationPrefix :: [Inline]
citationPrefix = [Inline]
p [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ Citation -> [Inline]
citationPrefix Citation
k} Citation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
: [Citation]
ks
addPrefix [Inline]
_ [Citation]
_ = []
addSuffix :: [Inline] -> [Citation] -> [Citation]
addSuffix :: [Inline] -> [Citation] -> [Citation]
addSuffix [Inline]
s ks :: [Citation]
ks@(Citation
_:[Citation]
_) =
let k :: Citation
k = [Citation] -> Citation
forall a. [a] -> a
last [Citation]
ks
in [Citation] -> [Citation]
forall a. [a] -> [a]
init [Citation]
ks [Citation] -> [Citation] -> [Citation]
forall a. [a] -> [a] -> [a]
++ [Citation
k {citationSuffix :: [Inline]
citationSuffix = Citation -> [Inline]
citationSuffix Citation
k [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
s}]
addSuffix [Inline]
_ [Citation]
_ = []
simpleCiteArgs :: PandocMonad m => LP m [Citation]
simpleCiteArgs :: LP m [Citation]
simpleCiteArgs = LP m [Citation] -> LP m [Citation]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m [Citation] -> LP m [Citation])
-> LP m [Citation] -> LP m [Citation]
forall a b. (a -> b) -> a -> b
$ do
Maybe [Inline]
first <- ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline]))
-> ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline])
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inline]
forall a. Many a -> [a]
toList (Inlines -> [Inline])
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt
Maybe [Inline]
second <- ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline]))
-> ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline])
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inline]
forall a. Many a -> [a]
toList (Inlines -> [Inline])
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt
[Text]
keys <- ParsecT [Tok] LaTeXState m [Text]
-> ParsecT [Tok] LaTeXState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] LaTeXState m [Text]
-> ParsecT [Tok] LaTeXState m [Text])
-> ParsecT [Tok] LaTeXState m [Text]
-> ParsecT [Tok] LaTeXState m [Text]
forall a b. (a -> b) -> a -> b
$ LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
bgroup LP m Tok
-> ParsecT [Tok] LaTeXState m [Text]
-> ParsecT [Tok] LaTeXState m [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m Text
-> LP m Tok -> ParsecT [Tok] LaTeXState m [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => LP m Text
citationLabel LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
egroup
let ([Inline]
pre, [Inline]
suf) = case (Maybe [Inline]
first , Maybe [Inline]
second ) of
(Just [Inline]
s , Maybe [Inline]
Nothing) -> ([Inline]
forall a. Monoid a => a
mempty, [Inline]
s )
(Just [Inline]
s , Just [Inline]
t ) -> ([Inline]
s , [Inline]
t )
(Maybe [Inline], Maybe [Inline])
_ -> ([Inline]
forall a. Monoid a => a
mempty, [Inline]
forall a. Monoid a => a
mempty)
conv :: Text -> Citation
conv Text
k = Citation :: Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
Citation { citationId :: Text
citationId = Text
k
, citationPrefix :: [Inline]
citationPrefix = []
, citationSuffix :: [Inline]
citationSuffix = []
, citationMode :: CitationMode
citationMode = CitationMode
NormalCitation
, citationHash :: Int
citationHash = Int
0
, citationNoteNum :: Int
citationNoteNum = Int
0
}
[Citation] -> LP m [Citation]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Citation] -> LP m [Citation]) -> [Citation] -> LP m [Citation]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Citation] -> [Citation]
addPrefix [Inline]
pre ([Citation] -> [Citation]) -> [Citation] -> [Citation]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Citation] -> [Citation]
addSuffix [Inline]
suf ([Citation] -> [Citation]) -> [Citation] -> [Citation]
forall a b. (a -> b) -> a -> b
$ (Text -> Citation) -> [Text] -> [Citation]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Citation
conv [Text]
keys
citationLabel :: PandocMonad m => LP m Text
citationLabel :: LP m Text
citationLabel = do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp
[Tok] -> Text
untokenize ([Tok] -> Text) -> ParsecT [Tok] LaTeXState m [Tok] -> LP m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Tok -> Bool) -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok Tok -> Bool
isWordTok ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SourceName -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => SourceName -> LP m Tok
symbolIn SourceName
bibtexKeyChar)
ParsecT [Tok] LaTeXState m [Tok]
-> LP m () -> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp
ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe Tok)
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m (Maybe Tok)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
',')
ParsecT [Tok] LaTeXState m [Tok]
-> LP m () -> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp)
where bibtexKeyChar :: SourceName
bibtexKeyChar = SourceName
".:;?!`'()/*@_+=-&[]" :: [Char]
cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]
cites :: CitationMode -> Bool -> LP m [Citation]
cites CitationMode
mode Bool
multi = LP m [Citation] -> LP m [Citation]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m [Citation] -> LP m [Citation])
-> LP m [Citation] -> LP m [Citation]
forall a b. (a -> b) -> a -> b
$ do
[[Citation]]
cits <- if Bool
multi
then do
Maybe [Inline]
multiprenote <- ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline]))
-> ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline])
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inline]
forall a. Many a -> [a]
toList (Inlines -> [Inline])
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
paropt
Maybe [Inline]
multipostnote <- ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline]))
-> ParsecT [Tok] LaTeXState m [Inline]
-> ParsecT [Tok] LaTeXState m (Maybe [Inline])
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inline]
forall a. Many a -> [a]
toList (Inlines -> [Inline])
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
paropt
let ([Inline]
pre, [Inline]
suf) = case (Maybe [Inline]
multiprenote, Maybe [Inline]
multipostnote) of
(Just [Inline]
s , Maybe [Inline]
Nothing) -> ([Inline]
forall a. Monoid a => a
mempty, [Inline]
s)
(Maybe [Inline]
Nothing , Just [Inline]
t) -> ([Inline]
forall a. Monoid a => a
mempty, [Inline]
t)
(Just [Inline]
s , Just [Inline]
t ) -> ([Inline]
s, [Inline]
t)
(Maybe [Inline], Maybe [Inline])
_ -> ([Inline]
forall a. Monoid a => a
mempty, [Inline]
forall a. Monoid a => a
mempty)
[[Citation]]
tempCits <- LP m [Citation] -> ParsecT [Tok] LaTeXState m [[Citation]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 LP m [Citation]
forall (m :: * -> *). PandocMonad m => LP m [Citation]
simpleCiteArgs
case [[Citation]]
tempCits of
([Citation]
k:[[Citation]]
ks) -> case [[Citation]]
ks of
([Citation]
_:[[Citation]]
_) -> [[Citation]] -> ParsecT [Tok] LaTeXState m [[Citation]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Citation]] -> ParsecT [Tok] LaTeXState m [[Citation]])
-> [[Citation]] -> ParsecT [Tok] LaTeXState m [[Citation]]
forall a b. (a -> b) -> a -> b
$ ([Inline] -> [Citation] -> [Citation]
addMprenote [Inline]
pre [Citation]
k [Citation] -> [[Citation]] -> [[Citation]]
forall a. a -> [a] -> [a]
: [[Citation]] -> [[Citation]]
forall a. [a] -> [a]
init [[Citation]]
ks) [[Citation]] -> [[Citation]] -> [[Citation]]
forall a. [a] -> [a] -> [a]
++
[[Inline] -> [Citation] -> [Citation]
addMpostnote [Inline]
suf ([[Citation]] -> [Citation]
forall a. [a] -> a
last [[Citation]]
ks)]
[[Citation]]
_ -> [[Citation]] -> ParsecT [Tok] LaTeXState m [[Citation]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Inline] -> [Citation] -> [Citation]
addMprenote [Inline]
pre ([Inline] -> [Citation] -> [Citation]
addMpostnote [Inline]
suf [Citation]
k)]
[[Citation]]
_ -> [[Citation]] -> ParsecT [Tok] LaTeXState m [[Citation]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[]]
else Int -> LP m [Citation] -> ParsecT [Tok] LaTeXState m [[Citation]]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 LP m [Citation]
forall (m :: * -> *). PandocMonad m => LP m [Citation]
simpleCiteArgs
let cs :: [Citation]
cs = [[Citation]] -> [Citation]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Citation]]
cits
[Citation] -> LP m [Citation]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Citation] -> LP m [Citation]) -> [Citation] -> LP m [Citation]
forall a b. (a -> b) -> a -> b
$ case CitationMode
mode of
CitationMode
AuthorInText -> case [Citation]
cs of
(Citation
c:[Citation]
rest) -> Citation
c {citationMode :: CitationMode
citationMode = CitationMode
mode} Citation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
: [Citation]
rest
[] -> []
CitationMode
_ -> (Citation -> Citation) -> [Citation] -> [Citation]
forall a b. (a -> b) -> [a] -> [b]
map (\Citation
a -> Citation
a {citationMode :: CitationMode
citationMode = CitationMode
mode}) [Citation]
cs
where mprenote :: [Inline] -> [Inline]
mprenote (Inline
k:[Inline]
ks) = (Inline
kInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ks) [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline
Space]
mprenote [Inline]
_ = [Inline]
forall a. Monoid a => a
mempty
mpostnote :: [Inline] -> [Inline]
mpostnote (Inline
k:[Inline]
ks) = [Text -> Inline
Str Text
",", Inline
Space] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ (Inline
kInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ks)
mpostnote [Inline]
_ = [Inline]
forall a. Monoid a => a
mempty
addMprenote :: [Inline] -> [Citation] -> [Citation]
addMprenote [Inline]
mpn (Citation
k:[Citation]
ks) =
let mpnfinal :: [Inline]
mpnfinal = case Citation -> [Inline]
citationPrefix Citation
k of
(Inline
_:[Inline]
_) -> [Inline] -> [Inline]
mprenote [Inline]
mpn
[Inline]
_ -> [Inline]
mpn
in [Inline] -> [Citation] -> [Citation]
addPrefix [Inline]
mpnfinal (Citation
kCitation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
ks)
addMprenote [Inline]
_ [Citation]
_ = []
addMpostnote :: [Inline] -> [Citation] -> [Citation]
addMpostnote = [Inline] -> [Citation] -> [Citation]
addSuffix ([Inline] -> [Citation] -> [Citation])
-> ([Inline] -> [Inline]) -> [Inline] -> [Citation] -> [Citation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
mpostnote
citation :: PandocMonad m => Text -> CitationMode -> Bool -> LP m Inlines
citation :: Text -> CitationMode -> Bool -> LP m Inlines
citation Text
name CitationMode
mode Bool
multi = do
([Citation]
c,[Tok]
raw) <- LP m [Citation] -> LP m ([Citation], [Tok])
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m (a, [Tok])
withRaw (LP m [Citation] -> LP m ([Citation], [Tok]))
-> LP m [Citation] -> LP m ([Citation], [Tok])
forall a b. (a -> b) -> a -> b
$ CitationMode -> Bool -> LP m [Citation]
forall (m :: * -> *).
PandocMonad m =>
CitationMode -> Bool -> LP m [Citation]
cites CitationMode
mode Bool
multi
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ [Citation] -> Inlines -> Inlines
cite [Citation]
c (Text -> Text -> Inlines
rawInline Text
"latex" (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
raw)
handleCitationPart :: Inlines -> [Citation]
handleCitationPart :: Inlines -> [Citation]
handleCitationPart Inlines
ils =
let isCite :: Inline -> Bool
isCite Cite{} = Bool
True
isCite Inline
_ = Bool
False
([Inline]
pref, [Inline]
rest) = (Inline -> Bool) -> [Inline] -> ([Inline], [Inline])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Inline -> Bool
isCite (Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
ils)
in case [Inline]
rest of
(Cite [Citation]
cs [Inline]
_:[Inline]
suff) -> [Inline] -> [Citation] -> [Citation]
addPrefix [Inline]
pref ([Citation] -> [Citation]) -> [Citation] -> [Citation]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Citation] -> [Citation]
addSuffix [Inline]
suff [Citation]
cs
[Inline]
_ -> []
complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines
complexNatbibCitation :: CitationMode -> LP m Inlines
complexNatbibCitation CitationMode
mode = LP m Inlines -> LP m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ do
([Citation]
cs, [Tok]
raw) <-
LP m [Citation] -> LP m ([Citation], [Tok])
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m (a, [Tok])
withRaw (LP m [Citation] -> LP m ([Citation], [Tok]))
-> LP m [Citation] -> LP m ([Citation], [Tok])
forall a b. (a -> b) -> a -> b
$ [[Citation]] -> [Citation]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Citation]] -> [Citation])
-> ParsecT [Tok] LaTeXState m [[Citation]] -> LP m [Citation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
bgroup
[Inlines]
items <- [[Inlines]] -> [Inlines]
forall a. Monoid a => [a] -> a
mconcat ([[Inlines]] -> [Inlines])
-> ParsecT [Tok] LaTeXState m [[Inlines]]
-> ParsecT [Tok] LaTeXState m [Inlines]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
LP m Inlines -> ParsecT [Tok] LaTeXState m [Inlines]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (LP m Tok -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
';') ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline)
ParsecT [Tok] LaTeXState m [Inlines]
-> LP m Tok -> ParsecT [Tok] LaTeXState m [[Inlines]]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepBy1` Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
';'
LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
egroup
[[Citation]] -> ParsecT [Tok] LaTeXState m [[Citation]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Citation]] -> ParsecT [Tok] LaTeXState m [[Citation]])
-> [[Citation]] -> ParsecT [Tok] LaTeXState m [[Citation]]
forall a b. (a -> b) -> a -> b
$ (Inlines -> [Citation]) -> [Inlines] -> [[Citation]]
forall a b. (a -> b) -> [a] -> [b]
map Inlines -> [Citation]
handleCitationPart [Inlines]
items
case [Citation]
cs of
[] -> LP m Inlines
forall (m :: * -> *) a. MonadPlus m => m a
mzero
(Citation
c:[Citation]
cits) -> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ [Citation] -> Inlines -> Inlines
cite (Citation
c{ citationMode :: CitationMode
citationMode = CitationMode
mode }Citation -> [Citation] -> [Citation]
forall a. a -> [a] -> [a]
:[Citation]
cits)
(Text -> Text -> Inlines
rawInline Text
"latex" (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text
"\\citetext" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
raw)
inNote :: Inlines -> Inlines
inNote :: Inlines -> Inlines
inNote Inlines
ils =
Blocks -> Inlines
note (Blocks -> Inlines) -> Blocks -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"."
inlineCommand' :: PandocMonad m => LP m Inlines
inlineCommand' :: LP m Inlines
inlineCommand' = LP m Inlines -> LP m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ do
Tok SourcePos
_ (CtrlSeq Text
name) Text
cmd <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyControlSeq
Bool -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] LaTeXState m ())
-> Bool -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"begin" Bool -> Bool -> Bool
&& Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"end" Bool -> Bool -> Bool
&& Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"and"
Text
star <- Text
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (Text
"*" Text -> LP m Tok -> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'*' ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp)
Text
overlay <- Text
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => LP m Text
overlaySpecification
let name' :: Text
name' = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
star Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
overlay
let names :: [Text]
names = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub [Text
name', Text
name]
let raw :: LP m Inlines
raw = do
Bool -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] LaTeXState m ())
-> Bool -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool
isInlineCommand Text
name Bool -> Bool -> Bool
|| Bool -> Bool
not (Text -> Bool
isBlockCommand Text
name)
Text
rawcommand <- Text -> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> Text -> LP m Text
getRawCommand Text
name (Text
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
star)
(Extension -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_raw_tex ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> Inlines
rawInline Text
"latex" Text
rawcommand))
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> LP m Inlines
forall a (m :: * -> *) s u.
(Monoid a, PandocMonad m) =>
Text -> ParserT s u m a
ignore Text
rawcommand
LP m Inlines -> [Text] -> Map Text (LP m Inlines) -> LP m Inlines
forall k v. Ord k => v -> [k] -> Map k v -> v
lookupListDefault LP m Inlines
raw [Text]
names Map Text (LP m Inlines)
forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
inlineCommands
tok :: PandocMonad m => LP m Inlines
tok :: LP m Inlines
tok = LP m Inlines -> LP m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces LP m () -> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlineCommand' LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
singleChar'
where singleChar' :: LP m Inlines
singleChar' = do
Tok SourcePos
_ TokType
_ Text
t <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
singleChar
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str Text
t
opt :: PandocMonad m => LP m Inlines
opt :: LP m Inlines
opt = do
[Tok]
toks <- ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp LP m ()
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracketedToks ParsecT [Tok] LaTeXState m [Tok]
-> LP m () -> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp)
LaTeXState
st <- ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Either ParseError Inlines
parsed <- ParsecT [Tok] LaTeXState (ParsecT [Tok] LaTeXState m) Inlines
-> LaTeXState
-> SourceName
-> [Tok]
-> ParsecT [Tok] LaTeXState m (Either ParseError Inlines)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
runParserT ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT [Tok] LaTeXState (ParsecT [Tok] LaTeXState m) [Inlines]
-> ParsecT [Tok] LaTeXState (ParsecT [Tok] LaTeXState m) Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState (ParsecT [Tok] LaTeXState m) Inlines
-> ParsecT [Tok] LaTeXState (ParsecT [Tok] LaTeXState m) [Inlines]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT [Tok] LaTeXState (ParsecT [Tok] LaTeXState m) Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline) LaTeXState
st SourceName
"bracketed option" [Tok]
toks
case Either ParseError Inlines
parsed of
Right Inlines
result -> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
result
Left ParseError
e -> PandocError -> LP m Inlines
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> LP m Inlines) -> PandocError -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> ParseError -> PandocError
PandocParsecError ([Tok] -> Text
untokenize [Tok]
toks) ParseError
e
paropt :: PandocMonad m => LP m Inlines
paropt :: LP m Inlines
paropt = LP m Inlines -> LP m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
parenWrapped LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline
inBrackets :: Inlines -> Inlines
inBrackets :: Inlines -> Inlines
inBrackets Inlines
x = Text -> Inlines
str Text
"[" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"]"
unescapeURL :: Text -> Text
unescapeURL :: Text -> Text
unescapeURL = [Text] -> Text
T.concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
go ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"\\"
where
isEscapable :: Char -> Bool
isEscapable Char
c = Char
c Char -> Text -> Bool
`elemText` Text
"#$%&~_^\\{}"
go :: [Text] -> [Text]
go (Text
x:[Text]
xs) = Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
unescapeInterior [Text]
xs
go [] = []
unescapeInterior :: Text -> Text
unescapeInterior Text
t
| Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
t
, Char -> Bool
isEscapable Char
c = Text
t
| Bool
otherwise = Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
mathEnvWith :: PandocMonad m
=> (Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith :: (Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> a
f Maybe Text
innerEnv Text
name = Inlines -> a
f (Inlines -> a) -> (Text -> Inlines) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
mathDisplay (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
inner (Text -> a) -> ParsecT [Tok] LaTeXState m Text -> LP m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> LP m Text
mathEnv Text
name
where inner :: Text -> Text
inner Text
x = case Maybe Text
innerEnv of
Maybe Text
Nothing -> Text
x
Just Text
y -> Text
"\\begin{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\\end{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
mathEnv :: PandocMonad m => Text -> LP m Text
mathEnv :: Text -> LP m Text
mathEnv Text
name = do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
LP m () -> ParsecT [Tok] LaTeXState m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
blankline
[Tok]
res <- ParsecT [Tok] LaTeXState m Tok
-> LP m () -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok (Text -> LP m ()
forall (m :: * -> *). PandocMonad m => Text -> LP m ()
end_ Text
name)
Text -> LP m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> LP m Text) -> Text -> LP m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripTrailingNewlines (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize [Tok]
res
inlineEnvironment :: PandocMonad m => LP m Inlines
inlineEnvironment :: LP m Inlines
inlineEnvironment = LP m Inlines -> LP m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ do
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"begin"
Text
name <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
LP m Inlines -> Text -> Map Text (LP m Inlines) -> LP m Inlines
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault LP m Inlines
forall (m :: * -> *) a. MonadPlus m => m a
mzero Text
name Map Text (LP m Inlines)
forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
inlineEnvironments
inlineEnvironments :: PandocMonad m => M.Map Text (LP m Inlines)
inlineEnvironments :: Map Text (LP m Inlines)
inlineEnvironments = [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
(Text
"displaymath", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing Text
"displaymath")
, (Text
"math", Text -> Inlines
math (Text -> Inlines)
-> ParsecT [Tok] LaTeXState m Text -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> LP m Text
mathEnv Text
"math")
, (Text
"equation", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing Text
"equation")
, (Text
"equation*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing Text
"equation*")
, (Text
"gather", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"gathered") Text
"gather")
, (Text
"gather*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"gathered") Text
"gather*")
, (Text
"multline", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"gathered") Text
"multline")
, (Text
"multline*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"gathered") Text
"multline*")
, (Text
"eqnarray", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"eqnarray")
, (Text
"eqnarray*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"eqnarray*")
, (Text
"align", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"align")
, (Text
"align*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"align*")
, (Text
"alignat", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"alignat")
, (Text
"alignat*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"alignat*")
, (Text
"dmath", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing Text
"dmath")
, (Text
"dmath*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing Text
"dmath*")
, (Text
"dgroup", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"dgroup")
, (Text
"dgroup*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"dgroup*")
, (Text
"darray", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"darray")
, (Text
"darray*", (Inlines -> Inlines) -> Maybe Text -> Text -> LP m Inlines
forall (m :: * -> *) a.
PandocMonad m =>
(Inlines -> a) -> Maybe Text -> Text -> LP m a
mathEnvWith Inlines -> Inlines
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aligned") Text
"darray*")
]
inlineCommands :: PandocMonad m => M.Map Text (LP m Inlines)
inlineCommands :: Map Text (LP m Inlines)
inlineCommands = Map Text (LP m Inlines)
-> Map Text (LP m Inlines) -> Map Text (LP m Inlines)
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Text (LP m Inlines)
forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
inlineLanguageCommands (Map Text (LP m Inlines) -> Map Text (LP m Inlines))
-> Map Text (LP m Inlines) -> Map Text (LP m Inlines)
forall a b. (a -> b) -> a -> b
$ [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Text
"emph", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
emph (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"textit", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
emph (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"textsl", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
emph (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"textsc", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
smallcaps (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"textsf", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"sans-serif"],[])) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"textmd", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"medium"],[])) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"textrm", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"roman"],[])) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"textup", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"upright"],[])) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"texttt", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
ttfamily)
, (Text
"sout", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
strikeout (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"alert", LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts LP m () -> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"alert"],[]) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"lq", Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"‘"))
, (Text
"rq", Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"’"))
, (Text
"textquoteleft", Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"‘"))
, (Text
"textquoteright", Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"’"))
, (Text
"textquotedblleft", Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"“"))
, (Text
"textquotedblright", Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"”"))
, (Text
"textsuperscript", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
superscript (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"textsubscript", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
subscript (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"textbackslash", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\\")
, (Text
"backslash", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\\")
, (Text
"slash", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"/")
, (Text
"textbf", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
strong (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"textnormal", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"nodecor"],[])) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"underline", Inlines -> Inlines
underline (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"ldots", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"…")
, (Text
"vdots", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\8942")
, (Text
"dots", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"…")
, (Text
"mdots", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"…")
, (Text
"sim", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"~")
, (Text
"sep", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
",")
, (Text
"label", Text -> LP m Inlines -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"label" LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
dolabel)
, (Text
"ref", Text -> LP m Inlines -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"ref" (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doref Text
"ref")
, (Text
"cref", Text -> LP m Inlines -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"cref" (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doref Text
"ref")
, (Text
"vref", Text -> LP m Inlines -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"vref" (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doref Text
"ref+page")
, (Text
"eqref", Text -> LP m Inlines -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"eqref" (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doref Text
"eqref")
, (Text
"mbox", Text -> LP m Inlines -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"mbox" (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
processHBox (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"hbox", Text -> LP m Inlines -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"hbox" (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
processHBox (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"lettrine", Text -> LP m Inlines -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"lettrine" LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
lettrine)
, (Text
"(", Text -> Inlines
mathInline (Text -> Inlines) -> ([Tok] -> Text) -> [Tok] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Tok] -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok (Text -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
")"))
, (Text
"[", Text -> Inlines
mathDisplay (Text -> Inlines) -> ([Tok] -> Text) -> [Tok] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Tok] -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok (Text -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"]"))
, (Text
"ensuremath", Text -> Inlines
mathInline (Text -> Inlines) -> ([Tok] -> Text) -> [Tok] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Tok] -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced)
, (Text
"texorpdfstring", Inlines -> Inlines -> Inlines
forall a b. a -> b -> a
const (Inlines -> Inlines -> Inlines)
-> LP m Inlines -> ParsecT [Tok] LaTeXState m (Inlines -> Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok ParsecT [Tok] LaTeXState m (Inlines -> Inlines)
-> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"P", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"¶")
, (Text
"S", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"§")
, (Text
"$", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"$")
, (Text
"%", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"%")
, (Text
"&", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"&")
, (Text
"#", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"#")
, (Text
"_", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"_")
, (Text
"{", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"{")
, (Text
"}", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"}")
, (Text
"qed", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\a0\x25FB")
, (Text
"em", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
emph (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines)
, (Text
"it", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
emph (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines)
, (Text
"sl", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
emph (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines)
, (Text
"bf", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
strong (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines)
, (Text
"tt", Text -> Inlines
code (Text -> Inlines) -> (Inlines -> Text) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> (Inlines -> [Inline]) -> Inlines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
forall a. Many a -> [a]
toList (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines)
, (Text
"rm", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines)
, (Text
"itshape", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
emph (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines)
, (Text
"slshape", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
emph (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines)
, (Text
"scshape", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
smallcaps (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines)
, (Text
"bfseries", (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
strong (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines)
, (Text
"MakeUppercase", Inlines -> Inlines
makeUppercase (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"MakeTextUppercase", Inlines -> Inlines
makeUppercase (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"uppercase", Inlines -> Inlines
makeUppercase (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"MakeLowercase", Inlines -> Inlines
makeLowercase (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"MakeTextLowercase", Inlines -> Inlines
makeLowercase (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"lowercase", Inlines -> Inlines
makeLowercase (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"/", Inlines -> LP m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty)
, (Text
"aa", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"å")
, (Text
"AA", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"Å")
, (Text
"ss", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ß")
, (Text
"o", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ø")
, (Text
"O", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"Ø")
, (Text
"L", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"Ł")
, (Text
"l", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ł")
, (Text
"ae", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"æ")
, (Text
"AE", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"Æ")
, (Text
"oe", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"œ")
, (Text
"OE", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"Œ")
, (Text
"pounds", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"£")
, (Text
"euro", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"€")
, (Text
"copyright", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"©")
, (Text
"textasciicircum", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"^")
, (Text
"textasciitilde", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"~")
, (Text
"H", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\779' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"`", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\768' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'`'))
, (Text
"'", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\769' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\''))
, (Text
"^", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\770' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'^'))
, (Text
"~", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\771' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'~'))
, (Text
"\"", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\776' Maybe Char
forall a. Maybe a
Nothing)
, (Text
".", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\775' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"=", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\772' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"|", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\781' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"b", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\817' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"c", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\807' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"G", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\783' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"h", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\777' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"d", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\803' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"f", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\785' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"r", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\778' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"t", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\865' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"U", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\782' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"v", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\780' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"u", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\774' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"k", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\808' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"textogonekcentered", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\808' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"i", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ı")
, (Text
"j", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ȷ")
, (Text
"newtie", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\785' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"textcircled", Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Char -> Maybe Char -> LP m Inlines
accent Char
'\8413' Maybe Char
forall a. Maybe a
Nothing)
, (Text
"\\", Inlines
linebreak Inlines -> LP m () -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (do Bool
inTableCell <- LaTeXState -> Bool
sInTableCell (LaTeXState -> Bool)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Bool -> LP m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> LP m ()) -> Bool -> LP m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
inTableCell
LP m Inlines -> ParsecT [Tok] LaTeXState m (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces))
, (Text
",", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\8198")
, (Text
"@", Inlines -> LP m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty)
, (Text
" ", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\160")
, (Text
"ps", Inlines -> LP m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str Text
"PS." Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space)
, (Text
"TeX", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"TeX")
, (Text
"LaTeX", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"LaTeX")
, (Text
"bar", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"|")
, (Text
"textless", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"<")
, (Text
"textgreater", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
">")
, (Text
"thanks", LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts LP m () -> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blocks -> Inlines
note (Blocks -> Inlines)
-> ParsecT [Tok] LaTeXState m Blocks -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Blocks
-> ParsecT [Tok] LaTeXState m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped ParsecT [Tok] LaTeXState m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block)
, (Text
"footnote", LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts LP m () -> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blocks -> Inlines
note (Blocks -> Inlines)
-> ParsecT [Tok] LaTeXState m Blocks -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Blocks
-> ParsecT [Tok] LaTeXState m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped ParsecT [Tok] LaTeXState m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block)
, (Text
"passthrough", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"verb", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
doverb)
, (Text
"lstinline", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
dolstinline)
, (Text
"mintinline", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
domintinline)
, (Text
"Verb", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
doverb)
, (Text
"url", (\Text
url -> Text -> Text -> Inlines -> Inlines
link Text
url Text
"" (Text -> Inlines
str Text
url)) (Text -> Inlines) -> ([Tok] -> Text) -> [Tok] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
unescapeURL (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Tok] -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracedUrl)
, (Text
"nolinkurl", Text -> Inlines
code (Text -> Inlines) -> ([Tok] -> Text) -> [Tok] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
unescapeURL (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Tok] -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracedUrl)
, (Text
"href", do [Tok]
url <- ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracedUrl
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp
Text -> Text -> Inlines -> Inlines
link (Text -> Text
unescapeURL (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize [Tok]
url) Text
"" (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"includegraphics", do [(Text, Text)]
options <- [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] LaTeXState m [(Text, Text)]
forall (m :: * -> *). PandocMonad m => LP m [(Text, Text)]
keyvals
[Tok]
src <- ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
[(Text, Text)] -> Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> Text -> LP m Inlines
mkImage [(Text, Text)]
options (Text -> LP m Inlines) -> (Text -> Text) -> Text -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
unescapeURL (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
removeDoubleQuotes (Text -> LP m Inlines) -> Text -> LP m Inlines
forall a b. (a -> b) -> a -> b
$
[Tok] -> Text
untokenize [Tok]
src)
, (Text
"enquote*", Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Inlines
enquote Bool
True Maybe Text
forall a. Maybe a
Nothing)
, (Text
"enquote", Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Inlines
enquote Bool
False Maybe Text
forall a. Maybe a
Nothing)
, (Text
"foreignquote*", ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m [Tok]
-> ([Tok] -> LP m Inlines) -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Inlines
enquote Bool
True (Maybe Text -> LP m Inlines)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
, (Text
"foreignquote", ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m [Tok]
-> ([Tok] -> LP m Inlines) -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Inlines
enquote Bool
False (Maybe Text -> LP m Inlines)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
, (Text
"hyphenquote*", ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m [Tok]
-> ([Tok] -> LP m Inlines) -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Inlines
enquote Bool
True (Maybe Text -> LP m Inlines)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
, (Text
"hyphenquote", ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m [Tok]
-> ([Tok] -> LP m Inlines) -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Inlines
enquote Bool
False (Maybe Text -> LP m Inlines)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
, (Text
"figurename", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Figure)
, (Text
"prefacename", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Preface)
, (Text
"refname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.References)
, (Text
"bibname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Bibliography)
, (Text
"chaptername", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Chapter)
, (Text
"partname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Part)
, (Text
"contentsname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Contents)
, (Text
"listfigurename", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.ListOfFigures)
, (Text
"listtablename", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.ListOfTables)
, (Text
"indexname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Index)
, (Text
"abstractname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Abstract)
, (Text
"tablename", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Table)
, (Text
"enclname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Encl)
, (Text
"ccname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Cc)
, (Text
"headtoname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.To)
, (Text
"pagename", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Page)
, (Text
"seename", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.See)
, (Text
"seealsoname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.SeeAlso)
, (Text
"proofname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Proof)
, (Text
"glossaryname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Glossary)
, (Text
"lstlistingname", Term -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Listing)
, (Text
"cite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"cite" CitationMode
NormalCitation Bool
False)
, (Text
"Cite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Cite" CitationMode
NormalCitation Bool
False)
, (Text
"citep", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citep" CitationMode
NormalCitation Bool
False)
, (Text
"citep*", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citep*" CitationMode
NormalCitation Bool
False)
, (Text
"citeal", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citeal" CitationMode
NormalCitation Bool
False)
, (Text
"citealp", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citealp" CitationMode
NormalCitation Bool
False)
, (Text
"citealp*", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citealp*" CitationMode
NormalCitation Bool
False)
, (Text
"autocite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"autocite" CitationMode
NormalCitation Bool
False)
, (Text
"smartcite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"smartcite" CitationMode
NormalCitation Bool
False)
, (Text
"footcite", Inlines -> Inlines
inNote (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"footcite" CitationMode
NormalCitation Bool
False)
, (Text
"parencite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"parencite" CitationMode
NormalCitation Bool
False)
, (Text
"supercite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"supercite" CitationMode
NormalCitation Bool
False)
, (Text
"footcitetext", Inlines -> Inlines
inNote (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"footcitetext" CitationMode
NormalCitation Bool
False)
, (Text
"citeyearpar", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citeyearpar" CitationMode
SuppressAuthor Bool
False)
, (Text
"citeyear", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citeyear" CitationMode
SuppressAuthor Bool
False)
, (Text
"autocite*", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"autocite*" CitationMode
SuppressAuthor Bool
False)
, (Text
"cite*", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"cite*" CitationMode
SuppressAuthor Bool
False)
, (Text
"parencite*", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"parencite*" CitationMode
SuppressAuthor Bool
False)
, (Text
"textcite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"textcite" CitationMode
AuthorInText Bool
False)
, (Text
"citet", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citet" CitationMode
AuthorInText Bool
False)
, (Text
"citet*", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citet*" CitationMode
AuthorInText Bool
False)
, (Text
"citealt", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citealt" CitationMode
AuthorInText Bool
False)
, (Text
"citealt*", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citealt*" CitationMode
AuthorInText Bool
False)
, (Text
"textcites", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"textcites" CitationMode
AuthorInText Bool
True)
, (Text
"cites", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"cites" CitationMode
NormalCitation Bool
True)
, (Text
"autocites", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"autocites" CitationMode
NormalCitation Bool
True)
, (Text
"footcites", Inlines -> Inlines
inNote (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"footcites" CitationMode
NormalCitation Bool
True)
, (Text
"parencites", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"parencites" CitationMode
NormalCitation Bool
True)
, (Text
"supercites", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"supercites" CitationMode
NormalCitation Bool
True)
, (Text
"footcitetexts", Inlines -> Inlines
inNote (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"footcitetexts" CitationMode
NormalCitation Bool
True)
, (Text
"Autocite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Autocite" CitationMode
NormalCitation Bool
False)
, (Text
"Smartcite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Smartcite" CitationMode
NormalCitation Bool
False)
, (Text
"Footcite", Inlines -> Inlines
inNote (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Footcite" CitationMode
NormalCitation Bool
False)
, (Text
"Parencite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Parencite" CitationMode
NormalCitation Bool
False)
, (Text
"Supercite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Supercite" CitationMode
NormalCitation Bool
False)
, (Text
"Footcitetext", Inlines -> Inlines
inNote (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Footcitetext" CitationMode
NormalCitation Bool
False)
, (Text
"Citeyearpar", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Citeyearpar" CitationMode
SuppressAuthor Bool
False)
, (Text
"Citeyear", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Citeyear" CitationMode
SuppressAuthor Bool
False)
, (Text
"Autocite*", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Autocite*" CitationMode
SuppressAuthor Bool
False)
, (Text
"Cite*", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Cite*" CitationMode
SuppressAuthor Bool
False)
, (Text
"Parencite*", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Parencite*" CitationMode
SuppressAuthor Bool
False)
, (Text
"Textcite", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Textcite" CitationMode
AuthorInText Bool
False)
, (Text
"Textcites", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Textcites" CitationMode
AuthorInText Bool
True)
, (Text
"Cites", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Cites" CitationMode
NormalCitation Bool
True)
, (Text
"Autocites", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Autocites" CitationMode
NormalCitation Bool
True)
, (Text
"Footcites", Inlines -> Inlines
inNote (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Footcites" CitationMode
NormalCitation Bool
True)
, (Text
"Parencites", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Parencites" CitationMode
NormalCitation Bool
True)
, (Text
"Supercites", Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Supercites" CitationMode
NormalCitation Bool
True)
, (Text
"Footcitetexts", Inlines -> Inlines
inNote (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"Footcitetexts" CitationMode
NormalCitation Bool
True)
, (Text
"citetext", CitationMode -> LP m Inlines
forall (m :: * -> *). PandocMonad m => CitationMode -> LP m Inlines
complexNatbibCitation CitationMode
NormalCitation)
, (Text
"citeauthor", (ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m Tok
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines -> LP m () -> LP m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp LP m ()
-> ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"citetext") ParsecT [Tok] LaTeXState m Tok -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
CitationMode -> LP m Inlines
forall (m :: * -> *). PandocMonad m => CitationMode -> LP m Inlines
complexNatbibCitation CitationMode
AuthorInText)
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"citeauthor" CitationMode
AuthorInText Bool
False)
, (Text
"nocite", Inlines
forall a. Monoid a => a
mempty Inlines -> LP m () -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> CitationMode -> Bool -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> CitationMode -> Bool -> LP m Inlines
citation Text
"nocite" CitationMode
NormalCitation Bool
False LP m Inlines -> (Inlines -> LP m ()) -> LP m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Text -> Inlines -> LP m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"nocite"))
, (Text
"hyperlink", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
hyperlink)
, (Text
"hypertarget", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
hypertargetInline)
, (Text
"gls", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"short")
, (Text
"Gls", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"short")
, (Text
"glsdesc", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
, (Text
"Glsdesc", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
, (Text
"GLSdesc", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
, (Text
"acrlong", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
, (Text
"Acrlong", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
, (Text
"acrfull", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"full")
, (Text
"Acrfull", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"full")
, (Text
"acrshort", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"abbrv")
, (Text
"Acrshort", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"abbrv")
, (Text
"glspl", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"short")
, (Text
"Glspl", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"short")
, (Text
"glsdescplural", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"long")
, (Text
"Glsdescplural", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"long")
, (Text
"GLSdescplural", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"long")
, (Text
"ac", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"short")
, (Text
"acf", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"full")
, (Text
"acs", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"abbrv")
, (Text
"acl", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
, (Text
"acp", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"short")
, (Text
"acfp", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"full")
, (Text
"acsp", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"abbrv")
, (Text
"aclp", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"long")
, (Text
"Ac", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"short")
, (Text
"Acf", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"full")
, (Text
"Acs", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"abbrv")
, (Text
"Acl", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
, (Text
"Acp", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"short")
, (Text
"Acfp", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"full")
, (Text
"Acsp", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"abbrv")
, (Text
"Aclp", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"long")
, (Text
"si", LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts LP m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
dosi LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"SI", LP m Inlines -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
doSI LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"SIrange", Bool -> LP m Inlines -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Bool -> LP m Inlines -> LP m Inlines
doSIrange Bool
True LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"numrange", Bool -> LP m Inlines -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Bool -> LP m Inlines -> LP m Inlines
doSIrange Bool
False LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"numlist", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
doSInumlist)
, (Text
"num", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
doSInum)
, (Text
"ang", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
doSIang)
, (Text
"bshyp", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\\\173")
, (Text
"fshyp", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"/\173")
, (Text
"dothyp", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
".\173")
, (Text
"colonhyp", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
":\173")
, (Text
"hyp", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"-")
, (Text
"nohyphens", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"textnhtt", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
ttfamily)
, (Text
"nhttfamily", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
ttfamily)
, (Text
"textcolor", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
coloredInline Text
"color")
, (Text
"colorbox", Text -> LP m Inlines
forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
coloredInline Text
"background-color")
, (Text
"faCheck", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\10003")
, (Text
"faClose", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\10007")
, (Text
"xspace", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
doxspace)
, (Text
"ifstrequal", LP m Inlines
forall (m :: * -> *) a. (PandocMonad m, Monoid a) => LP m a
ifstrequal)
, (Text
"newtoggle", ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m [Tok]
-> ([Tok] -> LP m Inlines) -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Tok] -> LP m Inlines
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
[Tok] -> LP m a
newToggle)
, (Text
"toggletrue", ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m [Tok]
-> ([Tok] -> LP m Inlines) -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> [Tok] -> LP m Inlines
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Bool -> [Tok] -> LP m a
setToggle Bool
True)
, (Text
"togglefalse", ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m [Tok]
-> ([Tok] -> LP m Inlines) -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> [Tok] -> LP m Inlines
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Bool -> [Tok] -> LP m a
setToggle Bool
False)
, (Text
"iftoggle", LP m Inlines -> LP m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
ifToggle LP m () -> LP m Inlines -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline)
, (Text
"RN", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
romanNumeralUpper)
, (Text
"Rn", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
romanNumeralLower)
, (Text
"foreignlanguage", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
foreignlanguage)
, (Text
"input", Text -> LP m Inlines -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"input" (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> LP m Inlines
forall (m :: * -> *) a. (PandocMonad m, Monoid a) => Text -> LP m a
include Text
"input")
, (Text
"ul", Inlines -> Inlines
underline (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"uline", Inlines -> Inlines
underline (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
, (Text
"ifdim", LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
ifdim)
]
accent :: PandocMonad m => Char -> Maybe Char -> LP m Inlines
accent :: Char -> Maybe Char -> LP m Inlines
accent Char
combiningAccent Maybe Char
fallBack = LP m Inlines -> LP m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ do
Inlines
ils <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
case Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
ils of
(Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
x, Text
xs)) : [Inline]
ys) -> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
fromList ([Inline] -> Inlines) -> [Inline] -> Inlines
forall a b. (a -> b) -> a -> b
$
Text -> Inline
Str (NormalizationMode -> Text -> Text
Normalize.normalize NormalizationMode
Normalize.NFC
(SourceName -> Text
T.pack [Char
x, Char
combiningAccent]) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xs) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ys
[Inline
Space] -> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
combiningAccent Maybe Char
fallBack
[] -> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
combiningAccent Maybe Char
fallBack
[Inline]
_ -> Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
ils
lettrine :: PandocMonad m => LP m Inlines
lettrine :: LP m Inlines
lettrine = do
LP m Inlines -> ParsecT [Tok] LaTeXState m (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt
Inlines
x <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
Inlines
y <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"lettrine"],[])) Inlines
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
smallcaps Inlines
y
ifdim :: PandocMonad m => LP m Inlines
ifdim :: LP m Inlines
ifdim = do
[Tok]
contents <- ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok (Text -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"fi")
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
rawInline Text
"latex" (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text
"\\ifdim" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\fi"
makeUppercase :: Inlines -> Inlines
makeUppercase :: Inlines -> Inlines
makeUppercase = [Inline] -> Inlines
forall a. [a] -> Many a
fromList ([Inline] -> Inlines)
-> (Inlines -> [Inline]) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk ((Text -> Text) -> Inline -> Inline
alterStr Text -> Text
T.toUpper) ([Inline] -> [Inline])
-> (Inlines -> [Inline]) -> Inlines -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
forall a. Many a -> [a]
toList
makeLowercase :: Inlines -> Inlines
makeLowercase :: Inlines -> Inlines
makeLowercase = [Inline] -> Inlines
forall a. [a] -> Many a
fromList ([Inline] -> Inlines)
-> (Inlines -> [Inline]) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk ((Text -> Text) -> Inline -> Inline
alterStr Text -> Text
T.toLower) ([Inline] -> [Inline])
-> (Inlines -> [Inline]) -> Inlines -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
forall a. Many a -> [a]
toList
alterStr :: (Text -> Text) -> Inline -> Inline
alterStr :: (Text -> Text) -> Inline -> Inline
alterStr Text -> Text
f (Str Text
xs) = Text -> Inline
Str (Text -> Text
f Text
xs)
alterStr Text -> Text
_ Inline
x = Inline
x
foreignlanguage :: PandocMonad m => LP m Inlines
foreignlanguage :: LP m Inlines
foreignlanguage = do
Text
babelLang <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
case Text -> Maybe Lang
babelLangToBCP47 Text
babelLang of
Just Lang
lang -> Attr -> Inlines -> Inlines
spanWith (Text
"", [], [(Text
"lang", Lang -> Text
renderLang Lang
lang)]) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
Maybe Lang
_ -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
inlineLanguageCommands :: PandocMonad m => M.Map Text (LP m Inlines)
inlineLanguageCommands :: Map Text (LP m Inlines)
inlineLanguageCommands = [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, LP m Inlines)] -> Map Text (LP m Inlines))
-> [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall a b. (a -> b) -> a -> b
$ (Text, Text -> Lang) -> (Text, LP m Inlines)
forall a (m :: * -> *).
(Semigroup a, IsString a, PandocMonad m) =>
(a, Text -> Lang) -> (a, LP m Inlines)
mk ((Text, Text -> Lang) -> (Text, LP m Inlines))
-> [(Text, Text -> Lang)] -> [(Text, LP m Inlines)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Text -> Lang) -> [(Text, Text -> Lang)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text (Text -> Lang)
polyglossiaLangToBCP47
where
mk :: (a, Text -> Lang) -> (a, LP m Inlines)
mk (a
polyglossia, Text -> Lang
bcp47Func) =
(a
"text" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
polyglossia, (Text -> Lang) -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Text -> Lang) -> LP m Inlines
inlineLanguage Text -> Lang
bcp47Func)
inlineLanguage :: PandocMonad m => (Text -> Lang) -> LP m Inlines
inlineLanguage :: (Text -> Lang) -> LP m Inlines
inlineLanguage Text -> Lang
bcp47Func = do
Text
o <- Text
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text)
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
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 -> Text)
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => LP m Text
rawopt
let lang :: Text
lang = Lang -> Text
renderLang (Lang -> Text) -> Lang -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Lang
bcp47Func Text
o
(Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Inlines -> Inlines
spanWith (Text
"", [], [(Text
"lang", Text
lang)])) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
hyperlink :: PandocMonad m => LP m Inlines
hyperlink :: LP m Inlines
hyperlink = LP m Inlines -> LP m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ do
Text
src <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Inlines
lab <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src) Text
"" Inlines
lab
hypertargetBlock :: PandocMonad m => LP m Blocks
hypertargetBlock :: LP m Blocks
hypertargetBlock = LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ do
Text
ref <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Blocks
bs <- LP m Blocks -> LP m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block
case Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
bs of
[Header Int
1 (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
_] | Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ref -> Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
bs
[Block]
_ -> Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
divWith (Text
ref, [], []) Blocks
bs
hypertargetInline :: PandocMonad m => LP m Inlines
hypertargetInline :: LP m Inlines
hypertargetInline = LP m Inlines -> LP m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Inlines -> LP m Inlines) -> LP m Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ do
Text
ref <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Inlines
ils <- LP m Inlines -> LP m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
ref, [], []) Inlines
ils
romanNumeralUpper :: (PandocMonad m) => LP m Inlines
romanNumeralUpper :: LP m Inlines
romanNumeralUpper =
Text -> Inlines
str (Text -> Inlines) -> (Int -> Text) -> Int -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
toRomanNumeral (Int -> Inlines) -> ParsecT [Tok] LaTeXState m Int -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Int
forall (m :: * -> *). PandocMonad m => LP m Int
romanNumeralArg
romanNumeralLower :: (PandocMonad m) => LP m Inlines
romanNumeralLower :: LP m Inlines
romanNumeralLower =
Text -> Inlines
str (Text -> Inlines) -> (Int -> Text) -> Int -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
toRomanNumeral (Int -> Inlines) -> ParsecT [Tok] LaTeXState m Int -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Int
forall (m :: * -> *). PandocMonad m => LP m Int
romanNumeralArg
romanNumeralArg :: (PandocMonad m) => LP m Int
romanNumeralArg :: LP m Int
romanNumeralArg = LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces LP m () -> LP m Int -> LP m Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (LP m Int
parser LP m Int -> LP m Int -> LP m Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Int
inBraces)
where
inBraces :: LP m Int
inBraces = do
Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'{'
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Int
res <- LP m Int
parser
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'}'
Int -> LP m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
res
parser :: LP m Int
parser = do
Tok SourcePos
_ TokType
Word Text
s <- (Tok -> Bool) -> LP m Tok
forall (m :: * -> *). PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok Tok -> Bool
isWordTok
let (Text
digits, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isDigit Text
s
Bool -> LP m () -> LP m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
rest) (LP m () -> LP m ()) -> LP m () -> LP m ()
forall a b. (a -> b) -> a -> b
$
SourceName -> LP m ()
forall (m :: * -> *) a. MonadFail m => SourceName -> m a
Prelude.fail SourceName
"Non-digits in argument to \\Rn or \\RN"
Text -> LP m Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
digits
newToggle :: (Monoid a, PandocMonad m) => [Tok] -> LP m a
newToggle :: [Tok] -> LP m a
newToggle [Tok]
name = do
(LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ())
-> (LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st ->
LaTeXState
st{ sToggles :: Map Text Bool
sToggles = Text -> Bool -> Map Text Bool -> Map Text Bool
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ([Tok] -> Text
untokenize [Tok]
name) Bool
False (LaTeXState -> Map Text Bool
sToggles LaTeXState
st) }
a -> LP m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
setToggle :: (Monoid a, PandocMonad m) => Bool -> [Tok] -> LP m a
setToggle :: Bool -> [Tok] -> LP m a
setToggle Bool
on [Tok]
name = do
(LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ())
-> (LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st ->
LaTeXState
st{ sToggles :: Map Text Bool
sToggles = (Bool -> Bool) -> Text -> Map Text Bool -> Map Text Bool
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
on) ([Tok] -> Text
untokenize [Tok]
name) (LaTeXState -> Map Text Bool
sToggles LaTeXState
st) }
a -> LP m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
ifToggle :: PandocMonad m => LP m ()
ifToggle :: LP m ()
ifToggle = do
[Tok]
name <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
[Tok]
yes <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
[Tok]
no <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Map Text Bool
toggles <- LaTeXState -> Map Text Bool
sToggles (LaTeXState -> Map Text Bool)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m (Map Text Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
[Tok]
inp <- LP m [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
let name' :: Text
name' = [Tok] -> Text
untokenize [Tok]
name
case Text -> Map Text Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name' Map Text Bool
toggles of
Just Bool
True -> [Tok] -> LP m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput ([Tok]
yes [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
inp)
Just Bool
False -> [Tok] -> LP m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput ([Tok]
no [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
inp)
Maybe Bool
Nothing -> do
SourcePos
pos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
LogMessage -> LP m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> LP m ()) -> LogMessage -> LP m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
UndefinedToggle Text
name' SourcePos
pos
() -> LP m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
doTerm :: PandocMonad m => Translations.Term -> LP m Inlines
doTerm :: Term -> LP m Inlines
doTerm Term
term = Text -> Inlines
str (Text -> Inlines)
-> ParsecT [Tok] LaTeXState m Text -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
term
ifstrequal :: (PandocMonad m, Monoid a) => LP m a
ifstrequal :: LP m a
ifstrequal = do
Inlines
str1 <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
Inlines
str2 <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
[Tok]
ifequal <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
[Tok]
ifnotequal <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
if Inlines
str1 Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
str2
then LP m [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput LP m [Tok]
-> ([Tok] -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Tok] -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput ([Tok] -> ParsecT [Tok] LaTeXState m ())
-> ([Tok] -> [Tok]) -> [Tok] -> ParsecT [Tok] LaTeXState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Tok]
ifequal [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++)
else LP m [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput LP m [Tok]
-> ([Tok] -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Tok] -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput ([Tok] -> ParsecT [Tok] LaTeXState m ())
-> ([Tok] -> [Tok]) -> [Tok] -> ParsecT [Tok] LaTeXState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Tok]
ifnotequal [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++)
a -> LP m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
coloredInline :: PandocMonad m => Text -> LP m Inlines
coloredInline :: Text -> LP m Inlines
coloredInline Text
stylename = do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
[Tok]
color <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Attr -> Inlines -> Inlines
spanWith (Text
"",[],[(Text
"style",Text
stylename Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
color)]) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
ttfamily :: PandocMonad m => LP m Inlines
ttfamily :: LP m Inlines
ttfamily = Text -> Inlines
code (Text -> Inlines) -> (Inlines -> Text) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> (Inlines -> [Inline]) -> Inlines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
forall a. Many a -> [a]
toList (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
rawInlineOr :: PandocMonad m => Text -> LP m Inlines -> LP m Inlines
rawInlineOr :: Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
name' LP m Inlines
fallback = do
Bool
parseRaw <- Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_tex (Extensions -> Bool)
-> ParsecT [Tok] LaTeXState m Extensions
-> ParsecT [Tok] LaTeXState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderOptions -> Extensions)
-> ParsecT [Tok] LaTeXState m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
if Bool
parseRaw
then Text -> Text -> Inlines
rawInline Text
"latex" (Text -> Inlines)
-> ParsecT [Tok] LaTeXState m Text -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> Text -> LP m Text
getRawCommand Text
name' (Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name')
else LP m Inlines
fallback
processHBox :: Inlines -> Inlines
processHBox :: Inlines -> Inlines
processHBox = (Inline -> Inline) -> Inlines -> Inlines
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
convert
where
convert :: Inline -> Inline
convert Inline
Space = Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
160
convert Inline
SoftBreak = Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
160
convert Inline
LineBreak = Text -> Inline
Str Text
""
convert Inline
x = Inline
x
isBlockCommand :: Text -> Bool
isBlockCommand :: Text -> Bool
isBlockCommand Text
s =
Text
s Text -> Map Text (LP PandocPure Blocks) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` (Map Text (LP PandocPure Blocks)
forall (m :: * -> *). PandocMonad m => Map Text (LP m Blocks)
blockCommands :: M.Map Text (LP PandocPure Blocks))
Bool -> Bool -> Bool
|| Text
s Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
treatAsBlock
treatAsBlock :: Set.Set Text
treatAsBlock :: Set Text
treatAsBlock = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
[ Text
"special", Text
"pdfannot", Text
"pdfstringdef"
, Text
"bibliographystyle"
, Text
"maketitle", Text
"makeindex", Text
"makeglossary"
, Text
"addcontentsline", Text
"addtocontents", Text
"addtocounter"
, Text
"ignore"
, Text
"hyperdef"
, Text
"markboth", Text
"markright", Text
"markleft"
, Text
"hspace", Text
"vspace"
, Text
"newpage"
, Text
"clearpage"
, Text
"pagebreak"
, Text
"titleformat"
, Text
"listoffigures"
, Text
"listoftables"
, Text
"write"
]
isInlineCommand :: Text -> Bool
isInlineCommand :: Text -> Bool
isInlineCommand Text
s =
Text
s Text -> Map Text (LP PandocPure Inlines) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` (Map Text (LP PandocPure Inlines)
forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
inlineCommands :: M.Map Text (LP PandocPure Inlines))
Bool -> Bool -> Bool
|| Text
s Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
treatAsInline
treatAsInline :: Set.Set Text
treatAsInline :: Set Text
treatAsInline = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
[ Text
"index"
, Text
"hspace"
, Text
"vspace"
, Text
"noindent"
, Text
"newpage"
, Text
"clearpage"
, Text
"pagebreak"
]
label :: PandocMonad m => LP m ()
label :: LP m ()
label = do
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"label"
[Tok]
t <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st -> LaTeXState
st{ sLastLabel :: Maybe Text
sLastLabel = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize [Tok]
t }
dolabel :: PandocMonad m => LP m Inlines
dolabel :: LP m Inlines
dolabel = do
[Tok]
v <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
let refstr :: Text
refstr = [Tok] -> Text
untokenize [Tok]
v
(LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ())
-> (LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st ->
LaTeXState
st{ sLastLabel :: Maybe Text
sLastLabel = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
refstr }
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
refstr,[],[(Text
"label", Text
refstr)])
(Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
inBrackets (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize [Tok]
v
doref :: PandocMonad m => Text -> LP m Inlines
doref :: Text -> LP m Inlines
doref Text
cls = do
[Tok]
v <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
let refstr :: Text
refstr = [Tok] -> Text
untokenize [Tok]
v
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
linkWith (Text
"",[],[ (Text
"reference-type", Text
cls)
, (Text
"reference", Text
refstr)])
(Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
refstr)
Text
""
(Inlines -> Inlines
inBrackets (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str Text
refstr)
lookupListDefault :: (Ord k) => v -> [k] -> M.Map k v -> v
lookupListDefault :: v -> [k] -> Map k v -> v
lookupListDefault v
d = (v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
d (Maybe v -> v) -> (Map k v -> Maybe v) -> Map k v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Map k v -> Maybe v) -> Map k v -> v)
-> ([k] -> Map k v -> Maybe v) -> [k] -> Map k v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k] -> Map k v -> Maybe v
forall k a. Ord k => [k] -> Map k a -> Maybe a
lookupList
where lookupList :: [k] -> Map k a -> Maybe a
lookupList [k]
l Map k a
m = [Maybe a] -> Maybe a
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe a] -> Maybe a) -> [Maybe a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ (k -> Maybe a) -> [k] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map (k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map k a
m) [k]
l
inline :: PandocMonad m => LP m Inlines
inline :: LP m Inlines
inline = (Inlines
forall a. Monoid a => a
mempty Inlines -> ParsecT [Tok] LaTeXState m () -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
comment)
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines
space Inlines -> ParsecT [Tok] LaTeXState m () -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
whitespace)
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inlines
softbreak Inlines -> ParsecT [Tok] LaTeXState m () -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
endline)
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
word
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Inlines) -> LP m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Text -> a) -> LP m a
macroDef (Text -> Text -> Inlines
rawInline Text
"latex")
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlineCommand'
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlineEnvironment
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlineGroup
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'-' LP m Tok -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
Inlines -> LP m Inlines -> LP m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> Inlines
str Text
"-") (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'-' LP m Tok -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
Inlines -> LP m Inlines -> LP m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> Inlines
str Text
"–") (Text -> Inlines
str Text
"—" Inlines -> LP m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'-')))
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
doubleQuote
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
singleQuote
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Inlines
str Text
"”" Inlines -> LP m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LP m Tok -> LP m Tok
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'\'' LP m Tok -> LP m Tok -> LP m Tok
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'\''))
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Inlines
str Text
"”" Inlines -> LP m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'”')
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Inlines
str Text
"’" Inlines -> LP m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'\'')
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Inlines
str Text
"’" Inlines -> LP m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'’')
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Inlines
str Text
"\160" Inlines -> LP m Tok -> LP m Inlines
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'~')
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
dollarsMath
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Extension -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_literate_haskell ParsecT [Tok] LaTeXState m () -> LP m Tok -> LP m Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'|' LP m Tok -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
doLHSverb)
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Inlines
str (Text -> Inlines) -> (Char -> Text) -> Char -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Inlines)
-> ParsecT [Tok] LaTeXState m Char -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Char
forall (m :: * -> *). PandocMonad m => LP m Char
primEscape)
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
regularSymbol
LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do Tok
res <- SourceName -> LP m Tok
forall (m :: * -> *). PandocMonad m => SourceName -> LP m Tok
symbolIn SourceName
"#^'`\"[]&"
SourcePos
pos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
let s :: Text
s = Tok -> Text
untoken Tok
res
LogMessage -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [Tok] LaTeXState m ())
-> LogMessage -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
ParsingUnescaped Text
s SourcePos
pos
Inlines -> LP m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> LP m Inlines) -> Inlines -> LP m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str Text
s)
inlines :: PandocMonad m => LP m Inlines
inlines :: LP m Inlines
inlines = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Inlines] -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines -> ParsecT [Tok] LaTeXState m [Inlines]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline
preamble :: PandocMonad m => LP m Blocks
preamble :: LP m Blocks
preamble = [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [Tok] LaTeXState m [Blocks] -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Blocks -> ParsecT [Tok] LaTeXState m [Blocks]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many LP m Blocks
preambleBlock
where preambleBlock :: LP m Blocks
preambleBlock = (Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces1)
LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Blocks) -> LP m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Text -> a) -> LP m a
macroDef (Text -> Text -> Blocks
rawBlock Text
"latex")
LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Blocks
forall a. Monoid a => a
mempty Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blockCommand)
LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m [Tok] -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced)
LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Text -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => Text -> LP m ()
begin_ Text
"document")
LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty)
rule :: PandocMonad m => LP m Blocks
rule :: LP m Blocks
rule = do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
Text
width <- (Char -> Bool) -> Text -> Text
T.takeWhile (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Text -> Text) -> (Inlines -> Text) -> Inlines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Text
forall a. Walkable Inline a => a -> Text
stringify (Inlines -> Text)
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
Inlines
_thickness <- ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
case Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
width of
Just (Double
0 :: Double) -> Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Maybe Double
_ -> Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
horizontalRule
paragraph :: PandocMonad m => LP m Blocks
paragraph :: LP m Blocks
paragraph = do
Inlines
x <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Inlines]
-> ParsecT [Tok] LaTeXState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m [Inlines]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline
if Inlines
x Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty
then Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
else Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para Inlines
x
rawBlockOr :: PandocMonad m => Text -> LP m Blocks -> LP m Blocks
rawBlockOr :: Text -> LP m Blocks -> LP m Blocks
rawBlockOr Text
name LP m Blocks
fallback = do
Bool
parseRaw <- Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_tex (Extensions -> Bool)
-> ParsecT [Tok] LaTeXState m Extensions
-> ParsecT [Tok] LaTeXState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderOptions -> Extensions)
-> ParsecT [Tok] LaTeXState m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
if Bool
parseRaw
then Text -> Text -> Blocks
rawBlock Text
"latex" (Text -> Blocks) -> ParsecT [Tok] LaTeXState m Text -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> Text -> LP m Text
getRawCommand Text
name (Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)
else LP m Blocks
fallback
doSubfile :: PandocMonad m => LP m Blocks
doSubfile :: LP m Blocks
doSubfile = do
ParsecT [Tok] LaTeXState m Inlines -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt
SourceName
f <- Text -> SourceName
T.unpack (Text -> SourceName) -> ([Tok] -> Text) -> [Tok] -> SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
removeDoubleQuotes (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> SourceName)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m SourceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
[Tok]
oldToks <- ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
[Tok] -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput []
SourceName -> SourceName -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *).
PandocMonad m =>
SourceName -> SourceName -> LP m ()
insertIncluded SourceName
".tex" SourceName
f
Blocks
bs <- LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
[Tok] -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput [Tok]
oldToks
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
bs
include :: (PandocMonad m, Monoid a) => Text -> LP m a
include :: Text -> LP m a
include Text
name = do
ParsecT [Tok] LaTeXState m Inlines -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt
[SourceName]
fs <- (Text -> SourceName) -> [Text] -> [SourceName]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> SourceName
T.unpack (Text -> SourceName) -> (Text -> Text) -> Text -> SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
removeDoubleQuotes (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) ([Text] -> [SourceName])
-> ([Tok] -> [Text]) -> [Tok] -> [SourceName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"," (Text -> [Text]) -> ([Tok] -> Text) -> [Tok] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Tok] -> Text
untokenize ([Tok] -> [SourceName])
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [SourceName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
let defaultExt :: SourceName
defaultExt | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"usepackage" = SourceName
".sty"
| Bool
otherwise = SourceName
".tex"
(SourceName -> ParsecT [Tok] LaTeXState m ())
-> [SourceName] -> ParsecT [Tok] LaTeXState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SourceName -> SourceName -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *).
PandocMonad m =>
SourceName -> SourceName -> LP m ()
insertIncluded SourceName
defaultExt) [SourceName]
fs
a -> LP m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
insertIncluded :: PandocMonad m
=> FilePath
-> FilePath
-> LP m ()
insertIncluded :: SourceName -> SourceName -> LP m ()
insertIncluded SourceName
defaultExtension SourceName
f' = do
let f :: SourceName
f = case SourceName -> SourceName
takeExtension SourceName
f' of
SourceName
".tex" -> SourceName
f'
SourceName
".sty" -> SourceName
f'
SourceName
_ -> SourceName -> SourceName -> SourceName
addExtension SourceName
f' SourceName
defaultExtension
[SourceName]
dirs <- (Text -> SourceName) -> [Text] -> [SourceName]
forall a b. (a -> b) -> [a] -> [b]
map Text -> SourceName
T.unpack ([Text] -> [SourceName])
-> (Maybe Text -> [Text]) -> Maybe Text -> [SourceName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') (Text -> [Text]) -> (Maybe Text -> Text) -> Maybe Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"." (Maybe Text -> [SourceName])
-> ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m [SourceName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT [Tok] LaTeXState m (Maybe Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
lookupEnv Text
"TEXINPUTS"
SourcePos
pos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
[Text]
containers <- LaTeXState -> [Text]
forall st. HasIncludeFiles st => st -> [Text]
getIncludeFiles (LaTeXState -> [Text])
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Bool -> LP m () -> LP m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SourceName -> Text
T.pack SourceName
f Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
containers) (LP m () -> LP m ()) -> LP m () -> LP m ()
forall a b. (a -> b) -> a -> b
$
PandocError -> LP m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> LP m ()) -> PandocError -> LP m ()
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
T.pack (SourceName -> Text) -> SourceName -> Text
forall a b. (a -> b) -> a -> b
$ SourceName
"Include file loop at " SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourcePos -> SourceName
forall a. Show a => a -> SourceName
show SourcePos
pos
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ Text -> LaTeXState -> LaTeXState
forall st. HasIncludeFiles st => Text -> st -> st
addIncludeFile (Text -> LaTeXState -> LaTeXState)
-> Text -> LaTeXState -> LaTeXState
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
T.pack SourceName
f
Maybe Text
mbcontents <- [SourceName]
-> SourceName -> ParsecT [Tok] LaTeXState m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
[SourceName] -> SourceName -> m (Maybe Text)
readFileFromDirs [SourceName]
dirs SourceName
f
Text
contents <- case Maybe Text
mbcontents of
Just Text
s -> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
Maybe Text
Nothing -> do
LogMessage -> LP m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> LP m ()) -> LogMessage -> LP m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
CouldNotLoadIncludeFile (SourceName -> Text
T.pack SourceName
f) SourcePos
pos
Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput ParsecT [Tok] LaTeXState m [Tok] -> ([Tok] -> LP m ()) -> LP m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Tok] -> LP m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput ([Tok] -> LP m ()) -> ([Tok] -> [Tok]) -> [Tok] -> LP m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceName -> Text -> [Tok]
tokenize SourceName
f Text
contents [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++)
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState LaTeXState -> LaTeXState
forall st. HasIncludeFiles st => st -> st
dropLatestIncludeFile
addMeta :: PandocMonad m => ToMetaValue a => Text -> a -> LP m ()
addMeta :: Text -> a -> LP m ()
addMeta Text
field a
val = (LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st ->
LaTeXState
st{ sMeta :: Meta
sMeta = Text -> a -> Meta -> Meta
forall a. ToMetaValue a => Text -> a -> Meta -> Meta
addMetaField Text
field a
val (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$ LaTeXState -> Meta
sMeta LaTeXState
st }
authors :: PandocMonad m => LP m ()
authors :: LP m ()
authors = LP m () -> LP m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m () -> LP m ()) -> LP m () -> LP m ()
forall a b. (a -> b) -> a -> b
$ do
LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
bgroup
let oneAuthor :: ParsecT [Tok] LaTeXState m Inlines
oneAuthor = [Block] -> Inlines
blocksToInlines' ([Block] -> Inlines)
-> ([Blocks] -> [Block]) -> [Blocks] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> [Block]
forall a. Many a -> [a]
B.toList (Blocks -> [Block]) -> ([Blocks] -> Blocks) -> [Blocks] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Inlines)
-> ParsecT [Tok] LaTeXState m [Blocks]
-> ParsecT [Tok] LaTeXState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Blocks
-> ParsecT [Tok] LaTeXState m [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Tok] LaTeXState m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block
[Inlines]
auths <- ParsecT [Tok] LaTeXState m Inlines
-> LP m Tok -> ParsecT [Tok] LaTeXState m [Inlines]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepBy ParsecT [Tok] LaTeXState m Inlines
oneAuthor (Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"and")
LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
egroup
Text -> [Inlines] -> LP m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"author" ((Inlines -> Inlines) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Inlines -> Inlines
trimInlines [Inlines]
auths)
macroDef :: (PandocMonad m, Monoid a) => (Text -> a) -> LP m a
macroDef :: (Text -> a) -> LP m a
macroDef Text -> a
constructor = do
(()
_, [Tok]
s) <- LP m () -> LP m ((), [Tok])
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m (a, [Tok])
withRaw (LP m ()
commandDef LP m () -> LP m () -> LP m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m ()
environmentDef)
(Text -> a
constructor ([Tok] -> Text
untokenize [Tok]
s) a -> LP m () -> LP m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
Extension -> LP m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardDisabled Extension
Ext_latex_macros)
LP m a -> LP m a -> LP m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> LP m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
where commandDef :: LP m ()
commandDef = do
(Text
name, Macro
macro') <- LP m (Text, Macro)
forall (m :: * -> *). PandocMonad m => LP m (Text, Macro)
newcommand LP m (Text, Macro) -> LP m (Text, Macro) -> LP m (Text, Macro)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m (Text, Macro)
forall (m :: * -> *). PandocMonad m => LP m (Text, Macro)
letmacro LP m (Text, Macro) -> LP m (Text, Macro) -> LP m (Text, Macro)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m (Text, Macro)
forall (m :: * -> *). PandocMonad m => LP m (Text, Macro)
defmacro
Extension -> LP m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardDisabled Extension
Ext_latex_macros LP m () -> LP m () -> LP m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\LaTeXState
s -> LaTeXState
s{ sMacros :: Map Text Macro
sMacros = Text -> Macro -> Map Text Macro -> Map Text Macro
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
name Macro
macro' (LaTeXState -> Map Text Macro
sMacros LaTeXState
s) })
environmentDef :: LP m ()
environmentDef = do
Maybe (Text, Macro, Macro)
mbenv <- LP m (Maybe (Text, Macro, Macro))
forall (m :: * -> *).
PandocMonad m =>
LP m (Maybe (Text, Macro, Macro))
newenvironment
case Maybe (Text, Macro, Macro)
mbenv of
Maybe (Text, Macro, Macro)
Nothing -> () -> LP m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Text
name, Macro
macro1, Macro
macro2) ->
Extension -> LP m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardDisabled Extension
Ext_latex_macros LP m () -> LP m () -> LP m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
do (LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
s -> LaTeXState
s{ sMacros :: Map Text Macro
sMacros =
Text -> Macro -> Map Text Macro -> Map Text Macro
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
name Macro
macro1 (LaTeXState -> Map Text Macro
sMacros LaTeXState
s) }
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
s -> LaTeXState
s{ sMacros :: Map Text Macro
sMacros =
Text -> Macro -> Map Text Macro -> Map Text Macro
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text
"end" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) Macro
macro2 (LaTeXState -> Map Text Macro
sMacros LaTeXState
s) }
letmacro :: PandocMonad m => LP m (Text, Macro)
letmacro :: LP m (Text, Macro)
letmacro = do
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"let"
(Text
name, [Tok]
contents) <- LP m (Text, [Tok]) -> LP m (Text, [Tok])
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m a
withVerbatimMode (LP m (Text, [Tok]) -> LP m (Text, [Tok]))
-> LP m (Text, [Tok]) -> LP m (Text, [Tok])
forall a b. (a -> b) -> a -> b
$ do
Tok SourcePos
_ (CtrlSeq Text
name) Text
_ <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyControlSeq
LP m Tok -> ParsecT [Tok] LaTeXState m (Maybe Tok)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (LP m Tok -> ParsecT [Tok] LaTeXState m (Maybe Tok))
-> LP m Tok -> ParsecT [Tok] LaTeXState m (Maybe Tok)
forall a b. (a -> b) -> a -> b
$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'='
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
[Tok]
contents <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracedOrToken
(Text, [Tok]) -> LP m (Text, [Tok])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, [Tok]
contents)
[Tok]
contents' <- Int -> [Tok] -> LP m [Tok]
forall (m :: * -> *). PandocMonad m => Int -> [Tok] -> LP m [Tok]
doMacros' Int
0 [Tok]
contents
(Text, Macro) -> LP m (Text, Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, ExpansionPoint -> [ArgSpec] -> Maybe [Tok] -> [Tok] -> Macro
Macro ExpansionPoint
ExpandWhenDefined [] Maybe [Tok]
forall a. Maybe a
Nothing [Tok]
contents')
defmacro :: PandocMonad m => LP m (Text, Macro)
defmacro :: LP m (Text, Macro)
defmacro = LP m (Text, Macro) -> LP m (Text, Macro)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m (Text, Macro) -> LP m (Text, Macro))
-> LP m (Text, Macro) -> LP m (Text, Macro)
forall a b. (a -> b) -> a -> b
$
LP m (Text, Macro) -> LP m (Text, Macro)
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m a
withVerbatimMode (LP m (Text, Macro) -> LP m (Text, Macro))
-> LP m (Text, Macro) -> LP m (Text, Macro)
forall a b. (a -> b) -> a -> b
$ do
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"def"
Tok SourcePos
_ (CtrlSeq Text
name) Text
_ <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyControlSeq
[ArgSpec]
argspecs <- ParsecT [Tok] LaTeXState m ArgSpec
-> ParsecT [Tok] LaTeXState m [ArgSpec]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT [Tok] LaTeXState m ArgSpec
forall (m :: * -> *). PandocMonad m => LP m ArgSpec
argspecArg ParsecT [Tok] LaTeXState m ArgSpec
-> ParsecT [Tok] LaTeXState m ArgSpec
-> ParsecT [Tok] LaTeXState m ArgSpec
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tok] LaTeXState m ArgSpec
forall (m :: * -> *). PandocMonad m => LP m ArgSpec
argspecPattern)
[Tok]
contents <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracedOrToken
(Text, Macro) -> LP m (Text, Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, ExpansionPoint -> [ArgSpec] -> Maybe [Tok] -> [Tok] -> Macro
Macro ExpansionPoint
ExpandWhenUsed [ArgSpec]
argspecs Maybe [Tok]
forall a. Maybe a
Nothing [Tok]
contents)
argspecArg :: PandocMonad m => LP m ArgSpec
argspecArg :: LP m ArgSpec
argspecArg = do
Tok SourcePos
_ (Arg Int
i) Text
_ <- (Tok -> Bool) -> LP m Tok
forall (m :: * -> *). PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok Tok -> Bool
isArgTok
ArgSpec -> LP m ArgSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (ArgSpec -> LP m ArgSpec) -> ArgSpec -> LP m ArgSpec
forall a b. (a -> b) -> a -> b
$ Int -> ArgSpec
ArgNum Int
i
argspecPattern :: PandocMonad m => LP m ArgSpec
argspecPattern :: LP m ArgSpec
argspecPattern =
[Tok] -> ArgSpec
Pattern ([Tok] -> ArgSpec)
-> ParsecT [Tok] LaTeXState m [Tok] -> LP m ArgSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Tok -> Bool) -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok (\(Tok SourcePos
_ TokType
toktype' Text
txt) ->
(TokType
toktype' TokType -> TokType -> Bool
forall a. Eq a => a -> a -> Bool
== TokType
Symbol Bool -> Bool -> Bool
|| TokType
toktype' TokType -> TokType -> Bool
forall a. Eq a => a -> a -> Bool
== TokType
Word) Bool -> Bool -> Bool
&&
(Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"{" Bool -> Bool -> Bool
&& Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"\\" Bool -> Bool -> Bool
&& Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"}")))
newcommand :: PandocMonad m => LP m (Text, Macro)
newcommand :: LP m (Text, Macro)
newcommand = do
SourcePos
pos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Tok SourcePos
_ (CtrlSeq Text
mtype) Text
_ <- Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"newcommand" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"renewcommand" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"providecommand" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"DeclareMathOperator" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"DeclareRobustCommand"
LP m (Text, Macro) -> LP m (Text, Macro)
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m a
withVerbatimMode (LP m (Text, Macro) -> LP m (Text, Macro))
-> LP m (Text, Macro) -> LP m (Text, Macro)
forall a b. (a -> b) -> a -> b
$ do
Tok SourcePos
_ (CtrlSeq Text
name) Text
txt <- do
LP m Tok -> ParsecT [Tok] LaTeXState m (Maybe Tok)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'*')
LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyControlSeq LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'{' LP m Tok
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces ParsecT [Tok] LaTeXState m () -> LP m Tok -> LP m Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyControlSeq LP m Tok -> ParsecT [Tok] LaTeXState m () -> LP m Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'}')
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Int
numargs <- Int
-> ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int)
-> ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT [Tok] LaTeXState m Int
forall (m :: * -> *). PandocMonad m => LP m Int
bracketedNum
let argspecs :: [ArgSpec]
argspecs = (Int -> ArgSpec) -> [Int] -> [ArgSpec]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ArgSpec
ArgNum [Int
1..Int
numargs]
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Maybe [Tok]
optarg <- Maybe [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe [Tok]
forall a. Maybe a
Nothing (ParsecT [Tok] LaTeXState m (Maybe [Tok])
-> ParsecT [Tok] LaTeXState m (Maybe [Tok]))
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall a b. (a -> b) -> a -> b
$ [Tok] -> Maybe [Tok]
forall a. a -> Maybe a
Just ([Tok] -> Maybe [Tok])
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracketedToks
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
[Tok]
contents' <- ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracedOrToken
let contents :: [Tok]
contents =
case Text
mtype of
Text
"DeclareMathOperator" ->
SourcePos -> TokType -> Text -> Tok
Tok SourcePos
pos (Text -> TokType
CtrlSeq Text
"mathop") Text
"\\mathop"
Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: SourcePos -> TokType -> Text -> Tok
Tok SourcePos
pos TokType
Symbol Text
"{"
Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: SourcePos -> TokType -> Text -> Tok
Tok SourcePos
pos (Text -> TokType
CtrlSeq Text
"mathrm") Text
"\\mathrm"
Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: SourcePos -> TokType -> Text -> Tok
Tok SourcePos
pos TokType
Symbol Text
"{"
Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: ([Tok]
contents' [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++
[ SourcePos -> TokType -> Text -> Tok
Tok SourcePos
pos TokType
Symbol Text
"}", SourcePos -> TokType -> Text -> Tok
Tok SourcePos
pos TokType
Symbol Text
"}" ])
Text
_ -> [Tok]
contents'
Map Text Macro
macros <- LaTeXState -> Map Text Macro
sMacros (LaTeXState -> Map Text Macro)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m (Map Text Macro)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case Text -> Map Text Macro -> Maybe Macro
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name Map Text Macro
macros of
Just Macro
macro
| Text
mtype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"newcommand" -> do
LogMessage -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [Tok] LaTeXState m ())
-> LogMessage -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
MacroAlreadyDefined Text
txt SourcePos
pos
(Text, Macro) -> LP m (Text, Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, Macro
macro)
| Text
mtype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"providecommand" -> (Text, Macro) -> LP m (Text, Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, Macro
macro)
Maybe Macro
_ -> (Text, Macro) -> LP m (Text, Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, ExpansionPoint -> [ArgSpec] -> Maybe [Tok] -> [Tok] -> Macro
Macro ExpansionPoint
ExpandWhenUsed [ArgSpec]
argspecs Maybe [Tok]
optarg [Tok]
contents)
newenvironment :: PandocMonad m => LP m (Maybe (Text, Macro, Macro))
newenvironment :: LP m (Maybe (Text, Macro, Macro))
newenvironment = do
SourcePos
pos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Tok SourcePos
_ (CtrlSeq Text
mtype) Text
_ <- Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"newenvironment" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"renewenvironment" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"provideenvironment"
LP m (Maybe (Text, Macro, Macro))
-> LP m (Maybe (Text, Macro, Macro))
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m a
withVerbatimMode (LP m (Maybe (Text, Macro, Macro))
-> LP m (Maybe (Text, Macro, Macro)))
-> LP m (Maybe (Text, Macro, Macro))
-> LP m (Maybe (Text, Macro, Macro))
forall a b. (a -> b) -> a -> b
$ do
LP m Tok -> ParsecT [Tok] LaTeXState m (Maybe Tok)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (LP m Tok -> ParsecT [Tok] LaTeXState m (Maybe Tok))
-> LP m Tok -> ParsecT [Tok] LaTeXState m (Maybe Tok)
forall a b. (a -> b) -> a -> b
$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'*'
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Text
name <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Int
numargs <- Int
-> ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int)
-> ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT [Tok] LaTeXState m Int
forall (m :: * -> *). PandocMonad m => LP m Int
bracketedNum
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Maybe [Tok]
optarg <- Maybe [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe [Tok]
forall a. Maybe a
Nothing (ParsecT [Tok] LaTeXState m (Maybe [Tok])
-> ParsecT [Tok] LaTeXState m (Maybe [Tok]))
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall a b. (a -> b) -> a -> b
$ [Tok] -> Maybe [Tok]
forall a. a -> Maybe a
Just ([Tok] -> Maybe [Tok])
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracketedToks
let argspecs :: [ArgSpec]
argspecs = (Int -> ArgSpec) -> [Int] -> [ArgSpec]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Int -> ArgSpec
ArgNum Int
i) [Int
1..Int
numargs]
[Tok]
startcontents <- LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces LP m ()
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracedOrToken
[Tok]
endcontents <- LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces LP m ()
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracedOrToken
Map Text Macro
macros <- LaTeXState -> Map Text Macro
sMacros (LaTeXState -> Map Text Macro)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m (Map Text Macro)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case Text -> Map Text Macro -> Maybe Macro
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name Map Text Macro
macros of
Just Macro
_
| Text
mtype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"newenvironment" -> do
LogMessage -> LP m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> LP m ()) -> LogMessage -> LP m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
MacroAlreadyDefined Text
name SourcePos
pos
Maybe (Text, Macro, Macro) -> LP m (Maybe (Text, Macro, Macro))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, Macro, Macro)
forall a. Maybe a
Nothing
| Text
mtype Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"provideenvironment" ->
Maybe (Text, Macro, Macro) -> LP m (Maybe (Text, Macro, Macro))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, Macro, Macro)
forall a. Maybe a
Nothing
Maybe Macro
_ -> Maybe (Text, Macro, Macro) -> LP m (Maybe (Text, Macro, Macro))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, Macro, Macro) -> LP m (Maybe (Text, Macro, Macro)))
-> Maybe (Text, Macro, Macro) -> LP m (Maybe (Text, Macro, Macro))
forall a b. (a -> b) -> a -> b
$ (Text, Macro, Macro) -> Maybe (Text, Macro, Macro)
forall a. a -> Maybe a
Just (Text
name,
ExpansionPoint -> [ArgSpec] -> Maybe [Tok] -> [Tok] -> Macro
Macro ExpansionPoint
ExpandWhenUsed [ArgSpec]
argspecs Maybe [Tok]
optarg [Tok]
startcontents,
ExpansionPoint -> [ArgSpec] -> Maybe [Tok] -> [Tok] -> Macro
Macro ExpansionPoint
ExpandWhenUsed [] Maybe [Tok]
forall a. Maybe a
Nothing [Tok]
endcontents)
bracketedNum :: PandocMonad m => LP m Int
bracketedNum :: LP m Int
bracketedNum = do
Text
ds <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracketedToks
case Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
ds of
Just Int
i -> Int -> LP m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
Maybe Int
_ -> Int -> LP m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
setCaption :: PandocMonad m => LP m ()
setCaption :: LP m ()
setCaption = LP m () -> LP m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m () -> LP m ()) -> LP m () -> LP m ()
forall a b. (a -> b) -> a -> b
$ do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
Inlines
ils <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
LP m () -> ParsecT [Tok] LaTeXState m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (LP m () -> ParsecT [Tok] LaTeXState m (Maybe ()))
-> LP m () -> ParsecT [Tok] LaTeXState m (Maybe ())
forall a b. (a -> b) -> a -> b
$ LP m () -> LP m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m () -> LP m ()) -> LP m () -> LP m ()
forall a b. (a -> b) -> a -> b
$ LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces LP m () -> LP m () -> LP m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
label
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st -> LaTeXState
st{ sCaption :: Maybe Inlines
sCaption = Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just Inlines
ils }
looseItem :: PandocMonad m => LP m Blocks
looseItem :: LP m Blocks
looseItem = do
Bool
inListItem <- LaTeXState -> Bool
sInListItem (LaTeXState -> Bool)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Bool -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] LaTeXState m ())
-> Bool -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
inListItem
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
epigraph :: PandocMonad m => LP m Blocks
epigraph :: LP m Blocks
epigraph = do
Blocks
p1 <- LP m Blocks -> LP m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block
Blocks
p2 <- LP m Blocks -> LP m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
divWith (Text
"", [Text
"epigraph"], []) (Blocks
p1 Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
p2)
resetCaption :: PandocMonad m => LP m ()
resetCaption :: LP m ()
resetCaption = (LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st -> LaTeXState
st{ sCaption :: Maybe Inlines
sCaption = Maybe Inlines
forall a. Maybe a
Nothing
, sLastLabel :: Maybe Text
sLastLabel = Maybe Text
forall a. Maybe a
Nothing }
section :: PandocMonad m => Attr -> Int -> LP m Blocks
section :: Attr -> Int -> LP m Blocks
section (Text
ident, [Text]
classes, [(Text, Text)]
kvs) Int
lvl = do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
Inlines
contents <- LP m Inlines -> LP m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline
Text
lab <- Text
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
ident (ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text)
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall a b. (a -> b) -> a -> b
$
ParsecT [Tok] LaTeXState m Text -> ParsecT [Tok] LaTeXState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces LP m ()
-> ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"label"
ParsecT [Tok] LaTeXState m Tok -> LP m () -> LP m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces LP m ()
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced)
Bool -> LP m () -> LP m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
lvl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (LP m () -> LP m ()) -> LP m () -> LP m ()
forall a b. (a -> b) -> a -> b
$
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st -> LaTeXState
st{ sHasChapters :: Bool
sHasChapters = Bool
True }
Bool -> LP m () -> LP m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
"unnumbered" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes) (LP m () -> LP m ()) -> LP m () -> LP m ()
forall a b. (a -> b) -> a -> b
$ do
DottedNum
hn <- LaTeXState -> DottedNum
sLastHeaderNum (LaTeXState -> DottedNum)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m DottedNum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Bool
hasChapters <- LaTeXState -> Bool
sHasChapters (LaTeXState -> Bool)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let lvl' :: Int
lvl' = Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Bool
hasChapters then Int
1 else Int
0
let num :: DottedNum
num = Int -> DottedNum -> DottedNum
incrementDottedNum Int
lvl' DottedNum
hn
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st -> LaTeXState
st{ sLastHeaderNum :: DottedNum
sLastHeaderNum = DottedNum
num
, sLabels :: Map Text [Inline]
sLabels = Text -> [Inline] -> Map Text [Inline] -> Map Text [Inline]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
lab
[Text -> Inline
Str (DottedNum -> Text
renderDottedNum DottedNum
num)]
(LaTeXState -> Map Text [Inline]
sLabels LaTeXState
st) }
Attr
attr' <- Attr -> Inlines -> ParserT [Tok] LaTeXState m Attr
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st, HasLogMessages st,
HasIdentifierList st) =>
Attr -> Inlines -> ParserT s st m Attr
registerHeader (Text
lab, [Text]
classes, [(Text, Text)]
kvs) Inlines
contents
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Inlines -> Blocks
headerWith Attr
attr' Int
lvl Inlines
contents
blockCommand :: PandocMonad m => LP m Blocks
blockCommand :: LP m Blocks
blockCommand = LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ do
Tok SourcePos
_ (CtrlSeq Text
name) Text
txt <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyControlSeq
Bool -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] LaTeXState m ())
-> Bool -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"begin" Bool -> Bool -> Bool
&& Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"end" Bool -> Bool -> Bool
&& Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"and"
Text
star <- Text
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (Text
"*" Text -> LP m Tok -> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'*' ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp)
let name' :: Text
name' = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
star
let names :: [Text]
names = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub [Text
name', Text
name]
let rawDefiniteBlock :: LP m Blocks
rawDefiniteBlock = do
Bool -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] LaTeXState m ())
-> Bool -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool
isBlockCommand Text
name
Text
rawcontents <- Text -> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> Text -> LP m Text
getRawCommand Text
name (Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
star)
(Extension -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_raw_tex ParsecT [Tok] LaTeXState m () -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> Blocks
rawBlock Text
"latex" Text
rawcontents))
LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> LP m Blocks
forall a (m :: * -> *) s u.
(Monoid a, PandocMonad m) =>
Text -> ParserT s u m a
ignore Text
rawcontents
let startCommand :: ParsecT [Tok] LaTeXState m ()
startCommand = ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ do
Tok SourcePos
_ (CtrlSeq Text
n) Text
_ <- LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyControlSeq
Bool -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] LaTeXState m ())
-> Bool -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text
"start" Text -> Text -> Bool
`T.isPrefixOf` Text
n
let rawMaybeBlock :: LP m Blocks
rawMaybeBlock = LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ do
Bool -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] LaTeXState m ())
-> Bool -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
isInlineCommand Text
name
Text
rawcontents <- Text -> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> Text -> LP m Text
getRawCommand Text
name (Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
star)
Blocks
curr <- (Extension -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_raw_tex ParsecT [Tok] LaTeXState m () -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> Blocks
rawBlock Text
"latex" Text
rawcontents))
LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> LP m Blocks
forall a (m :: * -> *) s u.
(Monoid a, PandocMonad m) =>
Text -> ParserT s u m a
ignore Text
rawcontents
[Blocks]
rest <- LP m Blocks -> ParsecT [Tok] LaTeXState m [Blocks]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (LP m Blocks -> ParsecT [Tok] LaTeXState m [Blocks])
-> LP m Blocks -> ParsecT [Tok] LaTeXState m [Blocks]
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Tok] LaTeXState m ()
startCommand ParsecT [Tok] LaTeXState m () -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blockCommand
ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
blankline ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tok] LaTeXState m ()
startCommand
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
curr Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat [Blocks]
rest
let raw :: LP m Blocks
raw = LP m Blocks
rawDefiniteBlock LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Blocks
rawMaybeBlock
LP m Blocks -> [Text] -> Map Text (LP m Blocks) -> LP m Blocks
forall k v. Ord k => v -> [k] -> Map k v -> v
lookupListDefault LP m Blocks
raw [Text]
names Map Text (LP m Blocks)
forall (m :: * -> *). PandocMonad m => Map Text (LP m Blocks)
blockCommands
closing :: PandocMonad m => LP m Blocks
closing :: LP m Blocks
closing = do
Inlines
contents <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
LaTeXState
st <- ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let extractInlines :: MetaValue -> [Inline]
extractInlines (MetaBlocks [Plain [Inline]
ys]) = [Inline]
ys
extractInlines (MetaBlocks [Para [Inline]
ys ]) = [Inline]
ys
extractInlines MetaValue
_ = []
let sigs :: Blocks
sigs = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"author" (LaTeXState -> Meta
sMeta LaTeXState
st) of
Just (MetaList [MetaValue]
xs) ->
Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
fromList ([Inline] -> Inlines) -> [Inline] -> Inlines
forall a b. (a -> b) -> a -> b
$
[Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] ([[Inline]] -> [Inline]) -> [[Inline]] -> [Inline]
forall a b. (a -> b) -> a -> b
$ (MetaValue -> [Inline]) -> [MetaValue] -> [[Inline]]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> [Inline]
extractInlines [MetaValue]
xs
Maybe MetaValue
_ -> Blocks
forall a. Monoid a => a
mempty
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para (Inlines -> Inlines
trimInlines Inlines
contents) Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
sigs
parbox :: PandocMonad m => LP m Blocks
parbox :: LP m Blocks
parbox = LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Bool
oldInTableCell <- LaTeXState -> Bool
sInTableCell (LaTeXState -> Bool)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st -> LaTeXState
st{ sInTableCell :: Bool
sInTableCell = Bool
False }
Blocks
res <- LP m Blocks -> LP m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st -> LaTeXState
st{ sInTableCell :: Bool
sInTableCell = Bool
oldInTableCell }
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
res
blockCommands :: PandocMonad m => M.Map Text (LP m Blocks)
blockCommands :: Map Text (LP m Blocks)
blockCommands = [(Text, LP m Blocks)] -> Map Text (LP m Blocks)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Text
"par", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts)
, (Text
"parbox", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
parbox)
, (Text
"title", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
(LP m Inlines -> LP m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"title")
ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (LP m Blocks -> LP m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block LP m Blocks
-> (Blocks -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Blocks -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"title")))
, (Text
"subtitle", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"subtitle"))
, (Text
"author", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
authors))
, (Text
"address", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"address"))
, (Text
"signature", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
authors))
, (Text
"date", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"date"))
, (Text
"newtheorem", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
newtheorem)
, (Text
"theoremstyle", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
theoremstyle)
, (Text
"extratitle", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"extratitle"))
, (Text
"frontispiece", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"frontispiece"))
, (Text
"titlehead", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"titlehead"))
, (Text
"subject", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"subject"))
, (Text
"publishers", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"publishers"))
, (Text
"uppertitleback", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"uppertitleback"))
, (Text
"lowertitleback", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"lowertitleback"))
, (Text
"dedication", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok LP m Inlines
-> (Inlines -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"dedication"))
, (Text
"part", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section Attr
nullAttr (-Int
1))
, (Text
"part*", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section Attr
nullAttr (-Int
1))
, (Text
"chapter", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section Attr
nullAttr Int
0)
, (Text
"chapter*", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section (Text
"",[Text
"unnumbered"],[]) Int
0)
, (Text
"section", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section Attr
nullAttr Int
1)
, (Text
"section*", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section (Text
"",[Text
"unnumbered"],[]) Int
1)
, (Text
"subsection", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section Attr
nullAttr Int
2)
, (Text
"subsection*", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section (Text
"",[Text
"unnumbered"],[]) Int
2)
, (Text
"subsubsection", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section Attr
nullAttr Int
3)
, (Text
"subsubsection*", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section (Text
"",[Text
"unnumbered"],[]) Int
3)
, (Text
"paragraph", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section Attr
nullAttr Int
4)
, (Text
"paragraph*", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section (Text
"",[Text
"unnumbered"],[]) Int
4)
, (Text
"subparagraph", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section Attr
nullAttr Int
5)
, (Text
"subparagraph*", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section (Text
"",[Text
"unnumbered"],[]) Int
5)
, (Text
"frametitle", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section Attr
nullAttr Int
3)
, (Text
"framesubtitle", Attr -> Int -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Attr -> Int -> LP m Blocks
section Attr
nullAttr Int
4)
, (Text
"opening", Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines (Inlines -> Blocks) -> LP m Inlines -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok))
, (Text
"closing", ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
closing)
, (Text
"plainbreak", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blocks -> LP m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule)
, (Text
"plainbreak*", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blocks -> LP m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule)
, (Text
"fancybreak", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blocks -> LP m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule)
, (Text
"fancybreak*", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blocks -> LP m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule)
, (Text
"plainfancybreak", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m [Tok] -> LP m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m [Tok] -> LP m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blocks -> LP m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule)
, (Text
"plainfancybreak*", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m [Tok] -> LP m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m [Tok] -> LP m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Blocks -> LP m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule)
, (Text
"pfbreak", Blocks -> LP m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule)
, (Text
"pfbreak*", Blocks -> LP m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule)
, (Text
"hrule", Blocks -> LP m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
horizontalRule)
, (Text
"strut", Blocks -> LP m Blocks
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty)
, (Text
"rule", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
rule)
, (Text
"item", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
looseItem)
, (Text
"documentclass", ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m [Tok] -> LP m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
preamble)
, (Text
"centerline", Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines (Inlines -> Blocks) -> LP m Inlines -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok))
, (Text
"caption", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
setCaption)
, (Text
"bibliography", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m [Tok] -> LP m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok]
-> ([Tok] -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Text -> [Inlines] -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"bibliography" ([Inlines] -> ParsecT [Tok] LaTeXState m ())
-> ([Tok] -> [Inlines]) -> [Tok] -> ParsecT [Tok] LaTeXState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Inlines]
splitBibs (Text -> [Inlines]) -> ([Tok] -> Text) -> [Tok] -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize))
, (Text
"addbibresource", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m [Tok] -> LP m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok]
-> ([Tok] -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Text -> [Inlines] -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"bibliography" ([Inlines] -> ParsecT [Tok] LaTeXState m ())
-> ([Tok] -> [Inlines]) -> [Tok] -> ParsecT [Tok] LaTeXState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Inlines]
splitBibs (Text -> [Inlines]) -> ([Tok] -> Text) -> [Tok] -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize))
, (Text
"endinput", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok)
, (Text
"lstinputlisting", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
inputListing)
, (Text
"inputminted", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
inputMinted)
, (Text
"graphicspath", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
graphicsPath)
, (Text
"setdefaultlanguage", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
setDefaultLanguage)
, (Text
"setmainlanguage", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
setDefaultLanguage)
, (Text
"hypertarget", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
hypertargetBlock)
, (Text
"textcolor", Text -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> LP m Blocks
coloredBlock Text
"color")
, (Text
"colorbox", Text -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> LP m Blocks
coloredBlock Text
"background-color")
, (Text
"blockquote", Bool -> Maybe Text -> LP m Blocks
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Blocks
blockquote Bool
False Maybe Text
forall a. Maybe a
Nothing)
, (Text
"blockcquote", Bool -> Maybe Text -> LP m Blocks
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Blocks
blockquote Bool
True Maybe Text
forall a. Maybe a
Nothing)
, (Text
"foreignblockquote", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> ([Tok] -> LP m Blocks) -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe Text -> LP m Blocks
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Blocks
blockquote Bool
False (Maybe Text -> LP m Blocks)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
, (Text
"foreignblockcquote", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> ([Tok] -> LP m Blocks) -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe Text -> LP m Blocks
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Blocks
blockquote Bool
True (Maybe Text -> LP m Blocks)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
, (Text
"hyphenblockquote", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> ([Tok] -> LP m Blocks) -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe Text -> LP m Blocks
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Blocks
blockquote Bool
False (Maybe Text -> LP m Blocks)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
, (Text
"hyphenblockcquote", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> ([Tok] -> LP m Blocks) -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe Text -> LP m Blocks
forall (m :: * -> *).
PandocMonad m =>
Bool -> Maybe Text -> LP m Blocks
blockquote Bool
True (Maybe Text -> LP m Blocks)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
, (Text
"include", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Blocks -> LP m Blocks
rawBlockOr Text
"include" (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> LP m Blocks
forall (m :: * -> *) a. (PandocMonad m, Monoid a) => Text -> LP m a
include Text
"include")
, (Text
"input", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Blocks -> LP m Blocks
rawBlockOr Text
"input" (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> LP m Blocks
forall (m :: * -> *) a. (PandocMonad m, Monoid a) => Text -> LP m a
include Text
"input")
, (Text
"subfile", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Blocks -> LP m Blocks
rawBlockOr Text
"subfile" LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
doSubfile)
, (Text
"usepackage", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Blocks -> LP m Blocks
rawBlockOr Text
"usepackage" (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> LP m Blocks
forall (m :: * -> *) a. (PandocMonad m, Monoid a) => Text -> LP m a
include Text
"usepackage")
, (Text
"PackageError", Blocks
forall a. Monoid a => a
mempty Blocks -> LP m [Tok] -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m [Tok] -> LP m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> LP m [Tok] -> LP m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced))
, (Text
"epigraph", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
epigraph)
]
environments :: PandocMonad m => M.Map Text (LP m Blocks)
environments :: Map Text (LP m Blocks)
environments = [(Text, LP m Blocks)] -> Map Text (LP m Blocks)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Text
"document", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"document" LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks LP m Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok)
, (Text
"abstract", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"abstract" LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks LP m Blocks
-> (Blocks -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Blocks -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> LP m ()
addMeta Text
"abstract"))
, (Text
"sloppypar", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"sloppypar" LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks)
, (Text
"letter", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"letter" LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
letterContents)
, (Text
"minipage", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"minipage" (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m (Maybe [Tok])
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces ParsecT [Tok] LaTeXState m () -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks)
, (Text
"figure", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"figure" (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
figure)
, (Text
"subfigure", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"subfigure" (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok ParsecT [Tok] LaTeXState m Inlines -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
figure)
, (Text
"center", Attr -> Blocks -> Blocks
divWith (Text
"", [Text
"center"], []) (Blocks -> Blocks) -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"center" LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks)
, (Text
"longtable", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"longtable" (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
resetCaption ParsecT [Tok] LaTeXState m () -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Bool -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> Bool -> LP m Blocks
simpTable Text
"longtable" Bool
False LP m Blocks -> (Blocks -> LP m Blocks) -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Blocks -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> LP m Blocks
addTableCaption)
, (Text
"table", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"table" (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
resetCaption ParsecT [Tok] LaTeXState m () -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks LP m Blocks -> (Blocks -> LP m Blocks) -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Blocks -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> LP m Blocks
addTableCaption)
, (Text
"tabular*", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"tabular*" (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> Bool -> LP m Blocks
simpTable Text
"tabular*" Bool
True)
, (Text
"tabularx", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"tabularx" (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> Bool -> LP m Blocks
simpTable Text
"tabularx" Bool
True)
, (Text
"tabular", Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"tabular" (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> Bool -> LP m Blocks
simpTable Text
"tabular" Bool
False)
, (Text
"quote", Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"quote" LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks)
, (Text
"quotation", Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"quotation" LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks)
, (Text
"verse", Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"verse" LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks)
, (Text
"itemize", [Blocks] -> Blocks
bulletList ([Blocks] -> Blocks)
-> ParsecT [Tok] LaTeXState m [Blocks] -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT [Tok] LaTeXState m [Blocks]
-> ParsecT [Tok] LaTeXState m [Blocks]
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
listenv Text
"itemize" (LP m Blocks -> ParsecT [Tok] LaTeXState m [Blocks]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
item))
, (Text
"description", [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> ParsecT [Tok] LaTeXState m [(Inlines, [Blocks])] -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT [Tok] LaTeXState m [(Inlines, [Blocks])]
-> ParsecT [Tok] LaTeXState m [(Inlines, [Blocks])]
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
listenv Text
"description" (ParsecT [Tok] LaTeXState m (Inlines, [Blocks])
-> ParsecT [Tok] LaTeXState m [(Inlines, [Blocks])]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT [Tok] LaTeXState m (Inlines, [Blocks])
forall (m :: * -> *). PandocMonad m => LP m (Inlines, [Blocks])
descItem))
, (Text
"enumerate", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
orderedList')
, (Text
"alltt", Blocks -> Blocks
alltt (Blocks -> Blocks) -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"alltt" LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks)
, (Text
"code", Extension -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParserT s st m ()
guardEnabled Extension
Ext_literate_haskell ParsecT [Tok] LaTeXState m () -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
(Attr -> Text -> Blocks
codeBlockWith (Text
"",[Text
"haskell",Text
"literate"],[]) (Text -> Blocks) -> ParsecT [Tok] LaTeXState m Text -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> LP m Text
verbEnv Text
"code"))
, (Text
"comment", Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m Text -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> LP m Text
verbEnv Text
"comment")
, (Text
"verbatim", Text -> Blocks
codeBlock (Text -> Blocks) -> ParsecT [Tok] LaTeXState m Text -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> LP m Text
verbEnv Text
"verbatim")
, (Text
"Verbatim", Text -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> LP m Blocks
fancyverbEnv Text
"Verbatim")
, (Text
"BVerbatim", Text -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> LP m Blocks
fancyverbEnv Text
"BVerbatim")
, (Text
"lstlisting", do Attr
attr <- [(Text, Text)] -> Attr
parseListingsOptions ([(Text, Text)] -> Attr)
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
-> ParsecT [Tok] LaTeXState m Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] LaTeXState m [(Text, Text)]
forall (m :: * -> *). PandocMonad m => LP m [(Text, Text)]
keyvals
Attr -> Text -> Blocks
codeBlockWith Attr
attr (Text -> Blocks) -> ParsecT [Tok] LaTeXState m Text -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> LP m Text
verbEnv Text
"lstlisting")
, (Text
"minted", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
minted)
, (Text
"obeylines", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
obeylines)
, (Text
"tikzpicture", Text -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> LP m Blocks
rawVerbEnv Text
"tikzpicture")
, (Text
"tikzcd", Text -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> LP m Blocks
rawVerbEnv Text
"tikzcd")
, (Text
"lilypond", Text -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> LP m Blocks
rawVerbEnv Text
"lilypond")
, (Text
"ly", Text -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> LP m Blocks
rawVerbEnv Text
"ly")
, (Text
"proof", LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
proof)
, (Text
"ifstrequal", LP m Blocks
forall (m :: * -> *) a. (PandocMonad m, Monoid a) => LP m a
ifstrequal)
, (Text
"newtoggle", ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m [Tok]
-> ([Tok] -> LP m Blocks) -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Tok] -> LP m Blocks
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
[Tok] -> LP m a
newToggle)
, (Text
"toggletrue", ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m [Tok]
-> ([Tok] -> LP m Blocks) -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> [Tok] -> LP m Blocks
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Bool -> [Tok] -> LP m a
setToggle Bool
True)
, (Text
"togglefalse", ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m [Tok]
-> ([Tok] -> LP m Blocks) -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> [Tok] -> LP m Blocks
forall a (m :: * -> *).
(Monoid a, PandocMonad m) =>
Bool -> [Tok] -> LP m a
setToggle Bool
False)
, (Text
"iftoggle", LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
ifToggle ParsecT [Tok] LaTeXState m () -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block)
]
theoremstyle :: PandocMonad m => LP m Blocks
theoremstyle :: LP m Blocks
theoremstyle = do
Text
stylename <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
let mbstyle :: Maybe TheoremStyle
mbstyle = case Text
stylename of
Text
"plain" -> TheoremStyle -> Maybe TheoremStyle
forall a. a -> Maybe a
Just TheoremStyle
PlainStyle
Text
"definition" -> TheoremStyle -> Maybe TheoremStyle
forall a. a -> Maybe a
Just TheoremStyle
DefinitionStyle
Text
"remark" -> TheoremStyle -> Maybe TheoremStyle
forall a. a -> Maybe a
Just TheoremStyle
RemarkStyle
Text
_ -> Maybe TheoremStyle
forall a. Maybe a
Nothing
case Maybe TheoremStyle
mbstyle of
Maybe TheoremStyle
Nothing -> () -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TheoremStyle
sty -> (LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ())
-> (LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
s -> LaTeXState
s{ sLastTheoremStyle :: TheoremStyle
sLastTheoremStyle = TheoremStyle
sty }
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
newtheorem :: PandocMonad m => LP m Blocks
newtheorem :: LP m Blocks
newtheorem = do
Bool
number <- Bool
-> ParsecT [Tok] LaTeXState m Bool
-> ParsecT [Tok] LaTeXState m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
True (Bool
False Bool
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'*' ParsecT [Tok] LaTeXState m Bool
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp)
Text
name <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp
Maybe Text
series <- Maybe Text
-> ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m (Maybe Text)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe Text
forall a. Maybe a
Nothing (ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m (Maybe Text))
-> ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Maybe Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracketedToks
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp
Inlines
showName <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp
Maybe Text
syncTo <- Maybe Text
-> ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m (Maybe Text)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe Text
forall a. Maybe a
Nothing (ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m (Maybe Text))
-> ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Maybe Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
bracketedToks
TheoremStyle
sty <- LaTeXState -> TheoremStyle
sLastTheoremStyle (LaTeXState -> TheoremStyle)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m TheoremStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let spec :: TheoremSpec
spec = TheoremSpec :: Inlines
-> TheoremStyle
-> Maybe Text
-> Maybe Text
-> Bool
-> DottedNum
-> TheoremSpec
TheoremSpec { theoremName :: Inlines
theoremName = Inlines
showName
, theoremStyle :: TheoremStyle
theoremStyle = TheoremStyle
sty
, theoremSeries :: Maybe Text
theoremSeries = Maybe Text
series
, theoremSyncTo :: Maybe Text
theoremSyncTo = Maybe Text
syncTo
, theoremNumber :: Bool
theoremNumber = Bool
number
, theoremLastNum :: DottedNum
theoremLastNum = [Int] -> DottedNum
DottedNum [Int
0] }
Map Text TheoremSpec
tmap <- LaTeXState -> Map Text TheoremSpec
sTheoremMap (LaTeXState -> Map Text TheoremSpec)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m (Map Text TheoremSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ())
-> (LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
s -> LaTeXState
s{ sTheoremMap :: Map Text TheoremSpec
sTheoremMap =
Text -> TheoremSpec -> Map Text TheoremSpec -> Map Text TheoremSpec
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
name TheoremSpec
spec Map Text TheoremSpec
tmap }
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
proof :: PandocMonad m => LP m Blocks
proof :: LP m Blocks
proof = do
Inlines
title <- Inlines
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Text -> Inlines
B.text Text
"Proof") ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt
Blocks
bs <- Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"proof" LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$
Attr -> Blocks -> Blocks
B.divWith (Text
"", [Text
"proof"], []) (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$
Blocks -> Blocks
addQed (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks -> Blocks
addTitle (Inlines -> Inlines
B.emph (Inlines
title Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
".")) Blocks
bs
addTitle :: Inlines -> Blocks -> Blocks
addTitle :: Inlines -> Blocks -> Blocks
addTitle Inlines
ils Blocks
bs =
case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bs of
(Para [Inline]
xs : [Block]
rest)
-> [Block] -> Blocks
forall a. [a] -> Many a
B.fromList ([Inline] -> Block
Para (Inlines -> [Inline]
forall a. Many a -> [a]
B.toList Inlines
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ (Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs)) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest)
[Block]
_ -> Inlines -> Blocks
B.para Inlines
ils Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
bs
addQed :: Blocks -> Blocks
addQed :: Blocks -> Blocks
addQed Blocks
bs =
case Seq Block -> ViewR Block
forall a. Seq a -> ViewR a
Seq.viewr (Blocks -> Seq Block
forall a. Many a -> Seq a
B.unMany Blocks
bs) of
Seq Block
s Seq.:> Para [Inline]
ils
-> Seq Block -> Blocks
forall a. Seq a -> Many a
B.Many (Seq Block
s Seq Block -> Block -> Seq Block
forall a. Seq a -> a -> Seq a
Seq.|> [Inline] -> Block
Para ([Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ Inlines -> [Inline]
forall a. Many a -> [a]
B.toList Inlines
qedSign))
ViewR Block
_ -> Blocks
bs Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Inlines -> Blocks
B.para Inlines
qedSign
where
qedSign :: Inlines
qedSign = Text -> Inlines
B.str Text
"\xa0\x25FB"
environment :: PandocMonad m => LP m Blocks
environment :: LP m Blocks
environment = LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ do
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"begin"
Text
name <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
LP m Blocks -> Text -> Map Text (LP m Blocks) -> LP m Blocks
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault LP m Blocks
forall (m :: * -> *) a. MonadPlus m => m a
mzero Text
name Map Text (LP m Blocks)
forall (m :: * -> *). PandocMonad m => Map Text (LP m Blocks)
environments LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> LP m Blocks
theoremEnvironment Text
name LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
if Text -> Map Text (LP PandocPure Inlines) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Text
name (Map Text (LP PandocPure Inlines)
forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
inlineEnvironments
:: M.Map Text (LP PandocPure Inlines))
then LP m Blocks
forall (m :: * -> *) a. MonadPlus m => m a
mzero
else LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> LP m Blocks
rawEnv Text
name) LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Text -> LP m Blocks
rawVerbEnv Text
name
theoremEnvironment :: PandocMonad m => Text -> LP m Blocks
theoremEnvironment :: Text -> LP m Blocks
theoremEnvironment Text
name = do
Map Text TheoremSpec
tmap <- LaTeXState -> Map Text TheoremSpec
sTheoremMap (LaTeXState -> Map Text TheoremSpec)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m (Map Text TheoremSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case Text -> Map Text TheoremSpec -> Maybe TheoremSpec
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name Map Text TheoremSpec
tmap of
Maybe TheoremSpec
Nothing -> LP m Blocks
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just TheoremSpec
tspec -> do
Inlines
optTitle <- Inlines
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
forall a. Monoid a => a
mempty (ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines)
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall a b. (a -> b) -> a -> b
$ (\Inlines
x -> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"(" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
")") (Inlines -> Inlines)
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt
Maybe Text
mblabel <- Maybe Text
-> ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m (Maybe Text)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe Text
forall a. Maybe a
Nothing (ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m (Maybe Text))
-> ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Maybe Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces LP m ()
-> ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"label" ParsecT [Tok] LaTeXState m Tok -> LP m () -> LP m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces LP m ()
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced)
Blocks
bs <- Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
name LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
Inlines
number <-
if TheoremSpec -> Bool
theoremNumber TheoremSpec
tspec
then do
let name' :: Text
name' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
name (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ TheoremSpec -> Maybe Text
theoremSeries TheoremSpec
tspec
DottedNum
num <- (LaTeXState -> DottedNum) -> LP m DottedNum
forall (m :: * -> *).
Monad m =>
(LaTeXState -> DottedNum) -> LP m DottedNum
getNextNumber
(DottedNum
-> (TheoremSpec -> DottedNum) -> Maybe TheoremSpec -> DottedNum
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Int] -> DottedNum
DottedNum [Int
0]) TheoremSpec -> DottedNum
theoremLastNum (Maybe TheoremSpec -> DottedNum)
-> (LaTeXState -> Maybe TheoremSpec) -> LaTeXState -> DottedNum
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Map Text TheoremSpec -> Maybe TheoremSpec
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name' (Map Text TheoremSpec -> Maybe TheoremSpec)
-> (LaTeXState -> Map Text TheoremSpec)
-> LaTeXState
-> Maybe TheoremSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LaTeXState -> Map Text TheoremSpec
sTheoremMap)
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
s ->
LaTeXState
s{ sTheoremMap :: Map Text TheoremSpec
sTheoremMap =
(TheoremSpec -> TheoremSpec)
-> Text -> Map Text TheoremSpec -> Map Text TheoremSpec
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
(\TheoremSpec
spec -> TheoremSpec
spec{ theoremLastNum :: DottedNum
theoremLastNum = DottedNum
num })
Text
name'
(LaTeXState -> Map Text TheoremSpec
sTheoremMap LaTeXState
s)
}
case Maybe Text
mblabel of
Just Text
ident ->
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
s ->
LaTeXState
s{ sLabels :: Map Text [Inline]
sLabels = Text -> [Inline] -> Map Text [Inline] -> Map Text [Inline]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ident
(Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline]) -> Inlines -> [Inline]
forall a b. (a -> b) -> a -> b
$
TheoremSpec -> Inlines
theoremName TheoremSpec
tspec Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"\160" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
Text -> Inlines
str (DottedNum -> Text
renderDottedNum DottedNum
num)) (LaTeXState -> Map Text [Inline]
sLabels LaTeXState
s) }
Maybe Text
Nothing -> () -> LP m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Inlines -> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT [Tok] LaTeXState m Inlines)
-> Inlines -> ParsecT [Tok] LaTeXState m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.text (DottedNum -> Text
renderDottedNum DottedNum
num)
else Inlines -> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
let titleEmph :: Inlines -> Inlines
titleEmph = case TheoremSpec -> TheoremStyle
theoremStyle TheoremSpec
tspec of
TheoremStyle
PlainStyle -> Inlines -> Inlines
B.strong
TheoremStyle
DefinitionStyle -> Inlines -> Inlines
B.strong
TheoremStyle
RemarkStyle -> Inlines -> Inlines
B.emph
let title :: Inlines
title = Inlines -> Inlines
titleEmph (TheoremSpec -> Inlines
theoremName TheoremSpec
tspec Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
number)
Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
optTitle Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"." Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
divWith (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mblabel, [Text
name], []) (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks -> Blocks
addTitle Inlines
title
(Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ case TheoremSpec -> TheoremStyle
theoremStyle TheoremSpec
tspec of
TheoremStyle
PlainStyle -> (Block -> Block) -> Blocks -> Blocks
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
italicize Blocks
bs
TheoremStyle
_ -> Blocks
bs
italicize :: Block -> Block
italicize :: Block -> Block
italicize x :: Block
x@(Para [Image{}]) = Block
x
italicize (Para [Inline]
ils) = [Inline] -> Block
Para [[Inline] -> Inline
Emph [Inline]
ils]
italicize (Plain [Inline]
ils) = [Inline] -> Block
Plain [[Inline] -> Inline
Emph [Inline]
ils]
italicize Block
x = Block
x
env :: PandocMonad m => Text -> LP m a -> LP m a
env :: Text -> LP m a -> LP m a
env Text
name LP m a
p = LP m a
p LP m a -> ParsecT [Tok] LaTeXState m () -> LP m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => Text -> LP m ()
end_ Text
name
rawEnv :: PandocMonad m => Text -> LP m Blocks
rawEnv :: Text -> LP m Blocks
rawEnv Text
name = do
Extensions
exts <- (ReaderOptions -> Extensions)
-> ParserT [Tok] LaTeXState m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
let parseRaw :: Bool
parseRaw = Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_tex Extensions
exts
Text
rawOptions <- [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text)
-> ParsecT [Tok] LaTeXState m [Text]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => LP m Text
rawopt
let beginCommand :: Text
beginCommand = Text
"\\begin{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rawOptions
SourcePos
pos1 <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(Blocks
bs, [Tok]
raw) <- LP m Blocks -> LP m (Blocks, [Tok])
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m (a, [Tok])
withRaw (LP m Blocks -> LP m (Blocks, [Tok]))
-> LP m Blocks -> LP m (Blocks, [Tok])
forall a b. (a -> b) -> a -> b
$ Text -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
name LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
if Bool
parseRaw
then Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
rawBlock Text
"latex"
(Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ Text
beginCommand Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
raw
else do
LogMessage -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [Tok] LaTeXState m ())
-> LogMessage -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
beginCommand SourcePos
pos1
SourcePos
pos2 <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
LogMessage -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [Tok] LaTeXState m ())
-> LogMessage -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
"\\end{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}") SourcePos
pos2
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
bs
rawVerbEnv :: PandocMonad m => Text -> LP m Blocks
rawVerbEnv :: Text -> LP m Blocks
rawVerbEnv Text
name = do
SourcePos
pos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(Text
_, [Tok]
raw) <- LP m Text -> LP m (Text, [Tok])
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m (a, [Tok])
withRaw (LP m Text -> LP m (Text, [Tok]))
-> LP m Text -> LP m (Text, [Tok])
forall a b. (a -> b) -> a -> b
$ Text -> LP m Text
forall (m :: * -> *). PandocMonad m => Text -> LP m Text
verbEnv Text
name
let raw' :: Text
raw' = Text
"\\begin{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
raw
Extensions
exts <- (ReaderOptions -> Extensions)
-> ParserT [Tok] LaTeXState m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
let parseRaw :: Bool
parseRaw = Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_raw_tex Extensions
exts
if Bool
parseRaw
then Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
rawBlock Text
"latex" Text
raw'
else do
LogMessage -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [Tok] LaTeXState m ())
-> LogMessage -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
raw' SourcePos
pos
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
fancyverbEnv :: PandocMonad m => Text -> LP m Blocks
fancyverbEnv :: Text -> LP m Blocks
fancyverbEnv Text
name = do
[(Text, Text)]
options <- [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] LaTeXState m [(Text, Text)]
forall (m :: * -> *). PandocMonad m => LP m [(Text, Text)]
keyvals
let kvs :: [(Text, Text)]
kvs = [ (if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"firstnumber"
then Text
"startFrom"
else Text
k, Text
v) | (Text
k,Text
v) <- [(Text, Text)]
options ]
let classes :: [Text]
classes = [ Text
"numberLines" |
Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"numbers" [(Text, Text)]
options Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"left" ]
let attr :: Attr
attr = (Text
"",[Text]
classes,[(Text, Text)]
kvs)
Attr -> Text -> Blocks
codeBlockWith Attr
attr (Text -> Blocks) -> ParsecT [Tok] LaTeXState m Text -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> LP m Text
verbEnv Text
name
obeylines :: PandocMonad m => LP m Blocks
obeylines :: LP m Blocks
obeylines =
Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Inlines
forall a. [a] -> Many a
fromList ([Inline] -> Inlines)
-> (Inlines -> [Inline]) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
removeLeadingTrailingBreaks ([Inline] -> [Inline])
-> (Inlines -> [Inline]) -> Inlines -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
softBreakToHard ([Inline] -> [Inline])
-> (Inlines -> [Inline]) -> Inlines -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
forall a. Many a -> [a]
toList (Inlines -> Blocks)
-> ParsecT [Tok] LaTeXState m Inlines -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
"obeylines" ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlines
where softBreakToHard :: Inline -> Inline
softBreakToHard Inline
SoftBreak = Inline
LineBreak
softBreakToHard Inline
x = Inline
x
removeLeadingTrailingBreaks :: [Inline] -> [Inline]
removeLeadingTrailingBreaks = [Inline] -> [Inline]
forall a. [a] -> [a]
reverse ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Inline -> Bool
isLineBreak ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Inline] -> [Inline]
forall a. [a] -> [a]
reverse ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Inline -> Bool
isLineBreak
isLineBreak :: Inline -> Bool
isLineBreak Inline
LineBreak = Bool
True
isLineBreak Inline
_ = Bool
False
minted :: PandocMonad m => LP m Blocks
minted :: LP m Blocks
minted = do
Attr
attr <- LP m Attr
forall (m :: * -> *). PandocMonad m => LP m Attr
mintedAttr
Attr -> Text -> Blocks
codeBlockWith Attr
attr (Text -> Blocks) -> ParsecT [Tok] LaTeXState m Text -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => Text -> LP m Text
verbEnv Text
"minted"
mintedAttr :: PandocMonad m => LP m Attr
mintedAttr :: LP m Attr
mintedAttr = do
[(Text, Text)]
options <- [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] LaTeXState m [(Text, Text)]
forall (m :: * -> *). PandocMonad m => LP m [(Text, Text)]
keyvals
Text
lang <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
let kvs :: [(Text, Text)]
kvs = [ (if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"firstnumber"
then Text
"startFrom"
else Text
k, Text
v) | (Text
k,Text
v) <- [(Text, Text)]
options ]
let classes :: [Text]
classes = [ Text
lang | Bool -> Bool
not (Text -> Bool
T.null Text
lang) ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
[ Text
"numberLines" |
Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"linenos" [(Text, Text)]
options Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"true" ]
Attr -> LP m Attr
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"",[Text]
classes,[(Text, Text)]
kvs)
inputMinted :: PandocMonad m => LP m Blocks
inputMinted :: LP m Blocks
inputMinted = do
SourcePos
pos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Attr
attr <- LP m Attr
forall (m :: * -> *). PandocMonad m => LP m Attr
mintedAttr
Text
f <- (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'"') (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
[SourceName]
dirs <- (Text -> SourceName) -> [Text] -> [SourceName]
forall a b. (a -> b) -> [a] -> [b]
map Text -> SourceName
T.unpack ([Text] -> [SourceName])
-> (Maybe Text -> [Text]) -> Maybe Text -> [SourceName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') (Text -> [Text]) -> (Maybe Text -> Text) -> Maybe Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"." (Maybe Text -> [SourceName])
-> ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m [SourceName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT [Tok] LaTeXState m (Maybe Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
lookupEnv Text
"TEXINPUTS"
Maybe Text
mbCode <- [SourceName]
-> SourceName -> ParsecT [Tok] LaTeXState m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
[SourceName] -> SourceName -> m (Maybe Text)
readFileFromDirs [SourceName]
dirs (Text -> SourceName
T.unpack Text
f)
Text
rawcode <- case Maybe Text
mbCode of
Just Text
s -> Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
Maybe Text
Nothing -> do
LogMessage -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [Tok] LaTeXState m ())
-> LogMessage -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
CouldNotLoadIncludeFile Text
f SourcePos
pos
Text -> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith Attr
attr Text
rawcode
letterContents :: PandocMonad m => LP m Blocks
letterContents :: LP m Blocks
letterContents = do
Blocks
bs <- LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
LaTeXState
st <- ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let addr :: Blocks
addr = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"address" (LaTeXState -> Meta
sMeta LaTeXState
st) of
Just (MetaBlocks [Plain [Inline]
xs]) ->
Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
fromList [Inline]
xs
Maybe MetaValue
_ -> Blocks
forall a. Monoid a => a
mempty
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
addr Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
bs
figure :: PandocMonad m => LP m Blocks
figure :: LP m Blocks
figure = LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
resetCaption
LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks LP m Blocks -> (Blocks -> LP m Blocks) -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Blocks -> LP m Blocks
forall (m :: * -> *). PandocMonad m => Blocks -> LP m Blocks
addImageCaption
addImageCaption :: PandocMonad m => Blocks -> LP m Blocks
addImageCaption :: Blocks -> LP m Blocks
addImageCaption = (Inline -> ParsecT [Tok] LaTeXState m Inline)
-> Blocks -> LP m Blocks
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Inline -> ParsecT [Tok] LaTeXState m Inline
forall (m :: * -> *).
Monad m =>
Inline -> ParsecT [Tok] LaTeXState m Inline
go
where go :: Inline -> ParsecT [Tok] LaTeXState m Inline
go (Image attr :: Attr
attr@(Text
_, [Text]
cls, [(Text, Text)]
kvs) [Inline]
alt (Text
src,Text
tit))
| Bool -> Bool
not (Text
"fig:" Text -> Text -> Bool
`T.isPrefixOf` Text
tit) = do
LaTeXState
st <- ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let ([Inline]
alt', Text
tit') = case LaTeXState -> Maybe Inlines
sCaption LaTeXState
st of
Just Inlines
ils -> (Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
ils, Text
"fig:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tit)
Maybe Inlines
Nothing -> ([Inline]
alt, Text
tit)
attr' :: Attr
attr' = case LaTeXState -> Maybe Text
sLastLabel LaTeXState
st of
Just Text
lab -> (Text
lab, [Text]
cls, [(Text, Text)]
kvs)
Maybe Text
Nothing -> Attr
attr
case Attr
attr' of
(Text
"", [Text]
_, [(Text, Text)]
_) -> () -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Text
ident, [Text]
_, [(Text, Text)]
_) -> do
DottedNum
num <- (LaTeXState -> DottedNum) -> LP m DottedNum
forall (m :: * -> *).
Monad m =>
(LaTeXState -> DottedNum) -> LP m DottedNum
getNextNumber LaTeXState -> DottedNum
sLastFigureNum
LaTeXState -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState
LaTeXState
st{ sLastFigureNum :: DottedNum
sLastFigureNum = DottedNum
num
, sLabels :: Map Text [Inline]
sLabels = Text -> [Inline] -> Map Text [Inline] -> Map Text [Inline]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ident
[Text -> Inline
Str (DottedNum -> Text
renderDottedNum DottedNum
num)] (LaTeXState -> Map Text [Inline]
sLabels LaTeXState
st) }
Inline -> ParsecT [Tok] LaTeXState m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> ParsecT [Tok] LaTeXState m Inline)
-> Inline -> ParsecT [Tok] LaTeXState m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr' [Inline]
alt' (Text
src, Text
tit')
go Inline
x = Inline -> ParsecT [Tok] LaTeXState m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
coloredBlock :: PandocMonad m => Text -> LP m Blocks
coloredBlock :: Text -> LP m Blocks
coloredBlock Text
stylename = LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
[Tok]
color <- LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
ParsecT [Tok] LaTeXState m Inlines -> LP m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inline)
let constructor :: Blocks -> Blocks
constructor = Attr -> Blocks -> Blocks
divWith (Text
"",[],[(Text
"style",Text
stylename Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tok] -> Text
untokenize [Tok]
color)])
Blocks -> Blocks
constructor (Blocks -> Blocks) -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block
graphicsPath :: PandocMonad m => LP m Blocks
graphicsPath :: LP m Blocks
graphicsPath = do
[SourceName]
ps <- ([Tok] -> SourceName) -> [[Tok]] -> [SourceName]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> SourceName
T.unpack (Text -> SourceName) -> ([Tok] -> Text) -> [Tok] -> SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize) ([[Tok]] -> [SourceName])
-> ParsecT [Tok] LaTeXState m [[Tok]]
-> ParsecT [Tok] LaTeXState m [SourceName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
bgroup LP m Tok
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m [[Tok]]
-> ParsecT [Tok] LaTeXState m [[Tok]]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m [Tok]
-> LP m Tok -> ParsecT [Tok] LaTeXState m [[Tok]]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces) LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
egroup)
ParsecT [Tok] LaTeXState m [SourceName]
forall (m :: * -> *). PandocMonad m => m [SourceName]
getResourcePath ParsecT [Tok] LaTeXState m [SourceName]
-> ([SourceName] -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SourceName] -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => [SourceName] -> m ()
setResourcePath ([SourceName] -> ParsecT [Tok] LaTeXState m ())
-> ([SourceName] -> [SourceName])
-> [SourceName]
-> ParsecT [Tok] LaTeXState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SourceName] -> [SourceName] -> [SourceName]
forall a. Semigroup a => a -> a -> a
<> [SourceName]
ps)
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
splitBibs :: Text -> [Inlines]
splitBibs :: Text -> [Inlines]
splitBibs = (Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Inlines
str (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> Text
T.pack (SourceName -> Text) -> (Text -> SourceName) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceName -> SourceName -> SourceName)
-> SourceName -> SourceName -> SourceName
forall a b c. (a -> b -> c) -> b -> a -> c
flip SourceName -> SourceName -> SourceName
replaceExtension SourceName
"bib" (SourceName -> SourceName)
-> (Text -> SourceName) -> Text -> SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SourceName
T.unpack (Text -> SourceName) -> (Text -> Text) -> Text -> SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim) ([Text] -> [Inlines]) -> (Text -> [Text]) -> Text -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',')
alltt :: Blocks -> Blocks
alltt :: Blocks -> Blocks
alltt = (Inline -> Inline) -> Blocks -> Blocks
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
strToCode
where strToCode :: Inline -> Inline
strToCode (Str Text
s) = Attr -> Text -> Inline
Code Attr
nullAttr Text
s
strToCode Inline
Space = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex") Text
"\\ "
strToCode Inline
SoftBreak = Inline
LineBreak
strToCode Inline
x = Inline
x
parseListingsOptions :: [(Text, Text)] -> Attr
parseListingsOptions :: [(Text, Text)] -> Attr
parseListingsOptions [(Text, Text)]
options =
let kvs :: [(Text, Text)]
kvs = [ (if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"firstnumber"
then Text
"startFrom"
else Text
k, Text
v) | (Text
k,Text
v) <- [(Text, Text)]
options ]
classes :: [Text]
classes = [ Text
"numberLines" |
Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"numbers" [(Text, Text)]
options Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"left" ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList ([(Text, Text)] -> Maybe Text
listingsLanguage [(Text, Text)]
options)
in (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"label" [(Text, Text)]
options), [Text]
classes, [(Text, Text)]
kvs)
inputListing :: PandocMonad m => LP m Blocks
inputListing :: LP m Blocks
inputListing = do
SourcePos
pos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
[(Text, Text)]
options <- [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
-> ParsecT [Tok] LaTeXState m [(Text, Text)]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] LaTeXState m [(Text, Text)]
forall (m :: * -> *). PandocMonad m => LP m [(Text, Text)]
keyvals
Text
f <- (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'"') (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
[SourceName]
dirs <- (Text -> SourceName) -> [Text] -> [SourceName]
forall a b. (a -> b) -> [a] -> [b]
map Text -> SourceName
T.unpack ([Text] -> [SourceName])
-> (Maybe Text -> [Text]) -> Maybe Text -> [SourceName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') (Text -> [Text]) -> (Maybe Text -> Text) -> Maybe Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"." (Maybe Text -> [SourceName])
-> ParsecT [Tok] LaTeXState m (Maybe Text)
-> ParsecT [Tok] LaTeXState m [SourceName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT [Tok] LaTeXState m (Maybe Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
lookupEnv Text
"TEXINPUTS"
Maybe Text
mbCode <- [SourceName]
-> SourceName -> ParsecT [Tok] LaTeXState m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
[SourceName] -> SourceName -> m (Maybe Text)
readFileFromDirs [SourceName]
dirs (Text -> SourceName
T.unpack Text
f)
[Text]
codeLines <- case Maybe Text
mbCode of
Just Text
s -> [Text] -> ParsecT [Tok] LaTeXState m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> ParsecT [Tok] LaTeXState m [Text])
-> [Text] -> ParsecT [Tok] LaTeXState m [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s
Maybe Text
Nothing -> do
LogMessage -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [Tok] LaTeXState m ())
-> LogMessage -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
CouldNotLoadIncludeFile Text
f SourcePos
pos
[Text] -> ParsecT [Tok] LaTeXState m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
let (Text
ident,[Text]
classes,[(Text, Text)]
kvs) = [(Text, Text)] -> Attr
parseListingsOptions [(Text, Text)]
options
let classes' :: [Text]
classes' =
(case [(Text, Text)] -> Maybe Text
listingsLanguage [(Text, Text)]
options of
Maybe Text
Nothing -> (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
1 (Text -> [Text]
languagesByExtension (SourceName -> Text
T.pack (SourceName -> Text) -> SourceName -> Text
forall a b. (a -> b) -> a -> b
$ SourceName -> SourceName
takeExtension (SourceName -> SourceName) -> SourceName -> SourceName
forall a b. (a -> b) -> a -> b
$ Text -> SourceName
T.unpack Text
f)) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>)
Just Text
_ -> [Text] -> [Text]
forall a. a -> a
id) [Text]
classes
let firstline :: Int
firstline = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"firstline" [(Text, Text)]
options Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
let lastline :: Int
lastline = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
codeLines) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lastline" [(Text, Text)]
options Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
let codeContents :: Text
codeContents = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lastline Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
firstline) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
firstline Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Text]
codeLines
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
codeBlockWith (Text
ident,[Text]
classes',[(Text, Text)]
kvs) Text
codeContents
item :: PandocMonad m => LP m Blocks
item :: LP m Blocks
item = LP m Blocks -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"item" ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts ParsecT [Tok] LaTeXState m () -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
descItem :: PandocMonad m => LP m (Inlines, [Blocks])
descItem :: LP m (Inlines, [Blocks])
descItem = do
LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"item"
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp
Inlines
ils <- LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt
Blocks
bs <- LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
(Inlines, [Blocks]) -> LP m (Inlines, [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
ils, [Blocks
bs])
listenv :: PandocMonad m => Text -> LP m a -> LP m a
listenv :: Text -> LP m a -> LP m a
listenv Text
name LP m a
p = LP m a -> LP m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m a -> LP m a) -> LP m a -> LP m a
forall a b. (a -> b) -> a -> b
$ do
Bool
oldInListItem <- LaTeXState -> Bool
sInListItem (LaTeXState -> Bool)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ())
-> (LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st -> LaTeXState
st{ sInListItem :: Bool
sInListItem = Bool
True }
a
res <- Text -> LP m a -> LP m a
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
env Text
name LP m a
p
(LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ())
-> (LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st -> LaTeXState
st{ sInListItem :: Bool
sInListItem = Bool
oldInListItem }
a -> LP m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
orderedList' :: PandocMonad m => LP m Blocks
orderedList' :: LP m Blocks
orderedList' = LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
let markerSpec :: ParsecT [Tok] LaTeXState m ListAttributes
markerSpec = do
Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'['
Text
ts <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Tok -> LP m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
']')
case Parsec Text ParserState ListAttributes
-> ParserState
-> SourceName
-> Text
-> Either ParseError ListAttributes
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> SourceName -> s -> Either ParseError a
runParser Parsec Text ParserState ListAttributes
forall s (m :: * -> *).
Stream s m Char =>
ParserT s ParserState m ListAttributes
anyOrderedListMarker ParserState
forall a. Default a => a
def SourceName
"option" Text
ts of
Right ListAttributes
r -> ListAttributes -> ParsecT [Tok] LaTeXState m ListAttributes
forall (m :: * -> *) a. Monad m => a -> m a
return ListAttributes
r
Left ParseError
_ -> do
SourcePos
pos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
LogMessage -> LP m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> LP m ()) -> LogMessage -> LP m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") SourcePos
pos
ListAttributes -> ParsecT [Tok] LaTeXState m ListAttributes
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
1, ListNumberStyle
DefaultStyle, ListNumberDelim
DefaultDelim)
(Int
_, ListNumberStyle
style, ListNumberDelim
delim) <- ListAttributes
-> ParsecT [Tok] LaTeXState m ListAttributes
-> ParsecT [Tok] LaTeXState m ListAttributes
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Int
1, ListNumberStyle
DefaultStyle, ListNumberDelim
DefaultDelim) ParsecT [Tok] LaTeXState m ListAttributes
markerSpec
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok]))
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok])
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall a b. (a -> b) -> a -> b
$ Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"setlength"
LP m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped (Int -> LP m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 (LP m Tok -> ParsecT [Tok] LaTeXState m [Tok])
-> LP m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall a b. (a -> b) -> a -> b
$ Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"itemindent")
ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Int
start <- Int
-> ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
1 (ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int)
-> ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int)
-> ParsecT [Tok] LaTeXState m Int -> ParsecT [Tok] LaTeXState m Int
forall a b. (a -> b) -> a -> b
$ do SourcePos
pos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"setcounter"
Text
ctr <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Bool -> LP m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> LP m ()) -> Bool -> LP m ()
forall a b. (a -> b) -> a -> b
$ Text
"enum" Text -> Text -> Bool
`T.isPrefixOf` Text
ctr
Bool -> LP m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> LP m ()) -> Bool -> LP m ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Bool
T.all (Char -> SourceName -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'i',Char
'v']) (Int -> Text -> Text
T.drop Int
4 Text
ctr)
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp
Text
num <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
case Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
num of
Just Int
i -> Int -> ParsecT [Tok] LaTeXState m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 :: Int)
Maybe Int
Nothing -> do
LogMessage -> LP m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> LP m ()) -> LogMessage -> LP m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent
(Text
"\\setcounter{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ctr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"}{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}") SourcePos
pos
Int -> ParsecT [Tok] LaTeXState m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
[Blocks]
bs <- Text -> LP m [Blocks] -> LP m [Blocks]
forall (m :: * -> *) a. PandocMonad m => Text -> LP m a -> LP m a
listenv Text
"enumerate" (LP m Blocks -> LP m [Blocks]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
item)
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ ListAttributes -> [Blocks] -> Blocks
orderedListWith (Int
start, ListNumberStyle
style, ListNumberDelim
delim) [Blocks]
bs
hline :: PandocMonad m => LP m ()
hline :: LP m ()
hline = LP m () -> LP m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m () -> LP m ()) -> LP m () -> LP m ()
forall a b. (a -> b) -> a -> b
$ do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"hline" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"toprule" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"bottomrule" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"midrule" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"endhead" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"endfirsthead"
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m (Maybe Inlines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
opt
() -> LP m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lbreak :: PandocMonad m => LP m Tok
lbreak :: LP m Tok
lbreak = (Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"\\" LP m Tok -> LP m Tok -> LP m Tok
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"tabularnewline")
LP m Tok -> ParsecT [Tok] LaTeXState m () -> LP m Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts LP m Tok -> ParsecT [Tok] LaTeXState m () -> LP m Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
amp :: PandocMonad m => LP m Tok
amp :: LP m Tok
amp = Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'&'
splitWordTok :: PandocMonad m => LP m ()
splitWordTok :: LP m ()
splitWordTok = do
[Tok]
inp <- ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
case [Tok]
inp of
(Tok SourcePos
spos TokType
Word Text
t : [Tok]
rest) ->
[Tok] -> LP m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput ([Tok] -> LP m ()) -> [Tok] -> LP m ()
forall a b. (a -> b) -> a -> b
$ (Char -> Tok) -> SourceName -> [Tok]
forall a b. (a -> b) -> [a] -> [b]
map (SourcePos -> TokType -> Text -> Tok
Tok SourcePos
spos TokType
Symbol (Text -> Tok) -> (Char -> Text) -> Char -> Tok
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) (Text -> SourceName
T.unpack Text
t) [Tok] -> [Tok] -> [Tok]
forall a. Semigroup a => a -> a -> a
<> [Tok]
rest
[Tok]
_ -> () -> LP m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
parseAligns :: PandocMonad m => LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
parseAligns :: LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
parseAligns = LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
-> LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
-> LP m [(Alignment, ColWidth, ([Tok], [Tok]))])
-> LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
-> LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
forall a b. (a -> b) -> a -> b
$ do
let maybeBar :: ParsecT [Tok] LaTeXState m ()
maybeBar = ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany
(ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
sp ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (() ()
-> ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'|' ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () ()
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'@' ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced)))
let cAlign :: ParsecT [Tok] LaTeXState m Alignment
cAlign = Alignment
AlignCenter Alignment
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'c'
let lAlign :: ParsecT [Tok] LaTeXState m Alignment
lAlign = Alignment
AlignLeft Alignment
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'l'
let rAlign :: ParsecT [Tok] LaTeXState m Alignment
rAlign = Alignment
AlignRight Alignment
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'r'
let parAlign :: ParsecT [Tok] LaTeXState m Alignment
parAlign = Alignment
AlignLeft Alignment
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'p'
let xAlign :: ParsecT [Tok] LaTeXState m Alignment
xAlign = Alignment
AlignLeft Alignment
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'X'
let mAlign :: ParsecT [Tok] LaTeXState m Alignment
mAlign = Alignment
AlignLeft Alignment
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'm'
let bAlign :: ParsecT [Tok] LaTeXState m Alignment
bAlign = Alignment
AlignLeft Alignment
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'b'
let alignChar :: ParsecT [Tok] LaTeXState m Alignment
alignChar = ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
splitWordTok ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( ParsecT [Tok] LaTeXState m Alignment
cAlign ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tok] LaTeXState m Alignment
lAlign ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tok] LaTeXState m Alignment
rAlign ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tok] LaTeXState m Alignment
parAlign
ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tok] LaTeXState m Alignment
xAlign ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tok] LaTeXState m Alignment
mAlign ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT [Tok] LaTeXState m Alignment
bAlign )
let alignPrefix :: ParsecT [Tok] LaTeXState m [Tok]
alignPrefix = Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'>' ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
let alignSuffix :: ParsecT [Tok] LaTeXState m [Tok]
alignSuffix = Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'<' ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
let colWidth :: ParsecT [Tok] LaTeXState m (Maybe Double)
colWidth = ParsecT [Tok] LaTeXState m (Maybe Double)
-> ParsecT [Tok] LaTeXState m (Maybe Double)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] LaTeXState m (Maybe Double)
-> ParsecT [Tok] LaTeXState m (Maybe Double))
-> ParsecT [Tok] LaTeXState m (Maybe Double)
-> ParsecT [Tok] LaTeXState m (Maybe Double)
forall a b. (a -> b) -> a -> b
$ do
Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'{'
Text
ds <- Text -> Text
trim (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok (Text -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"linewidth")
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'}'
Maybe Double -> ParsecT [Tok] LaTeXState m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Double -> ParsecT [Tok] LaTeXState m (Maybe Double))
-> Maybe Double -> ParsecT [Tok] LaTeXState m (Maybe Double)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
ds
let alignSpec :: ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
alignSpec = do
[Tok]
pref <- [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] LaTeXState m [Tok]
alignPrefix
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Alignment
al <- ParsecT [Tok] LaTeXState m Alignment
alignChar
Maybe Double
width <- ParsecT [Tok] LaTeXState m (Maybe Double)
colWidth ParsecT [Tok] LaTeXState m (Maybe Double)
-> ParsecT [Tok] LaTeXState m (Maybe Double)
-> ParsecT [Tok] LaTeXState m (Maybe Double)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Double
-> ParsecT [Tok] LaTeXState m (Maybe Double)
-> ParsecT [Tok] LaTeXState m (Maybe Double)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe Double
forall a. Maybe a
Nothing (do Text
s <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
SourcePos
pos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
LogMessage -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [Tok] LaTeXState m ())
-> LogMessage -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
s SourcePos
pos
Maybe Double -> ParsecT [Tok] LaTeXState m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
forall a. Maybe a
Nothing)
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
[Tok]
suff <- [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] LaTeXState m [Tok]
alignSuffix
(Alignment, Maybe Double, ([Tok], [Tok]))
-> ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Alignment
al, Maybe Double
width, ([Tok]
pref, [Tok]
suff))
let starAlign :: ParsecT [Tok] LaTeXState m ()
starAlign = do
Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'*'
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Text
ds <- Text -> Text
trim (Text -> Text) -> ([Tok] -> Text) -> [Tok] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
[Tok]
spec <- ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
case Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
ds of
Just Int
n ->
ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput ParsecT [Tok] LaTeXState m [Tok]
-> ([Tok] -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Tok] -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput ([Tok] -> ParsecT [Tok] LaTeXState m ())
-> ([Tok] -> [Tok]) -> [Tok] -> ParsecT [Tok] LaTeXState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Tok]] -> [Tok]
forall a. Monoid a => [a] -> a
mconcat (Int -> [Tok] -> [[Tok]]
forall a. Int -> a -> [a]
replicate Int
n [Tok]
spec) [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++)
Maybe Int
Nothing -> SourceName -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) a. MonadFail m => SourceName -> m a
Prelude.fail (SourceName -> ParsecT [Tok] LaTeXState m ())
-> SourceName -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ SourceName
"Could not parse " SourceName -> SourceName -> SourceName
forall a. Semigroup a => a -> a -> a
<> Text -> SourceName
T.unpack Text
ds SourceName -> SourceName -> SourceName
forall a. Semigroup a => a -> a -> a
<> SourceName
" as number"
ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
bgroup
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
ParsecT [Tok] LaTeXState m ()
maybeBar
[(Alignment, Maybe Double, ([Tok], [Tok]))]
aligns' <- ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
-> ParsecT
[Tok] LaTeXState m [(Alignment, Maybe Double, ([Tok], [Tok]))]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
-> ParsecT
[Tok] LaTeXState m [(Alignment, Maybe Double, ([Tok], [Tok]))])
-> ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
-> ParsecT
[Tok] LaTeXState m [(Alignment, Maybe Double, ([Tok], [Tok]))]
forall a b. (a -> b) -> a -> b
$ ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
-> ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
-> ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok])))
-> ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
-> ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe ())
-> ParsecT [Tok] LaTeXState m (Maybe ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT [Tok] LaTeXState m ()
starAlign ParsecT [Tok] LaTeXState m (Maybe ())
-> ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
-> ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
alignSpec ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
-> ParsecT [Tok] LaTeXState m ()
-> ParsecT
[Tok] LaTeXState m (Alignment, Maybe Double, ([Tok], [Tok]))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m ()
maybeBar)
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
egroup
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
[(Alignment, ColWidth, ([Tok], [Tok]))]
-> LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Alignment, ColWidth, ([Tok], [Tok]))]
-> LP m [(Alignment, ColWidth, ([Tok], [Tok]))])
-> [(Alignment, ColWidth, ([Tok], [Tok]))]
-> LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
forall a b. (a -> b) -> a -> b
$ ((Alignment, Maybe Double, ([Tok], [Tok]))
-> (Alignment, ColWidth, ([Tok], [Tok])))
-> [(Alignment, Maybe Double, ([Tok], [Tok]))]
-> [(Alignment, ColWidth, ([Tok], [Tok]))]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment, Maybe Double, ([Tok], [Tok]))
-> (Alignment, ColWidth, ([Tok], [Tok]))
forall a c. (a, Maybe Double, c) -> (a, ColWidth, c)
toSpec [(Alignment, Maybe Double, ([Tok], [Tok]))]
aligns'
where
toColWidth :: Maybe Double -> ColWidth
toColWidth (Just Double
w) | Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Double -> ColWidth
ColWidth Double
w
toColWidth Maybe Double
_ = ColWidth
ColWidthDefault
toSpec :: (a, Maybe Double, c) -> (a, ColWidth, c)
toSpec (a
x, Maybe Double
y, c
z) = (a
x, Maybe Double -> ColWidth
toColWidth Maybe Double
y, c
z)
parseTableRow :: PandocMonad m
=> Text
-> [([Tok], [Tok])]
-> LP m Row
parseTableRow :: Text -> [([Tok], [Tok])] -> LP m Row
parseTableRow Text
envname [([Tok], [Tok])]
prefsufs = do
ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => Text -> LP m ()
end_ Text
envname)
let celltoks :: ([Tok], [Tok]) -> ParsecT [Tok] LaTeXState m [Tok]
celltoks ([Tok]
pref, [Tok]
suff) = do
SourcePos
prefpos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
[Tok]
contents <- [[Tok]] -> [Tok]
forall a. Monoid a => [a] -> a
mconcat ([[Tok]] -> [Tok])
-> ParsecT [Tok] LaTeXState m [[Tok]]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [[Tok]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ( (Blocks, [Tok]) -> [Tok]
forall a b. (a, b) -> b
snd ((Blocks, [Tok]) -> [Tok])
-> ParsecT [Tok] LaTeXState m (Blocks, [Tok])
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Blocks -> ParsecT [Tok] LaTeXState m (Blocks, [Tok])
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m (a, [Tok])
withRaw (Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"parbox" LP m Tok -> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
parbox)
ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Inlines, [Tok]) -> [Tok]
forall a b. (a, b) -> b
snd ((Inlines, [Tok]) -> [Tok])
-> ParsecT [Tok] LaTeXState m (Inlines, [Tok])
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines -> ParsecT [Tok] LaTeXState m (Inlines, [Tok])
forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m (a, [Tok])
withRaw (LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
inlineEnvironment LP m Inlines -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
dollarsMath)
ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(do ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy
(() () -> LP m Tok -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
amp ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () () -> LP m Tok -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
lbreak ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => Text -> LP m ()
end_ Text
envname)
Int -> LP m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok) )
SourcePos
suffpos <- ParsecT [Tok] LaTeXState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
[Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (Int -> LP m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
amp)
[Tok] -> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok] -> ParsecT [Tok] LaTeXState m [Tok])
-> [Tok] -> ParsecT [Tok] LaTeXState m [Tok]
forall a b. (a -> b) -> a -> b
$ (Tok -> Tok) -> [Tok] -> [Tok]
forall a b. (a -> b) -> [a] -> [b]
map (SourcePos -> Tok -> Tok
setpos SourcePos
prefpos) [Tok]
pref [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
contents [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ (Tok -> Tok) -> [Tok] -> [Tok]
forall a b. (a -> b) -> [a] -> [b]
map (SourcePos -> Tok -> Tok
setpos SourcePos
suffpos) [Tok]
suff
[[Tok]]
rawcells <- (([Tok], [Tok]) -> ParsecT [Tok] LaTeXState m [Tok])
-> [([Tok], [Tok])] -> ParsecT [Tok] LaTeXState m [[Tok]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Tok], [Tok]) -> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *).
PandocMonad m =>
([Tok], [Tok]) -> ParsecT [Tok] LaTeXState m [Tok]
celltoks [([Tok], [Tok])]
prefsufs
[Tok]
oldInput <- ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
[Cell]
cells <- ([Tok] -> ParsecT [Tok] LaTeXState m Cell)
-> [[Tok]] -> ParsecT [Tok] LaTeXState m [Cell]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[Tok]
ts -> [Tok] -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput [Tok]
ts ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m Cell
-> ParsecT [Tok] LaTeXState m Cell
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] LaTeXState m Cell
forall (m :: * -> *). PandocMonad m => LP m Cell
parseTableCell) [[Tok]]
rawcells
[Tok] -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput [Tok]
oldInput
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Row -> LP m Row
forall (m :: * -> *) a. Monad m => a -> m a
return (Row -> LP m Row) -> Row -> LP m Row
forall a b. (a -> b) -> a -> b
$ Attr -> [Cell] -> Row
Row Attr
nullAttr [Cell]
cells
parseTableCell :: PandocMonad m => LP m Cell
parseTableCell :: LP m Cell
parseTableCell = do
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st -> LaTeXState
st{ sInTableCell :: Bool
sInTableCell = Bool
True }
Cell
cell' <- LP m Cell
forall (m :: * -> *). PandocMonad m => LP m Cell
multicolumnCell
LP m Cell -> LP m Cell -> LP m Cell
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Cell
forall (m :: * -> *). PandocMonad m => LP m Cell
multirowCell
LP m Cell -> LP m Cell -> LP m Cell
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Cell
forall (m :: * -> *). PandocMonad m => LP m Cell
parseSimpleCell
LP m Cell -> LP m Cell -> LP m Cell
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Cell
parseEmptyCell
(LaTeXState -> LaTeXState) -> LP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> LP m ())
-> (LaTeXState -> LaTeXState) -> LP m ()
forall a b. (a -> b) -> a -> b
$ \LaTeXState
st -> LaTeXState
st{ sInTableCell :: Bool
sInTableCell = Bool
False }
LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
Cell -> LP m Cell
forall (m :: * -> *) a. Monad m => a -> m a
return Cell
cell'
where
parseEmptyCell :: LP m Cell
parseEmptyCell = LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces LP m () -> Cell -> LP m Cell
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Cell
emptyCell
cellAlignment :: PandocMonad m => LP m Alignment
cellAlignment :: LP m Alignment
cellAlignment = ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'|') ParsecT [Tok] LaTeXState m () -> LP m Alignment -> LP m Alignment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Alignment
alignment LP m Alignment -> ParsecT [Tok] LaTeXState m () -> LP m Alignment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m Tok -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (Char -> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'|')
where
alignment :: LP m Alignment
alignment = do
Text
c <- Tok -> Text
untoken (Tok -> Text)
-> ParsecT [Tok] LaTeXState m Tok
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
singleChar
Alignment -> LP m Alignment
forall (m :: * -> *) a. Monad m => a -> m a
return (Alignment -> LP m Alignment) -> Alignment -> LP m Alignment
forall a b. (a -> b) -> a -> b
$ case Text
c of
Text
"l" -> Alignment
AlignLeft
Text
"r" -> Alignment
AlignRight
Text
"c" -> Alignment
AlignCenter
Text
"*" -> Alignment
AlignDefault
Text
_ -> Alignment
AlignDefault
plainify :: Blocks -> Blocks
plainify :: Blocks -> Blocks
plainify Blocks
bs = case Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
bs of
[Para [Inline]
ils] -> Inlines -> Blocks
plain ([Inline] -> Inlines
forall a. [a] -> Many a
fromList [Inline]
ils)
[Block]
_ -> Blocks
bs
multirowCell :: PandocMonad m => LP m Cell
multirowCell :: LP m Cell
multirowCell = Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"multirow" LP m Tok -> LP m Cell -> LP m Cell
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
Maybe Alignment
_ <- ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m (Maybe Alignment)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m (Maybe Alignment))
-> ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m (Maybe Alignment)
forall a b. (a -> b) -> a -> b
$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'[' LP m Tok
-> ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m Alignment
forall (m :: * -> *). PandocMonad m => LP m Alignment
cellAlignment ParsecT [Tok] LaTeXState m Alignment
-> LP m Tok -> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
']'
Int
nrows <- ([Tok] -> Int)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> ([Tok] -> Maybe Int) -> [Tok] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Int) -> ([Tok] -> Text) -> [Tok] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize) ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Maybe [Tok]
_ <- ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok]))
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall a b. (a -> b) -> a -> b
$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'[' LP m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Tok -> LP m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
']')
[Tok]
_ <- Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'{' LP m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Tok -> LP m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'}')
Maybe [Tok]
_ <- ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok]))
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m (Maybe [Tok])
forall a b. (a -> b) -> a -> b
$ Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'[' LP m Tok
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LP m Tok -> LP m Tok -> ParsecT [Tok] LaTeXState m [Tok]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok (Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
']')
Blocks
content <- Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'{' LP m Tok
-> ParsecT [Tok] LaTeXState m Blocks
-> ParsecT [Tok] LaTeXState m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Blocks -> Blocks
plainify (Blocks -> Blocks)
-> ParsecT [Tok] LaTeXState m Blocks
-> ParsecT [Tok] LaTeXState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks) ParsecT [Tok] LaTeXState m Blocks
-> LP m Tok -> ParsecT [Tok] LaTeXState m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'}'
Cell -> LP m Cell
forall (m :: * -> *) a. Monad m => a -> m a
return (Cell -> LP m Cell) -> Cell -> LP m Cell
forall a b. (a -> b) -> a -> b
$ Alignment -> RowSpan -> ColSpan -> Blocks -> Cell
cell Alignment
AlignDefault (Int -> RowSpan
RowSpan Int
nrows) (Int -> ColSpan
ColSpan Int
1) Blocks
content
multicolumnCell :: PandocMonad m => LP m Cell
multicolumnCell :: LP m Cell
multicolumnCell = Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"multicolumn" LP m Tok -> LP m Cell -> LP m Cell
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
Int
span' <- ([Tok] -> Int)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> ([Tok] -> Maybe Int) -> [Tok] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Int) -> ([Tok] -> Text) -> [Tok] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize) ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
Alignment
alignment <- Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'{' LP m Tok
-> ParsecT [Tok] LaTeXState m Alignment
-> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m Alignment
forall (m :: * -> *). PandocMonad m => LP m Alignment
cellAlignment ParsecT [Tok] LaTeXState m Alignment
-> LP m Tok -> ParsecT [Tok] LaTeXState m Alignment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'}'
let singleCell :: LP m Cell
singleCell = do
Blocks
content <- Blocks -> Blocks
plainify (Blocks -> Blocks)
-> ParsecT [Tok] LaTeXState m Blocks
-> ParsecT [Tok] LaTeXState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks
Cell -> LP m Cell
forall (m :: * -> *) a. Monad m => a -> m a
return (Cell -> LP m Cell) -> Cell -> LP m Cell
forall a b. (a -> b) -> a -> b
$ Alignment -> RowSpan -> ColSpan -> Blocks -> Cell
cell Alignment
alignment (Int -> RowSpan
RowSpan Int
1) (Int -> ColSpan
ColSpan Int
span') Blocks
content
let nestedCell :: LP m Cell
nestedCell = do
(Cell Attr
_ Alignment
_ (RowSpan Int
rs) ColSpan
_ [Block]
bs) <- LP m Cell
forall (m :: * -> *). PandocMonad m => LP m Cell
multirowCell
Cell -> LP m Cell
forall (m :: * -> *) a. Monad m => a -> m a
return (Cell -> LP m Cell) -> Cell -> LP m Cell
forall a b. (a -> b) -> a -> b
$ Alignment -> RowSpan -> ColSpan -> Blocks -> Cell
cell
Alignment
alignment
(Int -> RowSpan
RowSpan Int
rs)
(Int -> ColSpan
ColSpan Int
span')
([Block] -> Blocks
forall a. [a] -> Many a
fromList [Block]
bs)
Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'{' LP m Tok -> LP m Cell -> LP m Cell
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (LP m Cell
nestedCell LP m Cell -> LP m Cell -> LP m Cell
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Cell
singleCell) LP m Cell -> LP m Tok -> LP m Cell
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> LP m Tok
forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'}'
parseSimpleCell :: PandocMonad m => LP m Cell
parseSimpleCell :: LP m Cell
parseSimpleCell = Blocks -> Cell
simpleCell (Blocks -> Cell) -> ParsecT [Tok] LaTeXState m Blocks -> LP m Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Blocks -> Blocks
plainify (Blocks -> Blocks)
-> ParsecT [Tok] LaTeXState m Blocks
-> ParsecT [Tok] LaTeXState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blocks)
fixTableHead :: TableHead -> TableHead
fixTableHead :: TableHead -> TableHead
fixTableHead (TableHead Attr
attr [Row]
rows) = Attr -> [Row] -> TableHead
TableHead Attr
attr [Row]
rows'
where
rows' :: [Row]
rows' = [Row] -> [Row]
fixTableRows [Row]
rows
fixTableBody :: TableBody -> TableBody
fixTableBody :: TableBody -> TableBody
fixTableBody (TableBody Attr
attr RowHeadColumns
rhc [Row]
th [Row]
tb)
= Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
attr RowHeadColumns
rhc [Row]
th' [Row]
tb'
where
th' :: [Row]
th' = [Row] -> [Row]
fixTableRows [Row]
th
tb' :: [Row]
tb' = [Row] -> [Row]
fixTableRows [Row]
tb
fixTableRows :: [Row] -> [Row]
fixTableRows :: [Row] -> [Row]
fixTableRows = [Maybe (ColSpan, RowSpan)] -> [Row] -> [Row]
fixTableRows' ([Maybe (ColSpan, RowSpan)] -> [Row] -> [Row])
-> [Maybe (ColSpan, RowSpan)] -> [Row] -> [Row]
forall a b. (a -> b) -> a -> b
$ Maybe (ColSpan, RowSpan) -> [Maybe (ColSpan, RowSpan)]
forall a. a -> [a]
repeat Maybe (ColSpan, RowSpan)
forall a. Maybe a
Nothing
where
fixTableRows' :: [Maybe (ColSpan, RowSpan)] -> [Row] -> [Row]
fixTableRows' [Maybe (ColSpan, RowSpan)]
oldHang (Row Attr
attr [Cell]
cells : [Row]
rs)
= let ([Maybe (ColSpan, RowSpan)]
newHang, [Cell]
cells') = [Maybe (ColSpan, RowSpan)]
-> [Cell] -> ([Maybe (ColSpan, RowSpan)], [Cell])
fixTableRow [Maybe (ColSpan, RowSpan)]
oldHang [Cell]
cells
rs' :: [Row]
rs' = [Maybe (ColSpan, RowSpan)] -> [Row] -> [Row]
fixTableRows' [Maybe (ColSpan, RowSpan)]
newHang [Row]
rs
in Attr -> [Cell] -> Row
Row Attr
attr [Cell]
cells' Row -> [Row] -> [Row]
forall a. a -> [a] -> [a]
: [Row]
rs'
fixTableRows' [Maybe (ColSpan, RowSpan)]
_ [] = []
fixTableRow :: [Maybe (ColSpan, RowSpan)] -> [Cell] -> ([Maybe (ColSpan, RowSpan)], [Cell])
fixTableRow :: [Maybe (ColSpan, RowSpan)]
-> [Cell] -> ([Maybe (ColSpan, RowSpan)], [Cell])
fixTableRow [Maybe (ColSpan, RowSpan)]
oldHang [Cell]
cells
| (ColSpan
n, [Maybe (ColSpan, RowSpan)] -> [Maybe (ColSpan, RowSpan)]
prefHang, [Maybe (ColSpan, RowSpan)]
restHang) <- [Maybe (ColSpan, RowSpan)]
-> (ColSpan,
[Maybe (ColSpan, RowSpan)] -> [Maybe (ColSpan, RowSpan)],
[Maybe (ColSpan, RowSpan)])
splitHang [Maybe (ColSpan, RowSpan)]
oldHang
, ColSpan
n ColSpan -> ColSpan -> Bool
forall a. Ord a => a -> a -> Bool
> ColSpan
0
= let cells' :: [Cell]
cells' = (Cell -> ColSpan) -> ColSpan -> [Cell] -> [Cell]
forall t t. (Ord t, Num t) => (t -> t) -> t -> [t] -> [t]
dropToWidth Cell -> ColSpan
getCellW ColSpan
n [Cell]
cells
([Maybe (ColSpan, RowSpan)]
restHang', [Cell]
cells'') = [Maybe (ColSpan, RowSpan)]
-> [Cell] -> ([Maybe (ColSpan, RowSpan)], [Cell])
fixTableRow [Maybe (ColSpan, RowSpan)]
restHang [Cell]
cells'
in ([Maybe (ColSpan, RowSpan)] -> [Maybe (ColSpan, RowSpan)]
prefHang [Maybe (ColSpan, RowSpan)]
restHang', [Cell]
cells'')
| c :: Cell
c@(Cell Attr
_ Alignment
_ RowSpan
h ColSpan
w [Block]
_):[Cell]
cells' <- [Cell]
cells
= let h' :: RowSpan
h' = RowSpan -> RowSpan -> RowSpan
forall a. Ord a => a -> a -> a
max RowSpan
1 RowSpan
h
w' :: ColSpan
w' = ColSpan -> ColSpan -> ColSpan
forall a. Ord a => a -> a -> a
max ColSpan
1 ColSpan
w
oldHang' :: [Maybe (ColSpan, RowSpan)]
oldHang' = (Maybe (ColSpan, RowSpan) -> ColSpan)
-> ColSpan
-> [Maybe (ColSpan, RowSpan)]
-> [Maybe (ColSpan, RowSpan)]
forall t t. (Ord t, Num t) => (t -> t) -> t -> [t] -> [t]
dropToWidth Maybe (ColSpan, RowSpan) -> ColSpan
forall b. Maybe (ColSpan, b) -> ColSpan
getHangW ColSpan
w' [Maybe (ColSpan, RowSpan)]
oldHang
([Maybe (ColSpan, RowSpan)]
newHang, [Cell]
cells'') = [Maybe (ColSpan, RowSpan)]
-> [Cell] -> ([Maybe (ColSpan, RowSpan)], [Cell])
fixTableRow [Maybe (ColSpan, RowSpan)]
oldHang' [Cell]
cells'
in (ColSpan -> RowSpan -> [Maybe (ColSpan, RowSpan)]
forall b. (Ord b, Num b) => ColSpan -> b -> [Maybe (ColSpan, b)]
toHang ColSpan
w' RowSpan
h' [Maybe (ColSpan, RowSpan)]
-> [Maybe (ColSpan, RowSpan)] -> [Maybe (ColSpan, RowSpan)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (ColSpan, RowSpan)]
newHang, Cell
c Cell -> [Cell] -> [Cell]
forall a. a -> [a] -> [a]
: [Cell]
cells'')
| Bool
otherwise
= ([Maybe (ColSpan, RowSpan)]
oldHang, [])
where
getCellW :: Cell -> ColSpan
getCellW (Cell Attr
_ Alignment
_ RowSpan
_ ColSpan
w [Block]
_) = ColSpan
w
getHangW :: Maybe (ColSpan, b) -> ColSpan
getHangW = ColSpan
-> ((ColSpan, b) -> ColSpan) -> Maybe (ColSpan, b) -> ColSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ColSpan
1 (ColSpan, b) -> ColSpan
forall a b. (a, b) -> a
fst
getCS :: ColSpan -> Int
getCS (ColSpan Int
n) = Int
n
toHang :: ColSpan -> b -> [Maybe (ColSpan, b)]
toHang ColSpan
c b
r
| b
r b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
1 = [(ColSpan, b) -> Maybe (ColSpan, b)
forall a. a -> Maybe a
Just (ColSpan
c, b
r)]
| Bool
otherwise = Int -> Maybe (ColSpan, b) -> [Maybe (ColSpan, b)]
forall a. Int -> a -> [a]
replicate (ColSpan -> Int
getCS ColSpan
c) Maybe (ColSpan, b)
forall a. Maybe a
Nothing
splitHang :: [Maybe (ColSpan, RowSpan)]
-> (ColSpan,
[Maybe (ColSpan, RowSpan)] -> [Maybe (ColSpan, RowSpan)],
[Maybe (ColSpan, RowSpan)])
splitHang = ColSpan
-> ([Maybe (ColSpan, RowSpan)] -> [Maybe (ColSpan, RowSpan)])
-> [Maybe (ColSpan, RowSpan)]
-> (ColSpan,
[Maybe (ColSpan, RowSpan)] -> [Maybe (ColSpan, RowSpan)],
[Maybe (ColSpan, RowSpan)])
forall b c.
(Ord b, Num b) =>
ColSpan
-> ([Maybe (ColSpan, b)] -> c)
-> [Maybe (ColSpan, b)]
-> (ColSpan, [Maybe (ColSpan, b)] -> c, [Maybe (ColSpan, b)])
splitHang' ColSpan
0 [Maybe (ColSpan, RowSpan)] -> [Maybe (ColSpan, RowSpan)]
forall a. a -> a
id
splitHang' :: ColSpan
-> ([Maybe (ColSpan, b)] -> c)
-> [Maybe (ColSpan, b)]
-> (ColSpan, [Maybe (ColSpan, b)] -> c, [Maybe (ColSpan, b)])
splitHang' !ColSpan
n [Maybe (ColSpan, b)] -> c
l (Just (ColSpan
c, b
r):[Maybe (ColSpan, b)]
xs)
= ColSpan
-> ([Maybe (ColSpan, b)] -> c)
-> [Maybe (ColSpan, b)]
-> (ColSpan, [Maybe (ColSpan, b)] -> c, [Maybe (ColSpan, b)])
splitHang' (ColSpan
n ColSpan -> ColSpan -> ColSpan
forall a. Num a => a -> a -> a
+ ColSpan
c) ([Maybe (ColSpan, b)] -> c
l ([Maybe (ColSpan, b)] -> c)
-> ([Maybe (ColSpan, b)] -> [Maybe (ColSpan, b)])
-> [Maybe (ColSpan, b)]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColSpan -> b -> [Maybe (ColSpan, b)]
forall b. (Ord b, Num b) => ColSpan -> b -> [Maybe (ColSpan, b)]
toHang ColSpan
c (b
rb -> b -> b
forall a. Num a => a -> a -> a
-b
1) [Maybe (ColSpan, b)]
-> [Maybe (ColSpan, b)] -> [Maybe (ColSpan, b)]
forall a. [a] -> [a] -> [a]
++)) [Maybe (ColSpan, b)]
xs
splitHang' ColSpan
n [Maybe (ColSpan, b)] -> c
l [Maybe (ColSpan, b)]
xs = (ColSpan
n, [Maybe (ColSpan, b)] -> c
l, [Maybe (ColSpan, b)]
xs)
dropToWidth :: (t -> t) -> t -> [t] -> [t]
dropToWidth t -> t
_ t
n [t]
l | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
1 = [t]
l
dropToWidth t -> t
wproj t
n (t
c:[t]
cs) = (t -> t) -> t -> [t] -> [t]
dropToWidth t -> t
wproj (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t -> t
wproj t
c) [t]
cs
dropToWidth t -> t
_ t
_ [] = []
simpTable :: PandocMonad m => Text -> Bool -> LP m Blocks
simpTable :: Text -> Bool -> LP m Blocks
simpTable Text
envname Bool
hasWidthParameter = LP m Blocks -> LP m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (LP m Blocks -> LP m Blocks) -> LP m Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ do
Bool
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasWidthParameter (ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ())
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ () ()
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m Inlines
-> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] LaTeXState m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines
tok)
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
[(Alignment, ColWidth, ([Tok], [Tok]))]
colspecs <- LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
forall (m :: * -> *).
PandocMonad m =>
LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
parseAligns
let ([Alignment]
aligns, [ColWidth]
widths, [([Tok], [Tok])]
prefsufs) = [(Alignment, ColWidth, ([Tok], [Tok]))]
-> ([Alignment], [ColWidth], [([Tok], [Tok])])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(Alignment, ColWidth, ([Tok], [Tok]))]
colspecs
ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe ()))
-> ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe ())
forall a b. (a -> b) -> a -> b
$ Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"caption" LP m Tok
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
setCaption
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
label
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
LP m Tok -> ParsecT [Tok] LaTeXState m (Maybe Tok)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
lbreak
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
hline
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
[Row]
header' <- [Row]
-> ParsecT [Tok] LaTeXState m [Row]
-> ParsecT [Tok] LaTeXState m [Row]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT [Tok] LaTeXState m [Row]
-> ParsecT [Tok] LaTeXState m [Row])
-> (ParsecT [Tok] LaTeXState m Row
-> ParsecT [Tok] LaTeXState m [Row])
-> ParsecT [Tok] LaTeXState m Row
-> ParsecT [Tok] LaTeXState m [Row]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT [Tok] LaTeXState m [Row]
-> ParsecT [Tok] LaTeXState m [Row]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] LaTeXState m [Row]
-> ParsecT [Tok] LaTeXState m [Row])
-> (ParsecT [Tok] LaTeXState m Row
-> ParsecT [Tok] LaTeXState m [Row])
-> ParsecT [Tok] LaTeXState m Row
-> ParsecT [Tok] LaTeXState m [Row]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row -> [Row])
-> ParsecT [Tok] LaTeXState m Row
-> ParsecT [Tok] LaTeXState m [Row]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Row -> [Row] -> [Row]
forall a. a -> [a] -> [a]
:[]) (ParsecT [Tok] LaTeXState m Row
-> ParsecT [Tok] LaTeXState m [Row])
-> ParsecT [Tok] LaTeXState m Row
-> ParsecT [Tok] LaTeXState m [Row]
forall a b. (a -> b) -> a -> b
$
Text -> [([Tok], [Tok])] -> ParsecT [Tok] LaTeXState m Row
forall (m :: * -> *).
PandocMonad m =>
Text -> [([Tok], [Tok])] -> LP m Row
parseTableRow Text
envname [([Tok], [Tok])]
prefsufs ParsecT [Tok] LaTeXState m Row
-> LP m Tok -> ParsecT [Tok] LaTeXState m Row
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
lbreak ParsecT [Tok] LaTeXState m Row
-> ParsecT [Tok] LaTeXState m [()]
-> ParsecT [Tok] LaTeXState m Row
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m [()]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
hline
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
[Row]
rows <- ParsecT [Tok] LaTeXState m Row
-> LP m Tok -> ParsecT [Tok] LaTeXState m [Row]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepEndBy (Text -> [([Tok], [Tok])] -> ParsecT [Tok] LaTeXState m Row
forall (m :: * -> *).
PandocMonad m =>
Text -> [([Tok], [Tok])] -> LP m Row
parseTableRow Text
envname [([Tok], [Tok])]
prefsufs)
(LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
lbreak LP m Tok -> ParsecT [Tok] LaTeXState m (Maybe ()) -> LP m Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
hline))
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe ()))
-> ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe ())
forall a b. (a -> b) -> a -> b
$ Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"caption" LP m Tok
-> ParsecT [Tok] LaTeXState m () -> ParsecT [Tok] LaTeXState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
setCaption
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
ParsecT [Tok] LaTeXState m ()
-> ParsecT [Tok] LaTeXState m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
label
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
LP m Tok -> ParsecT [Tok] LaTeXState m (Maybe Tok)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional LP m Tok
forall (m :: * -> *). PandocMonad m => LP m Tok
lbreak
ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces
LP m Tok -> LP m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (LP m Tok -> LP m Tok) -> LP m Tok -> LP m Tok
forall a b. (a -> b) -> a -> b
$ Text -> LP m Tok
forall (m :: * -> *). PandocMonad m => Text -> LP m Tok
controlSeq Text
"end"
let th :: TableHead
th = TableHead -> TableHead
fixTableHead (TableHead -> TableHead) -> TableHead -> TableHead
forall a b. (a -> b) -> a -> b
$ Attr -> [Row] -> TableHead
TableHead Attr
nullAttr [Row]
header'
let tbs :: [TableBody]
tbs = [TableBody -> TableBody
fixTableBody (TableBody -> TableBody) -> TableBody -> TableBody
forall a b. (a -> b) -> a -> b
$ Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] [Row]
rows]
let tf :: TableFoot
tf = Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr []
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> LP m Blocks) -> Blocks -> LP m Blocks
forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
table Caption
emptyCaption ([Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns [ColWidth]
widths) TableHead
th [TableBody]
tbs TableFoot
tf
addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
addTableCaption :: Blocks -> LP m Blocks
addTableCaption = (Block -> ParsecT [Tok] LaTeXState m Block)
-> Blocks -> LP m Blocks
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Block -> ParsecT [Tok] LaTeXState m Block
forall (m :: * -> *).
Monad m =>
Block -> ParsecT [Tok] LaTeXState m Block
go
where go :: Block -> ParsecT [Tok] LaTeXState m Block
go (Table Attr
attr Caption
c [ColSpec]
spec TableHead
th [TableBody]
tb TableFoot
tf) = do
LaTeXState
st <- ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let mblabel :: Maybe Text
mblabel = LaTeXState -> Maybe Text
sLastLabel LaTeXState
st
Caption
capt <- case (LaTeXState -> Maybe Inlines
sCaption LaTeXState
st, Maybe Text
mblabel) of
(Just Inlines
ils, Maybe Text
Nothing) -> Caption -> ParsecT [Tok] LaTeXState m Caption
forall (m :: * -> *) a. Monad m => a -> m a
return (Caption -> ParsecT [Tok] LaTeXState m Caption)
-> Caption -> ParsecT [Tok] LaTeXState m Caption
forall a b. (a -> b) -> a -> b
$ Maybe [Inline] -> Blocks -> Caption
caption Maybe [Inline]
forall a. Maybe a
Nothing (Inlines -> Blocks
plain Inlines
ils)
(Just Inlines
ils, Just Text
lab) -> do
DottedNum
num <- (LaTeXState -> DottedNum) -> LP m DottedNum
forall (m :: * -> *).
Monad m =>
(LaTeXState -> DottedNum) -> LP m DottedNum
getNextNumber LaTeXState -> DottedNum
sLastTableNum
LaTeXState -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState
LaTeXState
st{ sLastTableNum :: DottedNum
sLastTableNum = DottedNum
num
, sLabels :: Map Text [Inline]
sLabels = Text -> [Inline] -> Map Text [Inline] -> Map Text [Inline]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
lab
[Text -> Inline
Str (DottedNum -> Text
renderDottedNum DottedNum
num)]
(LaTeXState -> Map Text [Inline]
sLabels LaTeXState
st) }
Caption -> ParsecT [Tok] LaTeXState m Caption
forall (m :: * -> *) a. Monad m => a -> m a
return (Caption -> ParsecT [Tok] LaTeXState m Caption)
-> Caption -> ParsecT [Tok] LaTeXState m Caption
forall a b. (a -> b) -> a -> b
$ Maybe [Inline] -> Blocks -> Caption
caption Maybe [Inline]
forall a. Maybe a
Nothing (Inlines -> Blocks
plain Inlines
ils)
(Maybe Inlines
Nothing, Maybe Text
_) -> Caption -> ParsecT [Tok] LaTeXState m Caption
forall (m :: * -> *) a. Monad m => a -> m a
return Caption
c
let attr' :: Attr
attr' = case (Attr
attr, Maybe Text
mblabel) of
((Text
_,[Text]
classes,[(Text, Text)]
kvs), Just Text
ident) ->
(Text
ident,[Text]
classes,[(Text, Text)]
kvs)
(Attr, Maybe Text)
_ -> Attr
attr
Block -> ParsecT [Tok] LaTeXState m Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> ParsecT [Tok] LaTeXState m Block)
-> Block -> ParsecT [Tok] LaTeXState m Block
forall a b. (a -> b) -> a -> b
$ Attr -> Block -> Block
addAttrDiv Attr
attr' (Block -> Block) -> Block -> Block
forall a b. (a -> b) -> a -> b
$ Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
nullAttr Caption
capt [ColSpec]
spec TableHead
th [TableBody]
tb TableFoot
tf
go Block
x = Block -> ParsecT [Tok] LaTeXState m Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block
x
addAttrDiv :: Attr -> Block -> Block
addAttrDiv :: Attr -> Block -> Block
addAttrDiv (Text
"",[],[]) Block
b = Block
b
addAttrDiv Attr
attr Block
b = Attr -> [Block] -> Block
Div Attr
attr [Block
b]
block :: PandocMonad m => LP m Blocks
block :: LP m Blocks
block = do
Blocks
res <- (Blocks
forall a. Monoid a => a
mempty Blocks -> ParsecT [Tok] LaTeXState m () -> LP m Blocks
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => LP m ()
spaces1)
LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
environment
LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Blocks) -> LP m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
(Text -> a) -> LP m a
macroDef (Text -> Text -> Blocks
rawBlock Text
"latex")
LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
blockCommand
LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
paragraph
LP m Blocks -> LP m Blocks -> LP m Blocks
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LP m Blocks -> LP m Blocks
forall (m :: * -> *) a.
(PandocMonad m, Monoid a) =>
LP m a -> LP m a
grouped LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block
Text -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => Text -> m ()
trace (Int -> Text -> Text
T.take Int
60 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Show a => a -> Text
tshow ([Block] -> Text) -> [Block] -> Text
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
res)
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
res
blocks :: PandocMonad m => LP m Blocks
blocks :: LP m Blocks
blocks = [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [Tok] LaTeXState m [Blocks] -> LP m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Blocks -> ParsecT [Tok] LaTeXState m [Blocks]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many LP m Blocks
forall (m :: * -> *). PandocMonad m => LP m Blocks
block
setDefaultLanguage :: PandocMonad m => LP m Blocks
setDefaultLanguage :: LP m Blocks
setDefaultLanguage = do
Text
o <- Text
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text)
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
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 -> Text)
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => LP m Text
rawopt
Text
polylang <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
case Text -> Map Text (Text -> Lang) -> Maybe (Text -> Lang)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
polylang Map Text (Text -> Lang)
polyglossiaLangToBCP47 of
Maybe (Text -> Lang)
Nothing -> Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Just Text -> Lang
langFunc -> do
let l :: Lang
l = Text -> Lang
langFunc Text
o
Lang -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => Lang -> m ()
setTranslations Lang
l
(LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ())
-> (LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> Inlines -> LaTeXState -> LaTeXState
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"lang" (Inlines -> LaTeXState -> LaTeXState)
-> Inlines -> LaTeXState -> LaTeXState
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Lang -> Text
renderLang Lang
l)
Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty