{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ViewPatterns          #-}
{- |
   Module      : Text.Pandoc.Readers.LaTeX.Inline
   Copyright   : Copyright (C) 2006-2023 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.TeX (Tok (..), TokType (..))
import Control.Applicative (optional, (<|>))
import Control.Monad (guard, mzero, mplus, unless)
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
import Text.Pandoc.Translations (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)
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 :: forall (m :: * -> *).
PandocMonad m =>
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions
  if Bool
parseRaw
     then Text -> Text -> Inlines
rawInline Text
"latex" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Text -> Text -> LP m Text
getRawCommand Text
name' (Text
"\\" forall a. Semigroup a => a -> a -> a
<> Text
name')
     else LP m Inlines
fallback

dolabel :: PandocMonad m => LP m Inlines
dolabel :: forall (m :: * -> *). PandocMonad m => LP m Inlines
dolabel = do
  [Tok]
v <- forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  let refstr :: Text
refstr = [Tok] -> Text
untokenize [Tok]
v
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \LaTeXState
st ->
    LaTeXState
st{ sLastLabel :: Maybe Text
sLastLabel = forall a. a -> Maybe a
Just Text
refstr }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Text
refstr,[],[(Text
"label", Text
refstr)]) forall a. Monoid a => a
mempty

doref :: PandocMonad m => Text -> LP m Inlines
doref :: forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doref Text
cls = do
  [Tok]
v <- forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  let refstr :: Text
refstr = [Tok] -> Text
untokenize [Tok]
v
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
linkWith (Text
"",[],[ (Text
"reference-type", Text
cls)
                           , (Text
"reference", Text
refstr)])
                    (Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
refstr)
                    Text
""
                    (Inlines -> Inlines
inBrackets 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
"[" forall a. Semigroup a => a -> a -> a
<> Inlines
x forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"]"

doTerm :: PandocMonad m => Translations.Term -> LP m Inlines
doTerm :: forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
term = Text -> Inlines
str forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
term

lit :: Text -> LP m Inlines
lit :: forall (m :: * -> *). Text -> LP m Inlines
lit = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
str

doverb :: PandocMonad m => LP m Inlines
doverb :: forall (m :: * -> *). PandocMonad m => LP m Inlines
doverb = do
  Tok SourcePos
_ TokType
Symbol Text
t <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
              Maybe (Char, Text)
_            -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
  forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m a
withVerbatimMode forall a b. (a -> b) -> a -> b
$
    Text -> Inlines
code forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      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 (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *). PandocMonad m => LP m ()
newlineTok forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
verbTok Char
marker) (forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
marker)

verbTok :: PandocMonad m => Char -> LP m Tok
verbTok :: forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
verbTok Char
stopchar = do
  t :: Tok
t@(Tok SourcePos
pos TokType
toktype Text
txt) <- forall (m :: * -> *). PandocMonad m => LP m Tok
anyTok
  case (Char -> Bool) -> Text -> Maybe Column
T.findIndex (forall a. Eq a => a -> a -> Bool
== Char
stopchar) Text
txt of
       Maybe Column
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Tok
t
       Just Column
i  -> do
         let (Text
t1, Text
t2) = Column -> Text -> (Text, Text)
T.splitAt Column
i Text
txt
         TokStream Bool
macrosExpanded [Tok]
inp <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
         forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput forall a b. (a -> b) -> a -> b
$ Bool -> [Tok] -> TokStream
TokStream Bool
macrosExpanded
                  forall a b. (a -> b) -> a -> b
$ SourcePos -> TokType -> Text -> Tok
Tok (SourcePos -> Column -> SourcePos
incSourceColumn SourcePos
pos Column
i) TokType
Symbol (Char -> Text
T.singleton Char
stopchar)
                  forall a. a -> [a] -> [a]
: SourcePos -> Text -> [Tok]
tokenize (SourcePos -> Column -> SourcePos
incSourceColumn SourcePos
pos (Column
i forall a. Num a => a -> a -> a
+ Column
1)) (Column -> Text -> Text
T.drop Column
1 Text
t2) forall a. [a] -> [a] -> [a]
++ [Tok]
inp
         forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"language" [(Text, Text)]
opts of
    Maybe Text
Nothing  -> forall a. Maybe a
Nothing
    Just Text
l   -> Text -> Maybe Text
fromListingsLanguage Text
l forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. a -> Maybe a
Just Text
l

dolstinline :: PandocMonad m => LP m Inlines
dolstinline :: forall (m :: * -> *). PandocMonad m => LP m Inlines
dolstinline = do
  [(Text, Text)]
options <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall (m :: * -> *). PandocMonad m => LP m [(Text, Text)]
keyvals
  let classes :: [Text]
classes = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Maybe Text
listingsLanguage [(Text, Text)]
options
  forall (m :: * -> *). PandocMonad m => [Text] -> LP m Inlines
doinlinecode [Text]
classes

domintinline :: PandocMonad m => LP m Inlines
domintinline :: forall (m :: * -> *). PandocMonad m => LP m Inlines
domintinline = do
  forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
  Text
cls <- [Tok] -> Text
untokenize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  forall (m :: * -> *). PandocMonad m => [Text] -> LP m Inlines
doinlinecode [Text
cls]

doinlinecode :: PandocMonad m => [Text] -> LP m Inlines
doinlinecode :: forall (m :: * -> *). PandocMonad m => [Text] -> LP m Inlines
doinlinecode [Text]
classes = do
  Tok SourcePos
_ TokType
Symbol Text
t <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
              Maybe (Char, Text)
_            -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
  let stopchar :: Char
stopchar = if Char
marker forall a. Eq a => a -> a -> Bool
== Char
'{' then Char
'}' else Char
marker
  forall (m :: * -> *) a. PandocMonad m => LP m a -> LP m a
withVerbatimMode forall a b. (a -> b) -> a -> b
$
    Attr -> Text -> Inlines
codeWith (Text
"",[Text]
classes,[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
nlToSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      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 (forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
verbTok Char
stopchar) (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 :: forall (m :: * -> *). PandocMonad m => LP m Inlines
romanNumeralUpper =
  Text -> Inlines
str forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> Text
toRomanNumeral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => LP m Column
romanNumeralArg

romanNumeralLower :: (PandocMonad m) => LP m Inlines
romanNumeralLower :: forall (m :: * -> *). PandocMonad m => LP m Inlines
romanNumeralLower =
  Text -> Inlines
str forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> Text
toRomanNumeral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => LP m Column
romanNumeralArg

romanNumeralArg :: (PandocMonad m) => LP m Int
romanNumeralArg :: forall (m :: * -> *). PandocMonad m => LP m Column
romanNumeralArg = forall (m :: * -> *). PandocMonad m => LP m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT TokStream LaTeXState m Column
parser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT TokStream LaTeXState m Column
inBraces)
  where
    inBraces :: ParsecT TokStream LaTeXState m Column
inBraces = do
      forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'{'
      forall (m :: * -> *). PandocMonad m => LP m ()
spaces
      Column
res <- ParsecT TokStream LaTeXState m Column
parser
      forall (m :: * -> *). PandocMonad m => LP m ()
spaces
      forall (m :: * -> *). PandocMonad m => Char -> LP m Tok
symbol Char
'}'
      forall (m :: * -> *) a. Monad m => a -> m a
return Column
res
    parser :: ParsecT TokStream LaTeXState m Column
parser = do
      Text
s <- [Tok] -> Text
untokenize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (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
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
rest) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"Non-digits in argument to \\Rn or \\RN"
      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 :: forall (m :: * -> *).
PandocMonad m =>
LP m Inlines -> Char -> Maybe Char -> LP m Inlines
accentWith LP m Inlines
tok Char
combiningAccent Maybe Char
fallBack = do
  Inlines
ils <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Monoid a => a
mempty LP m Inlines
tok
  case forall a. Many a -> [a]
toList Inlines
ils of
       (Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
x, Text
xs)) : [Inline]
ys) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Many a
fromList 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]) forall a. Semigroup a => a -> a -> a
<> Text
xs) forall a. a -> [a] -> [a]
: [Inline]
ys
       [Inline
Space] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton
                         forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Char
combiningAccent Maybe Char
fallBack
       []      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton
                         forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Char
combiningAccent Maybe Char
fallBack
       [Inline]
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
ils


verbCommands :: PandocMonad m => M.Map Text (LP m Inlines)
verbCommands :: forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
verbCommands = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"verb", forall (m :: * -> *). PandocMonad m => LP m Inlines
doverb)
  , (Text
"lstinline", forall (m :: * -> *). PandocMonad m => LP m Inlines
dolstinline)
  , (Text
"mintinline", forall (m :: * -> *). PandocMonad m => LP m Inlines
domintinline)
  , (Text
"Verb", forall (m :: * -> *). PandocMonad m => LP m Inlines
doverb)
  ]

accentCommands :: PandocMonad m => LP m Inlines -> M.Map Text (LP m Inlines)
accentCommands :: forall (m :: * -> *).
PandocMonad m =>
LP m Inlines -> Map Text (LP m Inlines)
accentCommands LP m Inlines
tok =
  let accent :: Char -> Maybe Char -> LP m Inlines
accent = forall (m :: * -> *).
PandocMonad m =>
LP m Inlines -> Char -> Maybe Char -> LP m Inlines
accentWith LP m Inlines
tok
  in  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"aa", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"å")
  , (Text
"AA", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"Å")
  , (Text
"ss", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ß")
  , (Text
"o", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ø")
  , (Text
"O", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"Ø")
  , (Text
"L", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"Ł")
  , (Text
"l", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ł")
  , (Text
"ae", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"æ")
  , (Text
"AE", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"Æ")
  , (Text
"oe", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"œ")
  , (Text
"OE", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"Œ")
  , (Text
"pounds", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"£")
  , (Text
"euro", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"€")
  , (Text
"copyright", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"©")
  , (Text
"textasciicircum", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"^")
  , (Text
"textasciitilde", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"~")
  , (Text
"H", Char -> Maybe Char -> LP m Inlines
accent Char
'\779' forall a. Maybe a
Nothing) -- hungarumlaut
  , (Text
"`", Char -> Maybe Char -> LP m Inlines
accent Char
'\768' (forall a. a -> Maybe a
Just Char
'`')) -- grave
  , (Text
"'", Char -> Maybe Char -> LP m Inlines
accent Char
'\769' (forall a. a -> Maybe a
Just Char
'\'')) -- acute
  , (Text
"^", Char -> Maybe Char -> LP m Inlines
accent Char
'\770' (forall a. a -> Maybe a
Just Char
'^')) -- circ
  , (Text
"~", Char -> Maybe Char -> LP m Inlines
accent Char
'\771' (forall a. a -> Maybe a
Just Char
'~')) -- tilde
  , (Text
"\"", Char -> Maybe Char -> LP m Inlines
accent Char
'\776' forall a. Maybe a
Nothing) -- umlaut
  , (Text
".", Char -> Maybe Char -> LP m Inlines
accent Char
'\775' forall a. Maybe a
Nothing) -- dot
  , (Text
"=", Char -> Maybe Char -> LP m Inlines
accent Char
'\772' forall a. Maybe a
Nothing) -- macron
  , (Text
"|", Char -> Maybe Char -> LP m Inlines
accent Char
'\781' forall a. Maybe a
Nothing) -- vertical line above
  , (Text
"b", Char -> Maybe Char -> LP m Inlines
accent Char
'\817' forall a. Maybe a
Nothing) -- macron below
  , (Text
"c", Char -> Maybe Char -> LP m Inlines
accent Char
'\807' forall a. Maybe a
Nothing) -- cedilla
  , (Text
"G", Char -> Maybe Char -> LP m Inlines
accent Char
'\783' forall a. Maybe a
Nothing) -- doublegrave
  , (Text
"h", Char -> Maybe Char -> LP m Inlines
accent Char
'\777' forall a. Maybe a
Nothing) -- hookabove
  , (Text
"d", Char -> Maybe Char -> LP m Inlines
accent Char
'\803' forall a. Maybe a
Nothing) -- dotbelow
  , (Text
"f", Char -> Maybe Char -> LP m Inlines
accent Char
'\785' forall a. Maybe a
Nothing)  -- inverted breve
  , (Text
"r", Char -> Maybe Char -> LP m Inlines
accent Char
'\778' forall a. Maybe a
Nothing)  -- ringabove
  , (Text
"t", Char -> Maybe Char -> LP m Inlines
accent Char
'\865' forall a. Maybe a
Nothing)  -- double inverted breve
  , (Text
"U", Char -> Maybe Char -> LP m Inlines
accent Char
'\782' forall a. Maybe a
Nothing)  -- double vertical line above
  , (Text
"v", Char -> Maybe Char -> LP m Inlines
accent Char
'\780' forall a. Maybe a
Nothing) -- hacek
  , (Text
"u", Char -> Maybe Char -> LP m Inlines
accent Char
'\774' forall a. Maybe a
Nothing) -- breve
  , (Text
"k", Char -> Maybe Char -> LP m Inlines
accent Char
'\808' forall a. Maybe a
Nothing) -- ogonek
  , (Text
"textogonekcentered", Char -> Maybe Char -> LP m Inlines
accent Char
'\808' forall a. Maybe a
Nothing) -- ogonek
  , (Text
"i", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ı")  -- dotless i
  , (Text
"j", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"ȷ")  -- dotless j
  , (Text
"newtie", Char -> Maybe Char -> LP m Inlines
accent Char
'\785' forall a. Maybe a
Nothing) -- inverted breve
  , (Text
"textcircled", Char -> Maybe Char -> LP m Inlines
accent Char
'\8413' forall a. Maybe a
Nothing) -- combining circle
  ]

charCommands :: PandocMonad m => M.Map Text (LP m Inlines)
charCommands :: forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
charCommands = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"ldots", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"…")
  , (Text
"vdots", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\8942")
  , (Text
"dots", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"…")
  , (Text
"mdots", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"…")
  , (Text
"sim", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"~")
  , (Text
"sep", forall (m :: * -> *). Text -> LP m Inlines
lit Text
",")
  , (Text
"P", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"¶")
  , (Text
"S", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"§")
  , (Text
"$", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"$")
  , (Text
"%", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"%")
  , (Text
"&", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"&")
  , (Text
"#", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"#")
  , (Text
"_", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"_")
  , (Text
"{", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"{")
  , (Text
"}", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"}")
  , (Text
"qed", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\a0\x25FB")
  , (Text
"lq", forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"‘"))
  , (Text
"rq", forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"’"))
  , (Text
"textquoteleft", forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"‘"))
  , (Text
"textquoteright", forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"’"))
  , (Text
"textquotedblleft", forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"“"))
  , (Text
"textquotedblright", forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str Text
"”"))
  , (Text
"/", forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) -- italic correction
  , (Text
"\\", Inlines
linebreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (do Bool
inTableCell <- LaTeXState -> Bool
sInTableCell forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                            forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
inTableCell
                            forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall (m :: * -> *). PandocMonad m => LP m Text
rawopt
                            forall (m :: * -> *). PandocMonad m => LP m ()
spaces))
  , (Text
",", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\8198")
  , (Text
"@", forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)
  , (Text
" ", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\160")
  , (Text
"ps", forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str Text
"PS." forall a. Semigroup a => a -> a -> a
<> Inlines
space)
  , (Text
"TeX", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"TeX")
  , (Text
"LaTeX", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"LaTeX")
  , (Text
"bar", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"|")
  , (Text
"textless", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"<")
  , (Text
"textgreater", forall (m :: * -> *). Text -> LP m Inlines
lit Text
">")
  , (Text
"textbackslash", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\\")
  , (Text
"backslash", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\\")
  , (Text
"slash", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"/")
  -- fontawesome
  , (Text
"faCheck", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\10003")
  , (Text
"faClose", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\10007")
  -- hyphenat
  , (Text
"bshyp", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"\\\173")
  , (Text
"fshyp", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"/\173")
  , (Text
"dothyp", forall (m :: * -> *). Text -> LP m Inlines
lit Text
".\173")
  , (Text
"colonhyp", forall (m :: * -> *). Text -> LP m Inlines
lit Text
":\173")
  , (Text
"hyp", forall (m :: * -> *). Text -> LP m Inlines
lit Text
"-")
  ]

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

nameCommands :: PandocMonad m => M.Map Text (LP m Inlines)
nameCommands :: forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
nameCommands = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"figurename", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Figure)
  , (Text
"prefacename", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Preface)
  , (Text
"refname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.References)
  , (Text
"bibname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Bibliography)
  , (Text
"chaptername", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Chapter)
  , (Text
"partname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Part)
  , (Text
"contentsname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Contents)
  , (Text
"listfigurename", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.ListOfFigures)
  , (Text
"listtablename", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.ListOfTables)
  , (Text
"indexname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Index)
  , (Text
"abstractname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Abstract)
  , (Text
"tablename", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Table)
  , (Text
"enclname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Encl)
  , (Text
"ccname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Cc)
  , (Text
"headtoname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.To)
  , (Text
"pagename", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Page)
  , (Text
"seename", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.See)
  , (Text
"seealsoname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.SeeAlso)
  , (Text
"proofname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Proof)
  , (Text
"glossaryname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Glossary)
  , (Text
"lstlistingname", forall (m :: * -> *). PandocMonad m => Term -> LP m Inlines
doTerm Term
Translations.Listing)
  ]

refCommands :: PandocMonad m => M.Map Text (LP m Inlines)
refCommands :: forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
refCommands = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"label", forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"label" forall (m :: * -> *). PandocMonad m => LP m Inlines
dolabel)
  , (Text
"ref", forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"ref" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doref Text
"ref")
  , (Text
"cref", forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"cref" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doref Text
"ref")       -- from cleveref.sty
  , (Text
"vref", forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"vref" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doref Text
"ref+page")  -- from varioref.sty
  , (Text
"eqref", forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"eqref" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doref Text
"eqref")   -- from amsmath.sty
  , (Text
"autoref", forall (m :: * -> *).
PandocMonad m =>
Text -> LP m Inlines -> LP m Inlines
rawInlineOr Text
"autoref" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doref Text
"autoref") -- from hyperref.sty
  ]

acronymCommands :: PandocMonad m => M.Map Text (LP m Inlines)
acronymCommands :: forall (m :: * -> *). PandocMonad m => Map Text (LP m Inlines)
acronymCommands = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  -- glossaries package
  [ (Text
"gls", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"short")
  , (Text
"Gls", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"short")
  , (Text
"glsdesc", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
  , (Text
"Glsdesc", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
  , (Text
"GLSdesc", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
  , (Text
"acrlong", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
  , (Text
"Acrlong", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
  , (Text
"acrfull", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"full")
  , (Text
"Acrfull", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"full")
  , (Text
"acrshort", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"abbrv")
  , (Text
"Acrshort", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"abbrv")
  , (Text
"glspl", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"short")
  , (Text
"Glspl", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"short")
  , (Text
"glsdescplural", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"long")
  , (Text
"Glsdescplural", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"long")
  , (Text
"GLSdescplural", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"long")
  -- acronyms package
  , (Text
"ac", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"short")
  , (Text
"acf", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"full")
  , (Text
"acs", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"abbrv")
  , (Text
"acl", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
  , (Text
"acp", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"short")
  , (Text
"acfp", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"full")
  , (Text
"acsp", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"abbrv")
  , (Text
"aclp", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"long")
  , (Text
"Ac", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"short")
  , (Text
"Acf", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"full")
  , (Text
"Acs", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"abbrv")
  , (Text
"Acl", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
"long")
  , (Text
"Acp", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"short")
  , (Text
"Acfp", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"full")
  , (Text
"Acsp", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"abbrv")
  , (Text
"Aclp", forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
"long")
  ]

doAcronym :: PandocMonad m => Text -> LP m Inlines
doAcronym :: forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronym Text
form = do
  [Tok]
acro <- forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat 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+" forall a. Semigroup a => a -> a -> a
<> Text
form)])
    forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize [Tok]
acro]

doAcronymPlural :: PandocMonad m => Text -> LP m Inlines
doAcronymPlural :: forall (m :: * -> *). PandocMonad m => Text -> LP m Inlines
doAcronymPlural Text
form = do
  [Tok]
acro <- forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  let plural :: Inlines
plural = Text -> Inlines
str Text
"s"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat 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+" forall a. Semigroup a => a -> a -> a
<> Text
form)]) forall a b. (a -> b) -> a -> b
$
   forall a. Monoid a => [a] -> a
mconcat [Text -> Inlines
str forall a b. (a -> b) -> a -> b
$ [Tok] -> Text
untokenize [Tok]
acro, Inlines
plural]]