{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{- |
   Module      : Text.Pandoc.Parsing
   Copyright   : Copyright (C) 2006-2023 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 :: Meta
stateMeta = forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
field b
val forall a b. (a -> b) -> a -> b
$ ParserState -> Meta
stateMeta ParserState
st }
  deleteMeta :: Text -> ParserState -> ParserState
deleteMeta Text
field ParserState
st =
    ParserState
st{ stateMeta :: Meta
stateMeta = forall a. HasMeta a => Text -> a -> a
deleteMeta Text
field forall a b. (a -> b) -> a -> b
$ ParserState -> Meta
stateMeta ParserState
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    let oldQuoteContext :: QuoteContext
oldQuoteContext = ParserState -> QuoteContext
stateQuoteContext ParserState
oldState
    forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState ParserState
oldState { stateQuoteContext :: QuoteContext
stateQuoteContext = QuoteContext
context }
    a
result <- ParsecT s ParserState m a
parser
    ParserState
newState <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState ParserState
newState { stateQuoteContext :: QuoteContext
stateQuoteContext = QuoteContext
oldQuoteContext }
    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 :: Set Text
stateIdentifiers = Set Text -> Set Text
f forall a b. (a -> b) -> a -> b
$ ParserState -> Set Text
stateIdentifiers ParserState
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 :: Map Text Macro
stateMacros = Map Text Macro -> Map Text Macro
f forall a b. (a -> b) -> a -> b
$ ParserState -> Map Text Macro
stateMacros ParserState
st }

instance HasLastStrPosition ParserState where
  setLastStrPos :: Maybe SourcePos -> ParserState -> ParserState
setLastStrPos Maybe SourcePos
pos ParserState
st = ParserState
st{ stateLastStrPos :: Maybe SourcePos
stateLastStrPos = Maybe SourcePos
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 :: [LogMessage]
stateLogMessages = LogMessage
msg forall a. a -> [a] -> [a]
: ParserState -> [LogMessage]
stateLogMessages ParserState
st }
  getLogMessages :: ParserState -> [LogMessage]
getLogMessages ParserState
st = forall a. [a] -> [a]
reverse 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 :: [Text]
stateContainers = Text
f forall a. a -> [a] -> [a]
: ParserState -> [Text]
stateContainers ParserState
s }
  dropLatestIncludeFile :: ParserState -> ParserState
dropLatestIncludeFile ParserState
s = ParserState
s { stateContainers :: [Text]
stateContainers = forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ ParserState -> [Text]
stateContainers ParserState
s }

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

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

defaultParserState :: ParserState
defaultParserState :: ParserState
defaultParserState = ParserState
  { stateOptions :: ReaderOptions
stateOptions         = 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      = forall a. Maybe a
Nothing
  , stateKeys :: KeyTable
stateKeys            = forall k a. Map k a
M.empty
  , stateHeaderKeys :: KeyTable
stateHeaderKeys      = forall k a. Map k a
M.empty
  , stateSubstitutions :: SubstTable
stateSubstitutions   = forall k a. Map k a
M.empty
  , stateNotes :: NoteTable
stateNotes           = []
  , stateNotes' :: NoteTable'
stateNotes'          = forall k a. Map k a
M.empty
  , stateNoteRefs :: Set Text
stateNoteRefs        = 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'           = forall (m :: * -> *) a. Monad m => a -> m a
return Meta
nullMeta
  , stateCitations :: Map Text Text
stateCitations       = forall k a. Map k a
M.empty
  , stateHeaderTable :: [HeaderType]
stateHeaderTable     = []
  , stateIdentifiers :: Set Text
stateIdentifiers     = forall a. Set a
Set.empty
  , stateNextExample :: Int
stateNextExample     = Int
1
  , stateExamples :: Map Text Int
stateExamples        = forall k a. Map k a
M.empty
  , stateMacros :: Map Text Macro
stateMacros          = forall k a. Map k a
M.empty
  , stateRstDefaultRole :: Text
stateRstDefaultRole  = Text
"title-reference"
  , stateRstHighlight :: Maybe Text
stateRstHighlight    = forall a. Maybe a
Nothing
  , stateRstCustomRoles :: Map Text (Text, Maybe Text, Attr)
stateRstCustomRoles  = forall k a. Map k a
M.empty
  , stateCaption :: Maybe Inlines
stateCaption         = forall a. Maybe a
Nothing
  , stateInHtmlBlock :: Maybe Text
stateInHtmlBlock     = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, ReadPrec [Key]
ReadPrec Key
Int -> ReadS Key
ReadS [Key]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Key]
$creadListPrec :: ReadPrec [Key]
readPrec :: ReadPrec Key
$creadPrec :: ReadPrec Key
readList :: ReadS [Key]
$creadList :: ReadS [Key]
readsPrec :: Int -> ReadS Key
$creadsPrec :: Int -> ReadS Key
Read, Key -> Key -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq 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
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$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
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
Ord)

toKey :: Text -> Key
toKey :: Text -> Key
toKey = Text -> Key
Key forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words 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