{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
   Module      : Text.Pandoc.Parsing
   Copyright   : Copyright (C) 2006-2024 John MacFarlane
   License     : GPL-2.0-or-later
   Maintainer  : John MacFarlane <jgm@berkeley.edu>

A default parser state with commonly used properties.
-}

module Text.Pandoc.Parsing.State
  ( ParserState (..)
  , ParserContext (..)
  , HeaderType (..)
  , NoteTable
  , NoteTable'
  , Key (..)
  , KeyTable
  , SubstTable
  , defaultParserState
  , toKey
  )
where

import Data.Default (Default (def))
import Data.Text (Text)
import Text.Parsec (SourcePos, getState, setState)
import Text.Pandoc.Builder (Blocks, HasMeta (..), Inlines)
import Text.Pandoc.Definition (Attr, Meta, Target, nullMeta)
import Text.Pandoc.Logging (LogMessage)
import Text.Pandoc.Options (ReaderOptions)
import Text.Pandoc.Parsing.Capabilities
import Text.Pandoc.Parsing.Future
import Text.Pandoc.TeX (Macro)

import qualified Data.Map as M
import qualified Data.Set as Set
import qualified Data.Text as T

-- | Parsing options.
data ParserState = ParserState
  { ParserState -> ReaderOptions
stateOptions         :: ReaderOptions -- ^ User options
  , ParserState -> ParserContext
stateParserContext   :: ParserContext -- ^ Inside list?
  , ParserState -> QuoteContext
stateQuoteContext    :: QuoteContext  -- ^ Inside quoted environment?
  , ParserState -> Bool
stateAllowLinks      :: Bool          -- ^ Allow parsing of links
  , ParserState -> Bool
stateAllowLineBreaks :: Bool          -- ^ Allow parsing of line breaks
  , ParserState -> Maybe SourcePos
stateLastStrPos      :: Maybe SourcePos -- ^ Position after last str parsed
  , ParserState -> KeyTable
stateKeys            :: KeyTable      -- ^ List of reference keys
  , ParserState -> KeyTable
stateHeaderKeys      :: KeyTable      -- ^ List of implicit header ref keys
  , ParserState -> SubstTable
stateSubstitutions   :: SubstTable    -- ^ List of substitution references
  , ParserState -> NoteTable
stateNotes           :: NoteTable     -- ^ List of notes (raw bodies)
  , ParserState -> NoteTable'
stateNotes'          :: NoteTable'    -- ^ List of notes (parsed bodies)
  , ParserState -> Set Text
stateNoteRefs        :: Set.Set Text  -- ^ List of note references used
  , ParserState -> Bool
stateInNote          :: Bool          -- ^ True if parsing note contents
  , ParserState -> Int
stateNoteNumber      :: Int           -- ^ Last note number for citations
  , ParserState -> Meta
stateMeta            :: Meta          -- ^ Document metadata
  , ParserState -> Future ParserState Meta
stateMeta'           :: Future ParserState Meta -- ^ Document metadata
  , ParserState -> Map Text Text
stateCitations       :: M.Map Text Text -- ^ RST-style citations
  , ParserState -> [HeaderType]
stateHeaderTable     :: [HeaderType]  -- ^ Ordered list of header types used
  , ParserState -> Set Text
stateIdentifiers     :: Set.Set Text  -- ^ Header identifiers used
  , ParserState -> Int
stateNextExample     :: Int           -- ^ Number of next example
  , ParserState -> Map Text Int
stateExamples        :: M.Map Text Int -- ^ Map from example labels to numbers
  , ParserState -> Map Text Macro
stateMacros          :: M.Map Text Macro -- ^ Table of macros defined so far
  , ParserState -> Text
stateRstDefaultRole  :: Text          -- ^ Current rST default
                                           -- interpreted text role
  , ParserState -> Maybe Text
stateRstHighlight    :: Maybe Text    -- ^ Current rST literal block
                                           -- language
  , ParserState -> Map Text (Text, Maybe Text, Attr)
stateRstCustomRoles  :: M.Map Text (Text, Maybe Text, Attr)
    -- ^ Current rST cust text roles;
    -- Triple represents:) Base role 2) Optional format (only for :raw:
    -- roles) 3) Addition classes (rest of Attr is unused)).
  , ParserState -> Maybe Inlines
stateCaption         :: Maybe Inlines -- ^ Caption in current environment
  , ParserState -> Maybe Text
stateInHtmlBlock     :: Maybe Text    -- ^ Tag type of HTML block being parsed
  , ParserState -> Int
stateFencedDivLevel  :: Int           -- ^ Depth of fenced div
  , ParserState -> [Text]
stateContainers      :: [Text]        -- ^ parent include files
  , ParserState -> [LogMessage]
stateLogMessages     :: [LogMessage]  -- ^ log messages
  , ParserState -> Bool
stateMarkdownAttribute :: Bool        -- ^ True if in markdown=1 context
  }

instance Default ParserState where
  def :: ParserState
def = ParserState
defaultParserState

instance HasMeta ParserState where
  setMeta :: forall b. ToMetaValue b => Text -> b -> ParserState -> ParserState
setMeta Text
field b
val ParserState
st =
    ParserState
st{ stateMeta = setMeta field val $ stateMeta st }
  deleteMeta :: Text -> ParserState -> ParserState
deleteMeta Text
field ParserState
st =
    ParserState
st{ stateMeta = deleteMeta field $ stateMeta st }

instance HasReaderOptions ParserState where
  extractReaderOptions :: ParserState -> ReaderOptions
extractReaderOptions = ParserState -> ReaderOptions
stateOptions

instance Monad m => HasQuoteContext ParserState m where
  getQuoteContext :: forall s t. Stream s m t => ParsecT s ParserState m QuoteContext
getQuoteContext = ParserState -> QuoteContext
stateQuoteContext (ParserState -> QuoteContext)
-> ParsecT s ParserState m ParserState
-> ParsecT s ParserState m QuoteContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  withQuoteContext :: forall s a.
QuoteContext
-> ParsecT s ParserState m a -> ParsecT s ParserState m a
withQuoteContext QuoteContext
context ParsecT s ParserState m a
parser = do
    ParserState
oldState <- ParsecT s ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    let oldQuoteContext :: QuoteContext
oldQuoteContext = ParserState -> QuoteContext
stateQuoteContext ParserState
oldState
    ParserState -> ParsecT s ParserState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState ParserState
oldState { stateQuoteContext = context }
    a
result <- ParsecT s ParserState m a
parser
    ParserState
newState <- ParsecT s ParserState m ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    ParserState -> ParsecT s ParserState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState ParserState
newState { stateQuoteContext = oldQuoteContext }
    a -> ParsecT s ParserState m a
forall a. a -> ParsecT s ParserState m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

instance HasIdentifierList ParserState where
  extractIdentifierList :: ParserState -> Set Text
extractIdentifierList     = ParserState -> Set Text
stateIdentifiers
  updateIdentifierList :: (Set Text -> Set Text) -> ParserState -> ParserState
updateIdentifierList Set Text -> Set Text
f ParserState
st = ParserState
st{ stateIdentifiers = f $ stateIdentifiers st }

instance HasMacros ParserState where
  extractMacros :: ParserState -> Map Text Macro
extractMacros        = ParserState -> Map Text Macro
stateMacros
  updateMacros :: (Map Text Macro -> Map Text Macro) -> ParserState -> ParserState
updateMacros Map Text Macro -> Map Text Macro
f ParserState
st    = ParserState
st{ stateMacros = f $ stateMacros st }

instance HasLastStrPosition ParserState where
  setLastStrPos :: Maybe SourcePos -> ParserState -> ParserState
setLastStrPos Maybe SourcePos
pos ParserState
st = ParserState
st{ stateLastStrPos = pos }
  getLastStrPos :: ParserState -> Maybe SourcePos
getLastStrPos ParserState
st     = ParserState -> Maybe SourcePos
stateLastStrPos ParserState
st

instance HasLogMessages ParserState where
  addLogMessage :: LogMessage -> ParserState -> ParserState
addLogMessage LogMessage
msg ParserState
st = ParserState
st{ stateLogMessages = msg : stateLogMessages st }
  getLogMessages :: ParserState -> [LogMessage]
getLogMessages ParserState
st = [LogMessage] -> [LogMessage]
forall a. [a] -> [a]
reverse ([LogMessage] -> [LogMessage]) -> [LogMessage] -> [LogMessage]
forall a b. (a -> b) -> a -> b
$ ParserState -> [LogMessage]
stateLogMessages ParserState
st

instance HasIncludeFiles ParserState where
  getIncludeFiles :: ParserState -> [Text]
getIncludeFiles = ParserState -> [Text]
stateContainers
  addIncludeFile :: Text -> ParserState -> ParserState
addIncludeFile Text
f ParserState
s = ParserState
s{ stateContainers = f : stateContainers s }
  dropLatestIncludeFile :: ParserState -> ParserState
dropLatestIncludeFile ParserState
s = ParserState
s { stateContainers = drop 1 $ stateContainers s }

data ParserContext
    = ListItemState   -- ^ Used when running parser on list item contents
    | NullState       -- ^ Default state
    deriving (ParserContext -> ParserContext -> Bool
(ParserContext -> ParserContext -> Bool)
-> (ParserContext -> ParserContext -> Bool) -> Eq ParserContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParserContext -> ParserContext -> Bool
== :: ParserContext -> ParserContext -> Bool
$c/= :: ParserContext -> ParserContext -> Bool
/= :: ParserContext -> ParserContext -> Bool
Eq, Int -> ParserContext -> ShowS
[ParserContext] -> ShowS
ParserContext -> String
(Int -> ParserContext -> ShowS)
-> (ParserContext -> String)
-> ([ParserContext] -> ShowS)
-> Show ParserContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParserContext -> ShowS
showsPrec :: Int -> ParserContext -> ShowS
$cshow :: ParserContext -> String
show :: ParserContext -> String
$cshowList :: [ParserContext] -> ShowS
showList :: [ParserContext] -> ShowS
Show)

data HeaderType
    = SingleHeader Char  -- ^ Single line of characters underneath
    | DoubleHeader Char  -- ^ Lines of characters above and below
    deriving (HeaderType -> HeaderType -> Bool
(HeaderType -> HeaderType -> Bool)
-> (HeaderType -> HeaderType -> Bool) -> Eq HeaderType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeaderType -> HeaderType -> Bool
== :: HeaderType -> HeaderType -> Bool
$c/= :: HeaderType -> HeaderType -> Bool
/= :: HeaderType -> HeaderType -> Bool
Eq, Int -> HeaderType -> ShowS
[HeaderType] -> ShowS
HeaderType -> String
(Int -> HeaderType -> ShowS)
-> (HeaderType -> String)
-> ([HeaderType] -> ShowS)
-> Show HeaderType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeaderType -> ShowS
showsPrec :: Int -> HeaderType -> ShowS
$cshow :: HeaderType -> String
show :: HeaderType -> String
$cshowList :: [HeaderType] -> ShowS
showList :: [HeaderType] -> ShowS
Show)

defaultParserState :: ParserState
defaultParserState :: ParserState
defaultParserState = ParserState
  { stateOptions :: ReaderOptions
stateOptions         = ReaderOptions
forall a. Default a => a
def
  , stateParserContext :: ParserContext
stateParserContext   = ParserContext
NullState
  , stateQuoteContext :: QuoteContext
stateQuoteContext    = QuoteContext
NoQuote
  , stateAllowLinks :: Bool
stateAllowLinks      = Bool
True
  , stateAllowLineBreaks :: Bool
stateAllowLineBreaks = Bool
True
  , stateLastStrPos :: Maybe SourcePos
stateLastStrPos      = Maybe SourcePos
forall a. Maybe a
Nothing
  , stateKeys :: KeyTable
stateKeys            = KeyTable
forall k a. Map k a
M.empty
  , stateHeaderKeys :: KeyTable
stateHeaderKeys      = KeyTable
forall k a. Map k a
M.empty
  , stateSubstitutions :: SubstTable
stateSubstitutions   = SubstTable
forall k a. Map k a
M.empty
  , stateNotes :: NoteTable
stateNotes           = []
  , stateNotes' :: NoteTable'
stateNotes'          = NoteTable'
forall k a. Map k a
M.empty
  , stateNoteRefs :: Set Text
stateNoteRefs        = Set Text
forall a. Set a
Set.empty
  , stateInNote :: Bool
stateInNote          = Bool
False
  , stateNoteNumber :: Int
stateNoteNumber      = Int
0
  , stateMeta :: Meta
stateMeta            = Meta
nullMeta
  , stateMeta' :: Future ParserState Meta
stateMeta'           = Meta -> Future ParserState Meta
forall a. a -> Future ParserState a
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
nullMeta
  , stateCitations :: Map Text Text
stateCitations       = Map Text Text
forall k a. Map k a
M.empty
  , stateHeaderTable :: [HeaderType]
stateHeaderTable     = []
  , stateIdentifiers :: Set Text
stateIdentifiers     = Set Text
forall a. Set a
Set.empty
  , stateNextExample :: Int
stateNextExample     = Int
1
  , stateExamples :: Map Text Int
stateExamples        = Map Text Int
forall k a. Map k a
M.empty
  , stateMacros :: Map Text Macro
stateMacros          = Map Text Macro
forall k a. Map k a
M.empty
  , stateRstDefaultRole :: Text
stateRstDefaultRole  = Text
"title-reference"
  , stateRstHighlight :: Maybe Text
stateRstHighlight    = Maybe Text
forall a. Maybe a
Nothing
  , stateRstCustomRoles :: Map Text (Text, Maybe Text, Attr)
stateRstCustomRoles  = Map Text (Text, Maybe Text, Attr)
forall k a. Map k a
M.empty
  , stateCaption :: Maybe Inlines
stateCaption         = Maybe Inlines
forall a. Maybe a
Nothing
  , stateInHtmlBlock :: Maybe Text
stateInHtmlBlock     = Maybe Text
forall a. Maybe a
Nothing
  , stateFencedDivLevel :: Int
stateFencedDivLevel  = Int
0
  , stateContainers :: [Text]
stateContainers      = []
  , stateLogMessages :: [LogMessage]
stateLogMessages     = []
  , stateMarkdownAttribute :: Bool
stateMarkdownAttribute = Bool
False
  }

type NoteTable = [(Text, Text)]

type NoteTable' = M.Map Text (SourcePos, Future ParserState Blocks)
-- used in markdown reader

newtype Key = Key Text deriving (Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show, ReadPrec [Key]
ReadPrec Key
Int -> ReadS Key
ReadS [Key]
(Int -> ReadS Key)
-> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read Key
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Key
readsPrec :: Int -> ReadS Key
$creadList :: ReadS [Key]
readList :: ReadS [Key]
$creadPrec :: ReadPrec Key
readPrec :: ReadPrec Key
$creadListPrec :: ReadPrec [Key]
readListPrec :: ReadPrec [Key]
Read, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, Eq Key
Eq Key =>
(Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Key -> Key -> Ordering
compare :: Key -> Key -> Ordering
$c< :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
>= :: Key -> Key -> Bool
$cmax :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
min :: Key -> Key -> Key
Ord)

toKey :: Text -> Key
toKey :: Text -> Key
toKey = Text -> Key
Key (Text -> Key) -> (Text -> Text) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
unbracket
  where unbracket :: Text -> Text
unbracket Text
t
          | Just (Char
'[', Text
t') <- Text -> Maybe (Char, Text)
T.uncons Text
t
          , Just (Text
t'', Char
']') <- Text -> Maybe (Text, Char)
T.unsnoc Text
t'
          = Text
t''
          | Bool
otherwise
          = Text
t

type KeyTable = M.Map Key (Target, Attr)

type SubstTable = M.Map Key Inlines