{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ViewPatterns          #-}
{- |
   Module      : Text.Pandoc.Readers.LaTeX.Inline
   Copyright   : Copyright (C) 2006-2021 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable
-}
module Text.Pandoc.Readers.LaTeX.Inline
  ( acronymCommands
  , verbCommands
  , charCommands
  , accentCommands
  , nameCommands
  , biblatexInlineCommands
  , refCommands
  , rawInlineOr
  , listingsLanguage
  )
where

import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Builder
import Text.Pandoc.Shared (toRomanNumeral, safeRead)
import Text.Pandoc.Readers.LaTeX.Types (Tok (..), TokType (..))
import Control.Applicative (optional, (<|>))
import Control.Monad (guard, mzero, mplus, unless)
import Text.Pandoc.Class.PandocMonad (PandocMonad (..), translateTerm)
import Text.Pandoc.Readers.LaTeX.Parsing
import Text.Pandoc.Extensions (extensionEnabled, Extension(..))
import Text.Pandoc.Parsing (getOption, updateState, getState, notFollowedBy,
                            manyTill, getInput, setInput, incSourceColumn,
                            option, many1, try)
import Data.Char (isDigit)
import Text.Pandoc.Highlighting (fromListingsLanguage,)
import Data.Maybe (maybeToList, fromMaybe)
import Text.Pandoc.Options (ReaderOptions(..))
import qualified Data.Text.Normalize as Normalize
import qualified Text.Pandoc.Translations as Translations

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

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)

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
"]"

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

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

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

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
      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
<$> LP 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) -> 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
$
        String -> LP m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"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

accentWith :: PandocMonad m
           => LP m Inlines -> Char -> Maybe Char -> LP m Inlines
accentWith :: LP m Inlines -> Char -> Maybe Char -> LP m Inlines
accentWith LP m Inlines
tok 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
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
$
         -- try to normalize to the combined character:
         Text -> Inline
Str (NormalizationMode -> Text -> Text
Normalize.normalize NormalizationMode
Normalize.NFC
               (String -> 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


verbCommands :: PandocMonad m => M.Map Text (LP m Inlines)
verbCommands :: Map Text (LP m Inlines)
verbCommands = [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (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)
  ]

accentCommands :: PandocMonad m => LP m Inlines -> M.Map Text (LP m Inlines)
accentCommands :: LP m Inlines -> Map Text (LP m Inlines)
accentCommands LP m Inlines
tok =
  let accent :: Char -> Maybe Char -> LP m Inlines
accent = LP m Inlines -> Char -> Maybe Char -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
LP m Inlines -> Char -> Maybe Char -> LP m Inlines
accentWith LP m Inlines
tok
  in  [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (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
accent Char
'\779' Maybe Char
forall a. Maybe a
Nothing) -- hungarumlaut
  , (Text
"`", Char -> Maybe Char -> LP m Inlines
accent Char
'\768' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'`')) -- grave
  , (Text
"'", Char -> Maybe Char -> LP m Inlines
accent Char
'\769' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\'')) -- acute
  , (Text
"^", Char -> Maybe Char -> LP m Inlines
accent Char
'\770' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'^')) -- circ
  , (Text
"~", Char -> Maybe Char -> LP m Inlines
accent Char
'\771' (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'~')) -- tilde
  , (Text
"\"", Char -> Maybe Char -> LP m Inlines
accent Char
'\776' Maybe Char
forall a. Maybe a
Nothing) -- umlaut
  , (Text
".", Char -> Maybe Char -> LP m Inlines
accent Char
'\775' Maybe Char
forall a. Maybe a
Nothing) -- dot
  , (Text
"=", Char -> Maybe Char -> LP m Inlines
accent Char
'\772' Maybe Char
forall a. Maybe a
Nothing) -- macron
  , (Text
"|", Char -> Maybe Char -> LP m Inlines
accent Char
'\781' Maybe Char
forall a. Maybe a
Nothing) -- vertical line above
  , (Text
"b", Char -> Maybe Char -> LP m Inlines
accent Char
'\817' Maybe Char
forall a. Maybe a
Nothing) -- macron below
  , (Text
"c", Char -> Maybe Char -> LP m Inlines
accent Char
'\807' Maybe Char
forall a. Maybe a
Nothing) -- cedilla
  , (Text
"G", Char -> Maybe Char -> LP m Inlines
accent Char
'\783' Maybe Char
forall a. Maybe a
Nothing) -- doublegrave
  , (Text
"h", Char -> Maybe Char -> LP m Inlines
accent Char
'\777' Maybe Char
forall a. Maybe a
Nothing) -- hookabove
  , (Text
"d", Char -> Maybe Char -> LP m Inlines
accent Char
'\803' Maybe Char
forall a. Maybe a
Nothing) -- dotbelow
  , (Text
"f", Char -> Maybe Char -> LP m Inlines
accent Char
'\785' Maybe Char
forall a. Maybe a
Nothing)  -- inverted breve
  , (Text
"r", Char -> Maybe Char -> LP m Inlines
accent Char
'\778' Maybe Char
forall a. Maybe a
Nothing)  -- ringabove
  , (Text
"t", Char -> Maybe Char -> LP m Inlines
accent Char
'\865' Maybe Char
forall a. Maybe a
Nothing)  -- double inverted breve
  , (Text
"U", Char -> Maybe Char -> LP m Inlines
accent Char
'\782' Maybe Char
forall a. Maybe a
Nothing)  -- double vertical line above
  , (Text
"v", Char -> Maybe Char -> LP m Inlines
accent Char
'\780' Maybe Char
forall a. Maybe a
Nothing) -- hacek
  , (Text
"u", Char -> Maybe Char -> LP m Inlines
accent Char
'\774' Maybe Char
forall a. Maybe a
Nothing) -- breve
  , (Text
"k", Char -> Maybe Char -> LP m Inlines
accent Char
'\808' Maybe Char
forall a. Maybe a
Nothing) -- ogonek
  , (Text
"textogonekcentered", Char -> Maybe Char -> LP m Inlines
accent Char
'\808' Maybe Char
forall a. Maybe a
Nothing) -- ogonek
  , (Text
"i", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ı")  -- dotless i
  , (Text
"j", Text -> LP m Inlines
forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ȷ")  -- dotless j
  , (Text
"newtie", Char -> Maybe Char -> LP m Inlines
accent Char
'\785' Maybe Char
forall a. Maybe a
Nothing) -- inverted breve
  , (Text
"textcircled", Char -> Maybe Char -> LP m Inlines
accent Char
'\8413' Maybe Char
forall a. Maybe a
Nothing) -- combining circle
  ]

charCommands :: PandocMonad m => M.Map Text (LP m Inlines)
charCommands :: Map Text (LP m Inlines)
charCommands = [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (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
"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
"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
"/", Inlines -> LP m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty) -- italic correction
  , (Text
"\\", Inlines
linebreak Inlines -> ParsecT [Tok] LaTeXState 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 -> 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
inTableCell
                            ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => LP m Text
rawopt
                            ParsecT [Tok] LaTeXState 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
"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
"/")
  -- fontawesome
  , (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")
  -- hyphenat
  , (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
"-")
  ]

biblatexInlineCommands :: PandocMonad m
                       => LP m Inlines -> M.Map Text (LP m Inlines)
biblatexInlineCommands :: LP m Inlines -> Map Text (LP m Inlines)
biblatexInlineCommands LP m Inlines
tok = [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  -- biblatex misc
  [ (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
"mkbibquote", Attr -> Inlines -> Inlines
spanWith Attr
nullAttr (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
doubleQuoted (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
tok)
  , (Text
"mkbibemph", Attr -> Inlines -> Inlines
spanWith Attr
nullAttr (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
tok)
  , (Text
"mkbibitalic", Attr -> Inlines -> Inlines
spanWith Attr
nullAttr (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
tok)
  , (Text
"mkbibbold", Attr -> Inlines -> Inlines
spanWith Attr
nullAttr (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
tok)
  , (Text
"mkbibparens",
       Attr -> Inlines -> Inlines
spanWith Attr
nullAttr (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\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
")") (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
tok)
  , (Text
"mkbibbrackets",
       Attr -> Inlines -> Inlines
spanWith Attr
nullAttr (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\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
"]") (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
tok)
  , (Text
"autocap", Attr -> Inlines -> Inlines
spanWith Attr
nullAttr (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
tok)
  , (Text
"textnormal", 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
tok)
  , (Text
"bibstring",
       (\Text
x -> Attr -> Inlines -> Inlines
spanWith (Text
"",[],[(Text
"bibstring",Text
x)]) (Text -> Inlines
str Text
x)) (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
"adddot", Inlines -> LP m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Inlines
str Text
"."))
  , (Text
"adddotspace", Inlines -> LP m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attr -> Inlines -> Inlines
spanWith Attr
nullAttr (Text -> Inlines
str Text
"." Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space)))
  , (Text
"addabbrvspace", Inlines -> LP m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
space)
  , (Text
"hyphen", Inlines -> LP m Inlines
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Inlines
str Text
"-"))
  ]

nameCommands :: PandocMonad m => M.Map Text (LP m Inlines)
nameCommands :: Map Text (LP m Inlines)
nameCommands = [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (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)
  ]

refCommands :: PandocMonad m => M.Map Text (LP m Inlines)
refCommands :: Map Text (LP m Inlines)
refCommands = [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (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")       -- from cleveref.sty
  , (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")  -- from varioref.sty
  , (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")   -- from amsmath.sty
  ]

acronymCommands :: PandocMonad m => M.Map Text (LP m Inlines)
acronymCommands :: Map Text (LP m Inlines)
acronymCommands = [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  -- glossaries package
  [ (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")
  -- acronyms package
  , (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")
  ]

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
  let plural :: Inlines
plural = Text -> Inlines
str 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]]