path: root/src/Text/Pandoc/Readers/LaTeX/Parsing.hs

{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{- |
   Module      : Text.Pandoc.Readers.LaTeX.Parsing
   Copyright   : Copyright (C) 2006-2021 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

General parsing types and functions for LaTeX.
-}
module Text.Pandoc.Readers.LaTeX.Parsing
  ( DottedNum(..)
  , renderDottedNum
  , incrementDottedNum
  , TheoremSpec(..)
  , TheoremStyle(..)
  , LaTeXState(..)
  , defaultLaTeXState
  , LP
  , withVerbatimMode
  , rawLaTeXParser
  , applyMacros
  , tokenize
  , tokenizeSources
  , getInputTokens
  , untokenize
  , untoken
  , totoks
  , toksToString
  , satisfyTok
  , parseFromToks
  , disablingWithRaw
  , doMacros
  , doMacros'
  , setpos
  , anyControlSeq
  , anySymbol
  , isNewlineTok
  , isWordTok
  , isArgTok
  , infile
  , spaces
  , spaces1
  , tokTypeIn
  , controlSeq
  , symbol
  , symbolIn
  , sp
  , whitespace
  , newlineTok
  , comment
  , anyTok
  , singleChar
  , tokWith
  , specialChars
  , endline
  , blankline
  , primEscape
  , bgroup
  , egroup
  , grouped
  , braced
  , braced'
  , bracedUrl
  , bracedOrToken
  , bracketed
  , bracketedToks
  , parenWrapped
  , dimenarg
  , ignore
  , withRaw
  , keyvals
  , verbEnv
  , begin_
  , end_
  , getRawCommand
  , skipopts
  , rawopt
  , overlaySpecification
  , getNextNumber
  , label
  , setCaption
  , resetCaption
  , env
  , addMeta
  , removeLabel
  ) where

import Control.Applicative (many, (<|>))
import Control.Monad
import Control.Monad.Except (throwError)
import Control.Monad.Trans (lift)
import Data.Char (chr, isAlphaNum, isDigit, isLetter, ord)
import Data.Default
import Data.List (intercalate)
import qualified Data.IntMap as IntMap
import qualified Data.Map as M
import qualified Data.Set as Set
import Data.Text (Text)
import Data.Maybe (fromMaybe)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as T
import Text.Pandoc.Builder
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Error
         (PandocError (PandocMacroLoop,PandocShouldNeverHappenError))
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, many, mathDisplay, mathInline,
                            space, spaces, withRaw, (<|>))
import Text.Pandoc.Readers.LaTeX.Types (ExpansionPoint (..), Macro (..),
                                        ArgSpec (..), Tok (..), TokType (..))
import Text.Pandoc.Shared
import Text.Parsec.Pos
import Text.Pandoc.Walk

newtype DottedNum = DottedNum [Int]
  deriving (Show, Eq)

renderDottedNum :: DottedNum -> T.Text
renderDottedNum (DottedNum xs) = T.pack $
  intercalate "." (map show xs)

incrementDottedNum :: Int -> DottedNum -> DottedNum
incrementDottedNum level (DottedNum ns) = DottedNum $
  case reverse (take level (ns ++ repeat 0)) of
       (x:xs) -> reverse (x+1 : xs)
       []     -> []  -- shouldn't happen

data TheoremStyle =
  PlainStyle | DefinitionStyle | RemarkStyle
  deriving (Show, Eq)

data TheoremSpec =
  TheoremSpec
    { theoremName    :: Inlines
    , theoremStyle   :: TheoremStyle
    , theoremSeries  :: Maybe Text
    , theoremSyncTo  :: Maybe Text
    , theoremNumber  :: Bool
    , theoremLastNum :: DottedNum }
    deriving (Show, Eq)

data LaTeXState = LaTeXState{ sOptions       :: ReaderOptions
                            , sMeta          :: Meta
                            , sQuoteContext  :: QuoteContext
                            , sMacros        :: NonEmpty (M.Map Text Macro)
                            , sContainers    :: [Text]
                            , sLogMessages   :: [LogMessage]
                            , sIdentifiers   :: Set.Set Text
                            , sVerbatimMode  :: Bool
                            , sCaption       :: Maybe Inlines
                            , sInListItem    :: Bool
                            , sInTableCell   :: Bool
                            , sLastHeaderNum :: DottedNum
                            , sLastFigureNum :: DottedNum
                            , sLastTableNum  :: DottedNum
                            , sTheoremMap    :: M.Map Text TheoremSpec
                            , sLastTheoremStyle :: TheoremStyle
                            , sLastLabel     :: Maybe Text
                            , sLabels        :: M.Map Text [Inline]
                            , sHasChapters   :: Bool
                            , sToggles       :: M.Map Text Bool
                            , sFileContents  :: M.Map Text Text
                            , sEnableWithRaw :: Bool
                            , sRawTokens     :: IntMap.IntMap [Tok]
                            , sTheBibItemNum :: Int
                            }
     deriving Show

defaultLaTeXState :: LaTeXState
defaultLaTeXState = LaTeXState{ sOptions       = def
                              , sMeta          = nullMeta
                              , sQuoteContext  = NoQuote
                              , sMacros        = M.empty :| []
                              , sContainers    = []
                              , sLogMessages   = []
                              , sIdentifiers   = Set.empty
                              , sVerbatimMode  = False
                              , sCaption       = Nothing
                              , sInListItem    = False
                              , sInTableCell   = False
                              , sLastHeaderNum = DottedNum []
                              , sLastFigureNum = DottedNum []
                              , sLastTableNum  = DottedNum []
                              , sTheoremMap    = M.empty
                              , sLastTheoremStyle = PlainStyle
                              , sLastLabel     = Nothing
                              , sLabels        = M.empty
                              , sHasChapters   = False
                              , sToggles       = M.empty
                              , sFileContents  = M.empty
                              , sEnableWithRaw = True
                              , sRawTokens     = IntMap.empty
                              , sTheBibItemNum = 0
                              }

instance PandocMonad m => HasQuoteContext LaTeXState m where
  getQuoteContext = sQuoteContext <$> getState
  withQuoteContext context parser = do
    oldState <- getState
    let oldQuoteContext = sQuoteContext oldState
    setState oldState { sQuoteContext = context }
    result <- parser
    newState <- getState
    setState newState { sQuoteContext = oldQuoteContext }
    return result

instance HasLogMessages LaTeXState where
  addLogMessage msg st = st{ sLogMessages = msg : sLogMessages st }
  getLogMessages st = reverse $ sLogMessages st

instance HasIdentifierList LaTeXState where
  extractIdentifierList     = sIdentifiers
  updateIdentifierList f st = st{ sIdentifiers = f $ sIdentifiers st }

instance HasIncludeFiles LaTeXState where
  getIncludeFiles = sContainers
  addIncludeFile f s = s{ sContainers = f : sContainers s }
  dropLatestIncludeFile s = s { sContainers = drop 1 $ sContainers s }

instance HasMacros LaTeXState where
  extractMacros  st  = NonEmpty.head $ sMacros st
  updateMacros f st  = st{ sMacros = f (NonEmpty.head (sMacros st))
                                     :| NonEmpty.tail (sMacros st) }

instance HasReaderOptions LaTeXState where
  extractReaderOptions = sOptions

instance HasMeta LaTeXState where
  setMeta field val st =
    st{ sMeta = setMeta field val $ sMeta st }
  deleteMeta field st =
    st{ sMeta = deleteMeta field $ sMeta st }

instance Default LaTeXState where
  def = defaultLaTeXState

type LP m = ParserT [Tok] LaTeXState m

withVerbatimMode :: PandocMonad m => LP m a -> LP m a
withVerbatimMode parser = do
  alreadyVerbatimMode <- sVerbatimMode <$> getState
  if alreadyVerbatimMode
     then parser
     else do
       updateState $ \st -> st{ sVerbatimMode = True }
       result <- parser
       updateState $ \st -> st{ sVerbatimMode = False }
       return result

rawLaTeXParser :: (PandocMonad m, HasMacros s, HasReaderOptions s, Show a)
               => [Tok] -> Bool -> LP m a -> LP m a
               -> ParserT Sources s m (a, Text)
rawLaTeXParser toks retokenize parser valParser = do
  pstate <- getState
  let lstate = def{ sOptions = extractReaderOptions pstate }
  let lstate' = lstate { sMacros = extractMacros pstate :| [] }
  let setStartPos = case toks of
                      Tok pos _ _ : _ -> setPosition pos
                      _ -> return ()
  let preparser = setStartPos >> parser
  let rawparser = (,) <$> withRaw valParser <*> getState
  res' <- lift $ runParserT (withRaw (preparser >> getPosition))
                            lstate "chunk" toks
  case res' of
       Left _    -> mzero
       Right (endpos, toks') -> do
         res <- lift $ runParserT (do when retokenize $ do
                                        -- retokenize, applying macros
                                        ts <- many anyTok
                                        setInput ts
                                      rawparser)
                        lstate' "chunk" toks'
         case res of
              Left _    -> mzero
              Right ((val, raw), st) -> do
                updateState (updateMacros ((NonEmpty.head (sMacros st)) <>))
                let skipTilPos stopPos = do
                      anyChar
                      pos <- getPosition
                      if pos >= stopPos
                         then return ()
                         else skipTilPos stopPos
                skipTilPos endpos
                let result = untokenize raw
                -- ensure we end with space if input did, see #4442
                let result' =
                      case reverse toks' of
                        (Tok _ (CtrlSeq _) t : _)
                         | " " `T.isSuffixOf` t
                         , not (" " `T.isSuffixOf` result)
                          -> result <> " "
                        _ -> result
                return (val, result')

applyMacros :: (PandocMonad m, HasMacros s, HasReaderOptions s)
            => Text -> ParserT Sources s m Text
applyMacros s = (guardDisabled Ext_latex_macros >> return s) <|>
   do let retokenize = untokenize <$> many anyTok
      pstate <- getState
      let lstate = def{ sOptions = extractReaderOptions pstate
                      , sMacros  = extractMacros pstate :| [] }
      res <- runParserT retokenize lstate "math" (tokenize "math" s)
      case res of
           Left e   -> Prelude.fail (show e)
           Right s' -> return s'

{-
When tokenize or untokenize change, test with this
QuickCheck property:

> tokUntokRoundtrip :: String -> Bool
> tokUntokRoundtrip s =
>   let t = T.pack s in untokenize (tokenize "random" t) == t
-}

tokenizeSources :: Sources -> [Tok]
tokenizeSources = concatMap tokenizeSource . unSources
 where
   tokenizeSource (pos, t) = totoks pos t

-- Return tokens from input sources. Ensure that starting position is
-- correct.
getInputTokens :: PandocMonad m => ParserT Sources s m [Tok]
getInputTokens = do
  pos <- getPosition
  ss <- getInput
  return $
    case ss of
      Sources [] -> []
      Sources ((_,t):rest) -> tokenizeSources $ Sources ((pos,t):rest)

tokenize :: SourceName -> Text -> [Tok]
tokenize sourcename = totoks (initialPos sourcename)

totoks :: SourcePos -> Text -> [Tok]
totoks pos t =
  case T.uncons t of
       Nothing        -> []
       Just (c, rest)
         | c == '\n' ->
           Tok pos Newline "\n"
           : totoks (setSourceColumn (incSourceLine pos 1) 1) rest
         | isSpaceOrTab c ->
           let (sps, rest') = T.span isSpaceOrTab t
           in  Tok pos Spaces sps
               : totoks (incSourceColumn pos (T.length sps))
                 rest'
         | isAlphaNum c ->
           let (ws, rest') = T.span isAlphaNum t
           in  Tok pos Word ws
               : totoks (incSourceColumn pos (T.length ws)) rest'
         | c == '%' ->
           let (cs, rest') = T.break (== '\n') rest
           in  Tok pos Comment ("%" <> cs)
               : totoks (incSourceColumn pos (1 + T.length cs)) rest'
         | c == '\\' ->
           case T.uncons rest of
                Nothing -> [Tok pos (CtrlSeq " ") "\\"]
                Just (d, rest')
                  | isLetterOrAt d ->
                      -- \makeatletter is common in macro defs;
                      -- ideally we should make tokenization sensitive
                      -- to \makeatletter and \makeatother, but this is
                      -- probably best for now
                      let (ws, rest'') = T.span isLetterOrAt rest
                          (ss, rest''') = T.span isSpaceOrTab rest''
                      in  Tok pos (CtrlSeq ws) ("\\" <> ws <> ss)
                          : totoks (incSourceColumn pos
                               (1 + T.length ws + T.length ss)) rest'''
                  | isSpaceOrTab d || d == '\n' ->
                      let (w1, r1) = T.span isSpaceOrTab rest
                          (w2, (w3, r3)) = case T.uncons r1 of
                                          Just ('\n', r2)
                                                  -> (T.pack "\n",
                                                        T.span isSpaceOrTab r2)
                                          _ -> (mempty, (mempty, r1))
                          ws = "\\" <> w1 <> w2 <> w3
                      in  case T.uncons r3 of
                               Just ('\n', _) ->
                                 Tok pos (CtrlSeq " ") ("\\" <> w1)
                                 : totoks (incSourceColumn pos (T.length ws))
                                   r1
                               _ ->
                                 Tok pos (CtrlSeq " ") ws
                                 : totoks (incSourceColumn pos (T.length ws))
                                   r3
                  | otherwise  ->
                      Tok pos (CtrlSeq (T.singleton d)) (T.pack [c,d])
                      : totoks (incSourceColumn pos 2) rest'
         | c == '#' ->
           let (t1, t2) = T.span (\d -> d >= '0' && d <= '9') rest
           in  case safeRead t1 of
                    Just i ->
                       Tok pos (Arg i) ("#" <> t1)
                       : totoks (incSourceColumn pos (1 + T.length t1)) t2
                    Nothing ->
                       Tok pos Symbol "#"
                       : totoks (incSourceColumn pos 1) t2
         | c == '^' ->
           case T.uncons rest of
                Just ('^', rest') ->
                  case T.uncons rest' of
                       Just (d, rest'')
                         | isLowerHex d ->
                           case T.uncons rest'' of
                                Just (e, rest''') | isLowerHex e ->
                                  Tok pos Esc2 (T.pack ['^','^',d,e])
                                  : totoks (incSourceColumn pos 4) rest'''
                                _ ->
                                  Tok pos Esc1 (T.pack ['^','^',d])
                                  : totoks (incSourceColumn pos 3) rest''
                         | d < '\128' ->
                                  Tok pos Esc1 (T.pack ['^','^',d])
                                  : totoks (incSourceColumn pos 3) rest''
                       _ -> Tok pos Symbol "^" :
                            Tok (incSourceColumn pos 1) Symbol "^" :
                            totoks (incSourceColumn pos 2) rest'
                _ -> Tok pos Symbol "^"
                     : totoks (incSourceColumn pos 1) rest
         | otherwise ->
           Tok pos Symbol (T.singleton c) : totoks (incSourceColumn pos 1) rest

isSpaceOrTab :: Char -> Bool
isSpaceOrTab ' '  = True
isSpaceOrTab '\t' = True
isSpaceOrTab _    = False

isLetterOrAt :: Char -> Bool
isLetterOrAt '@' = True
isLetterOrAt c   = isLetter c

isLowerHex :: Char -> Bool
isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'

untokenize :: [Tok] -> Text
untokenize = foldr untokenAccum mempty

untokenAccum :: Tok -> Text -> Text
untokenAccum (Tok _ (CtrlSeq _) t) accum =
  -- insert space to prevent breaking a control sequence; see #5836
  case (T.unsnoc t, T.uncons accum) of
    (Just (_,c), Just (d,_))
      | isLetter c
      , isLetter d
      -> t <> " " <> accum
    _ -> t <> accum
untokenAccum (Tok _ _ t) accum = t <> accum

untoken :: Tok -> Text
untoken t = untokenAccum t mempty

toksToString :: [Tok] -> String
toksToString = T.unpack . untokenize

parseFromToks :: PandocMonad m => LP m a -> [Tok] -> LP m a
parseFromToks parser toks = do
  oldInput <- getInput
  setInput toks
  oldpos <- getPosition
  case toks of
     Tok pos _ _ : _ -> setPosition pos
     _ -> return ()
  result <- disablingWithRaw parser
  setInput oldInput
  setPosition oldpos
  return result

disablingWithRaw :: PandocMonad m => LP m a -> LP m a
disablingWithRaw parser = do
  oldEnableWithRaw <- sEnableWithRaw <$> getState
  updateState $ \st -> st{ sEnableWithRaw = False }
  result <- parser
  updateState $ \st -> st{ sEnableWithRaw = oldEnableWithRaw }
  return result

satisfyTok :: PandocMonad m => (Tok -> Bool) -> LP m Tok
satisfyTok f = do
    doMacros -- apply macros on remaining input stream
    res <- tokenPrim (T.unpack . untoken) updatePos matcher
    updateState $ \st ->
      if sEnableWithRaw st
         then st{ sRawTokens = IntMap.map (res:) $ sRawTokens st }
         else st
    return $! res
  where matcher t | f t       = Just t
                  | otherwise = Nothing
        updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos
        updatePos _spos _ (Tok pos _ _ : _) = pos
        updatePos spos (Tok _ _ t)  []      = incSourceColumn spos (T.length t)

doMacros :: PandocMonad m => LP m ()
doMacros = do
  st <- getState
  unless (sVerbatimMode st) $
    getInput >>= doMacros' 1 >>= setInput

doMacros' :: PandocMonad m => Int -> [Tok] -> LP m [Tok]
doMacros' n inp =
  case inp of
     Tok spos (CtrlSeq "begin") _ : Tok _ Symbol "{" :
      Tok _ Word name : Tok _ Symbol "}" : ts
        -> handleMacros n spos name ts <|> return inp
     Tok spos (CtrlSeq "end") _ : Tok _ Symbol "{" :
      Tok _ Word name : Tok _ Symbol "}" : ts
        -> handleMacros n spos ("end" <> name) ts <|> return inp
     Tok _ (CtrlSeq "expandafter") _ : t : ts
        -> combineTok t <$> doMacros' n ts
     Tok spos (CtrlSeq name) _ : ts
        -> handleMacros n spos name ts <|> return inp
     _ -> return inp

  where
    combineTok (Tok spos (CtrlSeq name) x) (Tok _ Word w : ts)
      | T.all isLetterOrAt w =
        Tok spos (CtrlSeq (name <> w)) (x1 <> w <> x2) : ts
          where (x1, x2) = T.break isSpaceOrTab x
    combineTok t ts = t:ts

    matchTok (Tok _ toktype txt) =
      satisfyTok (\(Tok _ toktype' txt') ->
                    toktype == toktype' &&
                    txt == txt')

    matchPattern toks = try $ mapM_ matchTok toks

    getargs argmap [] = return argmap
    getargs argmap (Pattern toks : rest) = try $ do
       matchPattern toks
       getargs argmap rest
    getargs argmap (ArgNum i : Pattern toks : rest) =
      try $ do
        x <- mconcat <$> manyTill (braced <|> ((:[]) <$> anyTok))
                  (matchPattern toks)
        getargs (M.insert i x argmap) rest
    getargs argmap (ArgNum i : rest) = do
      x <- try $ spaces >> bracedOrToken
      getargs (M.insert i x argmap) rest

    addTok False args spos (Tok _ (Arg i) _) acc =
       case M.lookup i args of
            Nothing -> mzero
            Just xs -> foldr (addTok True args spos) acc xs
    -- see #4007
    addTok _ _ spos (Tok _ (CtrlSeq x) txt)
           acc@(Tok _ Word _ : _)
      | not (T.null txt)
      , isLetter (T.last txt) =
        Tok spos (CtrlSeq x) (txt <> " ") : acc
    addTok _ _ spos t acc = setpos spos t : acc

    handleMacros n' spos name ts = do
      when (n' > 20)  -- detect macro expansion loops
        $ throwError $ PandocMacroLoop name
      (macros :| _ ) <- sMacros <$> getState
      case M.lookup name macros of
           Nothing -> trySpecialMacro name ts
           Just (Macro _scope expansionPoint argspecs optarg newtoks) -> do
             let getargs' = do
                   args <-
                     (case expansionPoint of
                        ExpandWhenUsed    -> withVerbatimMode
                        ExpandWhenDefined -> id)
                     $ case optarg of
                             Nothing -> getargs M.empty argspecs
                             Just o  -> do
                                x <- option o bracketedToks
                                getargs (M.singleton 1 x) $ drop 1 argspecs
                   rest <- getInput
                   return (args, rest)
             lstate <- getState
             res <- lift $ runParserT getargs' lstate "args" ts
             case res of
               Left _ -> Prelude.fail $ "Could not parse arguments for " ++
                                T.unpack name
               Right (args, rest) -> do
                 -- first boolean param is true if we're tokenizing
                 -- an argument (in which case we don't want to
                 -- expand #1 etc.)
                 let result = foldr (addTok False args spos) rest newtoks
                 case expansionPoint of
                   ExpandWhenUsed    -> doMacros' (n' + 1) result
                   ExpandWhenDefined -> return result

-- | Certain macros do low-level tex manipulations that can't
-- be represented in our Macro type, so we handle them here.
trySpecialMacro :: PandocMonad m => Text -> [Tok] -> LP m [Tok]
trySpecialMacro "xspace" ts = do
  ts' <- doMacros' 1 ts
  case ts' of
    Tok pos Word t : _
      | startsWithAlphaNum t -> return $ Tok pos Spaces " " : ts'
    _ -> return ts'
trySpecialMacro "iftrue" ts = handleIf True ts
trySpecialMacro "iffalse" ts = handleIf False ts
trySpecialMacro _ _ = mzero

handleIf :: PandocMonad m => Bool -> [Tok] -> LP m [Tok]
handleIf b ts = do
  res' <- lift $ runParserT (ifParser b) defaultLaTeXState "tokens" ts
  case res' of
    Left _ -> Prelude.fail "Could not parse conditional"
    Right ts' -> return ts'

ifParser :: PandocMonad m => Bool -> LP m [Tok]
ifParser b = do
  ifToks <- many (notFollowedBy (controlSeq "else" <|> controlSeq "fi")
                    *> anyTok)
  elseToks <- (controlSeq "else" >> manyTill anyTok (controlSeq "fi"))
                 <|> ([] <$ controlSeq "fi")
  rest <- getInput
  return $ (if b then ifToks else elseToks) ++ rest

startsWithAlphaNum :: Text -> Bool
startsWithAlphaNum t =
  case T.uncons t of
       Just (c, _) | isAlphaNum c -> True
       _           -> False

setpos :: SourcePos -> Tok -> Tok
setpos spos (Tok _ tt txt) = Tok spos tt txt

anyControlSeq :: PandocMonad m => LP m Tok
anyControlSeq = satisfyTok isCtrlSeq

isCtrlSeq :: Tok -> Bool
isCtrlSeq (Tok _ (CtrlSeq _) _) = True
isCtrlSeq _                     = False

anySymbol :: PandocMonad m => LP m Tok
anySymbol = satisfyTok isSymbolTok

isSymbolTok :: Tok -> Bool
isSymbolTok (Tok _ Symbol _) = True
isSymbolTok _                = False

isWordTok :: Tok -> Bool
isWordTok (Tok _ Word _) = True
isWordTok _              = False

isArgTok :: Tok -> Bool
isArgTok (Tok _ (Arg _) _) = True
isArgTok _                 = False

infile :: PandocMonad m => SourceName -> LP m Tok
infile reference = satisfyTok (\(Tok source _ _) -> (sourceName source) == reference)

spaces :: PandocMonad m => LP m ()
spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))

spaces1 :: PandocMonad m => LP m ()
spaces1 = skipMany1 (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))

tokTypeIn :: [TokType] -> Tok -> Bool
tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes

controlSeq :: PandocMonad m => Text -> LP m Tok
controlSeq name = satisfyTok isNamed
  where isNamed (Tok _ (CtrlSeq n) _) = n == name
        isNamed _                     = False

symbol :: PandocMonad m => Char -> LP m Tok
symbol c = satisfyTok isc
  where isc (Tok _ Symbol d) = case T.uncons d of
                                    Just (c',_) -> c == c'
                                    _           -> False
        isc _ = False

symbolIn :: PandocMonad m => [Char] -> LP m Tok
symbolIn cs = satisfyTok isInCs
  where isInCs (Tok _ Symbol d) = case T.uncons d of
                                       Just (c,_) -> c `elem` cs
                                       _          -> False
        isInCs _ = False

sp :: PandocMonad m => LP m ()
sp = do
  optional $ skipMany (whitespace <|> comment)
  optional $ endline  *> skipMany (whitespace <|> comment)

whitespace :: PandocMonad m => LP m ()
whitespace = () <$ satisfyTok isSpaceTok

isSpaceTok :: Tok -> Bool
isSpaceTok (Tok _ Spaces _) = True
isSpaceTok _                = False

newlineTok :: PandocMonad m => LP m ()
newlineTok = () <$ satisfyTok isNewlineTok

isNewlineTok :: Tok -> Bool
isNewlineTok (Tok _ Newline _) = True
isNewlineTok _                 = False

comment :: PandocMonad m => LP m ()
comment = () <$ satisfyTok isCommentTok

isCommentTok :: Tok -> Bool
isCommentTok (Tok _ Comment _) = True
isCommentTok _                 = False

anyTok :: PandocMonad m => LP m Tok
anyTok = satisfyTok (const True)

singleCharTok :: PandocMonad m => LP m Tok
singleCharTok =
  satisfyTok $ \case
     Tok _ Word  t   -> T.length t == 1
     Tok _ Symbol t  -> not (T.any (`Set.member` specialChars) t)
     _               -> False

singleChar :: PandocMonad m => LP m Tok
singleChar = singleCharTok <|> singleCharFromWord
 where
  singleCharFromWord = do
    Tok pos toktype t <- disablingWithRaw $ satisfyTok isWordTok
    let (t1, t2) = (T.take 1 t, T.drop 1 t)
    inp <- getInput
    setInput $ Tok pos toktype t1 : Tok (incSourceColumn pos 1) toktype t2 : inp
    anyTok

specialChars :: Set.Set Char
specialChars = Set.fromList "#$%&~_^\\{}"

endline :: PandocMonad m => LP m ()
endline = try $ do
  newlineTok
  lookAhead anyTok
  notFollowedBy blankline

blankline :: PandocMonad m => LP m ()
blankline = try $ skipMany whitespace *> newlineTok

primEscape :: PandocMonad m => LP m Char
primEscape = do
  Tok _ toktype t <- satisfyTok (tokTypeIn [Esc1, Esc2])
  case toktype of
       Esc1 -> case T.uncons (T.drop 2 t) of
                    Just (c, _)
                      | c >= '\64' && c <= '\127' -> return (chr (ord c - 64))
                      | otherwise                 -> return (chr (ord c + 64))
                    Nothing -> Prelude.fail "Empty content of Esc1"
       Esc2 -> case safeRead ("0x" <> T.drop 2 t) of
                    Just x  -> return (chr x)
                    Nothing -> Prelude.fail $ "Could not read: " ++ T.unpack t
       _    -> Prelude.fail "Expected an Esc1 or Esc2 token" -- should not happen

bgroup :: PandocMonad m => LP m Tok
bgroup = try $ do
  optional sp
  t <- symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup"
  -- Add a copy of the macro table to the top of the macro stack,
  -- private for this group. We inherit all the macros defined in
  -- the parent group.
  updateState $ \s -> s{ sMacros = NonEmpty.cons (NonEmpty.head (sMacros s))
                                                 (sMacros s) }
  return t


egroup :: PandocMonad m => LP m Tok
egroup = do
  t <- symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup"
  -- remove the group's macro table from the stack
  updateState $ \s -> s{ sMacros = fromMaybe (sMacros s) $
      NonEmpty.nonEmpty (NonEmpty.tail (sMacros s)) }
  return t

grouped :: (PandocMonad m,  Monoid a) => LP m a -> LP m a
grouped parser = try $ do
  bgroup
  -- first we check for an inner 'grouped', because
  -- {{a,b}} should be parsed the same as {a,b}
  try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup)

braced' :: PandocMonad m => LP m Tok -> LP m [Tok]
braced' getTok = symbol '{' *> go (1 :: Int)
 where
  go n = do
    t <- getTok
    case t of
      Tok _ Symbol "}"
        | n > 1     -> (t:) <$> go (n - 1)
        | otherwise -> return []
      Tok _ Symbol "{" -> (t:) <$> go (n + 1)
      _ -> (t:) <$> go n

braced :: PandocMonad m => LP m [Tok]
braced = braced' anyTok

-- URLs require special handling, because they can contain %
-- characters.  So we retonenize comments as we go...
bracedUrl :: PandocMonad m => LP m [Tok]
bracedUrl = braced' (retokenizeComment >> anyTok)

-- For handling URLs, which allow literal % characters...
retokenizeComment :: PandocMonad m => LP m ()
retokenizeComment = (do
  Tok pos Comment txt <- satisfyTok isCommentTok
  let updPos (Tok pos' toktype' txt') =
        Tok (incSourceColumn (incSourceLine pos' (sourceLine pos - 1))
             (sourceColumn pos)) toktype' txt'
  let newtoks = map updPos $ tokenize (sourceName pos) $ T.tail txt
  getInput >>= setInput . ((Tok pos Symbol "%" : newtoks) ++))
    <|> return ()

bracedOrToken :: PandocMonad m => LP m [Tok]
bracedOrToken = braced <|> ((:[]) <$> (anyControlSeq <|> singleChar))

bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a
bracketed parser = try $ do
  symbol '['
  mconcat <$> manyTill parser (symbol ']')

bracketedToks :: PandocMonad m => LP m [Tok]
bracketedToks = do
  symbol '['
  concat <$> manyTill ((snd <$> withRaw (try braced)) <|> count 1 anyTok)
                      (symbol ']')

parenWrapped :: PandocMonad m => Monoid a => LP m a -> LP m a
parenWrapped parser = try $ do
  symbol '('
  mconcat <$> manyTill parser (symbol ')')

dimenarg :: PandocMonad m => LP m Text
dimenarg = try $ do
  optional sp
  ch  <- option False $ True <$ symbol '='
  minus <- option "" $ "-" <$ symbol '-'
  Tok _ _ s1 <- satisfyTok isWordTok
  s2 <- option "" $ try $ do
          symbol '.'
          Tok _ _ t <-  satisfyTok isWordTok
          return ("." <> t)
  let s = s1 <> s2
  let (num, rest) = T.span (\c -> isDigit c || c == '.') s
  guard $ T.length num > 0
  guard $ rest `elem` ["", "pt","pc","in","bp","cm","mm","dd","cc","sp"]
  return $ T.pack ['=' | ch] <> minus <> s

ignore :: (Monoid a, PandocMonad m) => Text -> ParserT s u m a
ignore raw = do
  pos <- getPosition
  report $ SkippedContent raw pos
  return mempty

withRaw :: PandocMonad m => LP m a -> LP m (a, [Tok])
withRaw parser = do
  rawTokensMap <- sRawTokens <$> getState
  let key = case IntMap.lookupMax rawTokensMap of
               Nothing     -> 0
               Just (n,_)  -> n + 1
  -- insert empty list at key
  updateState $ \st -> st{ sRawTokens =
                             IntMap.insert key [] $ sRawTokens st }
  result <- parser
  mbRevToks <- IntMap.lookup key . sRawTokens <$> getState
  raw <- case mbRevToks of
           Just revtoks -> do
             updateState $ \st -> st{ sRawTokens =
                                        IntMap.delete key $ sRawTokens st}
             return $ reverse revtoks
           Nothing      ->
             throwError $ PandocShouldNeverHappenError $
                "sRawTokens has nothing at key " <> T.pack (show key)
  return (result, raw)

keyval :: PandocMonad m => LP m (Text, Text)
keyval = try $ do
  key <- untokenize <$> many1 (notFollowedBy (symbol '=') >>
                         (symbol '-' <|> symbol '_' <|> satisfyTok isWordTok))
  sp
  val <- option mempty $ do
           symbol '='
           sp
           (untokenize <$> braced) <|>
             (mconcat <$> many1 (
                 (untokenize . snd <$> withRaw braced)
                 <|>
                 (untokenize <$> many1
                      (satisfyTok
                         (\case
                                Tok _ Symbol "]" -> False
                                Tok _ Symbol "," -> False
                                Tok _ Symbol "{" -> False
                                Tok _ Symbol "}" -> False
                                _                -> True)))))
  optional (symbol ',')
  sp
  return (key, T.strip val)

keyvals :: PandocMonad m => LP m [(Text, Text)]
keyvals = try $ symbol '[' >> manyTill keyval (symbol ']') <* sp

verbEnv :: PandocMonad m => Text -> LP m Text
verbEnv name = withVerbatimMode $ do
  optional blankline
  res <- manyTill anyTok (end_ name)
  return $ stripTrailingNewline
         $ untokenize res

-- Strip single final newline and any spaces following it.
-- Input is unchanged if it doesn't end with newline +
-- optional spaces.
stripTrailingNewline :: Text -> Text
stripTrailingNewline t =
  let (b, e) = T.breakOnEnd "\n" t
  in  if T.all (== ' ') e
         then T.dropEnd 1 b
         else t

begin_ :: PandocMonad m => Text -> LP m ()
begin_ t = try (do
  controlSeq "begin"
  spaces
  txt <- untokenize <$> braced
  guard (t == txt)) <?> ("\\begin{" ++ T.unpack t ++ "}")

end_ :: PandocMonad m => Text -> LP m ()
end_ t = try (do
  controlSeq "end"
  spaces
  txt <- untokenize <$> braced
  guard $ t == txt) <?> ("\\end{" ++ T.unpack t ++ "}")

getRawCommand :: PandocMonad m => Text -> Text -> LP m Text
getRawCommand name txt = do
  (_, rawargs) <- withRaw $
      case name of
           "write" -> do
             void $ many $ satisfyTok isDigitTok -- digits
             void braced
           "titleformat" -> do
             void braced
             skipopts
             void $ count 4 braced
           "def" ->
             void $ manyTill anyTok braced
           "vadjust" ->
             void (manyTill anyTok braced) <|>
                void (satisfyTok isPreTok) -- see #7531
           _ | isFontSizeCommand name -> return ()
             | otherwise -> do
               skipopts
               option "" (try dimenarg)
               void $ many braced
  return $ txt <> untokenize rawargs

isPreTok :: Tok -> Bool
isPreTok (Tok _ Word "pre") = True
isPreTok _ = False

isDigitTok :: Tok -> Bool
isDigitTok (Tok _ Word t) = T.all isDigit t
isDigitTok _              = False

skipopts :: PandocMonad m => LP m ()
skipopts = skipMany (void overlaySpecification <|> void rawopt)

-- opts in angle brackets are used in beamer
overlaySpecification :: PandocMonad m => LP m Text
overlaySpecification = try $ do
  symbol '<'
  t <- untokenize <$> manyTill overlayTok (symbol '>')
  -- see issue #3368
  guard $ not (T.all isLetter t) ||
          t `elem` ["beamer","presentation", "trans",
                    "handout","article", "second"]
  return $ "<" <> t <> ">"

overlayTok :: PandocMonad m => LP m Tok
overlayTok =
  satisfyTok (\case
                    Tok _ Word _       -> True
                    Tok _ Spaces _     -> True
                    Tok _ Symbol c     -> c `elem` ["-","+","@","|",":",","]
                    _                  -> False)

rawopt :: PandocMonad m => LP m Text
rawopt = try $ do
  sp
  inner <- untokenize <$> bracketedToks
  sp
  return $ "[" <> inner <> "]"

isFontSizeCommand :: Text -> Bool
isFontSizeCommand "tiny" = True
isFontSizeCommand "scriptsize" = True
isFontSizeCommand "footnotesize" = True
isFontSizeCommand "small" = True
isFontSizeCommand "normalsize" = True
isFontSizeCommand "large" = True
isFontSizeCommand "Large" = True
isFontSizeCommand "LARGE" = True
isFontSizeCommand "huge" = True
isFontSizeCommand "Huge" = True
isFontSizeCommand _ = False

getNextNumber :: Monad m
              => (LaTeXState -> DottedNum) -> LP m DottedNum
getNextNumber getCurrentNum = do
  st <- getState
  let chapnum =
        case sLastHeaderNum st of
             DottedNum (n:_) | sHasChapters st -> Just n
             _                                 -> Nothing
  return . DottedNum $
    case getCurrentNum st of
       DottedNum [m,n]  ->
         case chapnum of
              Just m' | m' == m   -> [m, n+1]
                      | otherwise -> [m', 1]
              Nothing             -> [1]
                                      -- shouldn't happen
       DottedNum [n]   ->
         case chapnum of
              Just m  -> [m, 1]
              Nothing -> [n + 1]
       _               ->
         case chapnum of
               Just n  -> [n, 1]
               Nothing -> [1]

label :: PandocMonad m => LP m ()
label = do
  controlSeq "label"
  t <- braced
  updateState $ \st -> st{ sLastLabel = Just $ untokenize t }

setCaption :: PandocMonad m => LP m Inlines -> LP m ()
setCaption inline = try $ do
  skipopts
  ils <- tokWith inline
  optional $ try $ spaces *> label
  updateState $ \st -> st{ sCaption = Just ils }

resetCaption :: PandocMonad m => LP m ()
resetCaption = updateState $ \st -> st{ sCaption   = Nothing
                                      , sLastLabel = Nothing }

env :: PandocMonad m => Text -> LP m a -> LP m a
env name p = do
  -- environments are groups as far as macros are concerned,
  -- so we need a local copy of the macro table (see above, bgroup, egroup):
  updateState $ \s -> s{ sMacros = NonEmpty.cons (NonEmpty.head (sMacros s))
                                                 (sMacros s) }
  result <- p
  updateState $ \s -> s{ sMacros = fromMaybe (sMacros s) $
      NonEmpty.nonEmpty (NonEmpty.tail (sMacros s)) }
  end_ name
  return result

tokWith :: PandocMonad m => LP m Inlines -> LP m Inlines
tokWith inlineParser = try $ spaces >>
                                 grouped inlineParser
                            <|> (lookAhead anyControlSeq >> inlineParser)
                            <|> singleChar'
  where singleChar' = do
          Tok _ _ t <- singleChar
          return $ str t

addMeta :: PandocMonad m => ToMetaValue a => Text -> a -> LP m ()
addMeta field val = updateState $ \st ->
   st{ sMeta = addMetaField field val $ sMeta st }

-- remove label spans to avoid duplicated identifier
removeLabel :: Walkable [Inline] a => Text -> a -> a
removeLabel lbl = walk go
 where
  go (Span (_,_,kvs) _ : rest)
    | Just lbl' <- lookup "label" kvs
    , lbl' == lbl = go (dropWhile isSpaceOrSoftBreak rest)
  go (x:xs) = x : go xs
  go [] = []
  isSpaceOrSoftBreak Space = True
  isSpaceOrSoftBreak SoftBreak = True
  isSpaceOrSoftBreak _ = False