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

Parser state capabilities.
-}
module Text.Pandoc.Parsing.Capabilities
  ( -- * Capabilities

    -- ** Element identifiers
    HasIdentifierList (..)

    -- ** Include files
  , HasIncludeFiles (..)

    -- ** String/Word boundaries
  , HasLastStrPosition (..)
  , updateLastStrPos
  , notAfterString

    -- ** Logging
  , HasLogMessages (..)
  , logMessage
  , reportLogMessages

    -- ** Macros
  , HasMacros (..)

    -- ** Quote context
  , QuoteContext (..)
  , HasQuoteContext (..)
  , failIfInQuoteContext

    -- ** Reader options
  , HasReaderOptions (..)
  , guardEnabled
  , guardDisabled
  )
where

import Control.Monad (guard, when)
import Data.Text (Text)
import Text.Parsec (SourcePos, Stream, ParsecT,
                     getPosition, getState, updateState)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Logging (LogMessage)
import Text.Pandoc.Options
  ( Extension
  , ReaderOptions(readerExtensions)
  , extensionEnabled
  )
import Text.Pandoc.TeX (Macro)

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

class HasReaderOptions st where
  extractReaderOptions :: st -> ReaderOptions
  getOption            :: (Stream s m t) => (ReaderOptions -> b) -> ParsecT s st m b
  -- default
  getOption  ReaderOptions -> b
f         = ReaderOptions -> b
f (ReaderOptions -> b) -> (st -> ReaderOptions) -> st -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> ReaderOptions
forall st. HasReaderOptions st => st -> ReaderOptions
extractReaderOptions (st -> b) -> ParsecT s st m st -> ParsecT s st m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m st
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

class HasQuoteContext st m where
  getQuoteContext :: (Stream s m t) => ParsecT s st m QuoteContext
  withQuoteContext :: QuoteContext -> ParsecT s st m a -> ParsecT s st m a

failIfInQuoteContext :: (HasQuoteContext st m, Stream s m t)
                     => QuoteContext
                     -> ParsecT s st m ()
failIfInQuoteContext :: forall st (m :: * -> *) s t.
(HasQuoteContext st m, Stream s m t) =>
QuoteContext -> ParsecT s st m ()
failIfInQuoteContext QuoteContext
context = do
  QuoteContext
context' <- ParsecT s st m QuoteContext
forall s t. Stream s m t => ParsecT s st m QuoteContext
forall st (m :: * -> *) s t.
(HasQuoteContext st m, Stream s m t) =>
ParsecT s st m QuoteContext
getQuoteContext
  Bool -> ParsecT s st m () -> ParsecT s st m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (QuoteContext
context' QuoteContext -> QuoteContext -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteContext
context) (ParsecT s st m () -> ParsecT s st m ())
-> ParsecT s st m () -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT s st m ()
forall a. String -> ParsecT s st m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"already inside quotes"

class HasIdentifierList st where
  extractIdentifierList  :: st -> Set.Set Text
  updateIdentifierList   :: (Set.Set Text -> Set.Set Text) -> st -> st

class HasMacros st where
  extractMacros          :: st -> M.Map Text Macro
  updateMacros           :: (M.Map Text Macro -> M.Map Text Macro) -> st -> st

class HasLastStrPosition st where
  setLastStrPos  :: Maybe SourcePos -> st -> st
  getLastStrPos  :: st -> Maybe SourcePos

class HasLogMessages st where
  addLogMessage :: LogMessage -> st -> st
  getLogMessages :: st -> [LogMessage]

class HasIncludeFiles st where
  getIncludeFiles :: st -> [Text]
  addIncludeFile :: Text -> st -> st
  dropLatestIncludeFile :: st -> st

-- | Add a log message.
logMessage :: (Stream s m a, HasLogMessages st)
           => LogMessage -> ParsecT s st m ()
logMessage :: forall s (m :: * -> *) a st.
(Stream s m a, HasLogMessages st) =>
LogMessage -> ParsecT s st m ()
logMessage LogMessage
msg = (st -> st) -> ParsecT s st m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (LogMessage -> st -> st
forall st. HasLogMessages st => LogMessage -> st -> st
addLogMessage LogMessage
msg)

-- | Report all the accumulated log messages, according to verbosity level.
reportLogMessages :: (PandocMonad m, HasLogMessages st) => ParsecT s st m ()
reportLogMessages :: forall (m :: * -> *) st s.
(PandocMonad m, HasLogMessages st) =>
ParsecT s st m ()
reportLogMessages = do
  [LogMessage]
msgs <- st -> [LogMessage]
forall st. HasLogMessages st => st -> [LogMessage]
getLogMessages (st -> [LogMessage])
-> ParsecT s st m st -> ParsecT s st m [LogMessage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m st
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  (LogMessage -> ParsecT s st m ())
-> [LogMessage] -> ParsecT s st m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LogMessage -> ParsecT s st m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report [LogMessage]
msgs

-- | Succeed only if the extension is enabled.
guardEnabled :: (Stream s m a,  HasReaderOptions st)
             => Extension -> ParsecT s st m ()
guardEnabled :: forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardEnabled Extension
ext =
  (ReaderOptions -> Extensions) -> ParsecT s st m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
forall s (m :: * -> *) t b.
Stream s m t =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions ParsecT s st m Extensions
-> (Extensions -> ParsecT s st m ()) -> ParsecT s st m ()
forall a b.
ParsecT s st m a -> (a -> ParsecT s st m b) -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT s st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT s st m ())
-> (Extensions -> Bool) -> Extensions -> ParsecT s st m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> Extensions -> Bool
extensionEnabled Extension
ext

-- | Succeed only if the extension is disabled.
guardDisabled :: (Stream s m a, HasReaderOptions st)
              => Extension -> ParsecT s st m ()
guardDisabled :: forall s (m :: * -> *) a st.
(Stream s m a, HasReaderOptions st) =>
Extension -> ParsecT s st m ()
guardDisabled Extension
ext =
  (ReaderOptions -> Extensions) -> ParsecT s st m Extensions
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParsecT s st m b
forall s (m :: * -> *) t b.
Stream s m t =>
(ReaderOptions -> b) -> ParsecT s st m b
getOption ReaderOptions -> Extensions
readerExtensions ParsecT s st m Extensions
-> (Extensions -> ParsecT s st m ()) -> ParsecT s st m ()
forall a b.
ParsecT s st m a -> (a -> ParsecT s st m b) -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT s st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT s st m ())
-> (Extensions -> Bool) -> Extensions -> ParsecT s st m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (Extensions -> Bool) -> Extensions -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> Extensions -> Bool
extensionEnabled Extension
ext

-- | Update the position on which the last string ended.
updateLastStrPos :: (Stream s m a, HasLastStrPosition st)
                 => ParsecT s st m ()
updateLastStrPos :: forall s (m :: * -> *) a st.
(Stream s m a, HasLastStrPosition st) =>
ParsecT s st m ()
updateLastStrPos = ParsecT s st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition ParsecT s st m SourcePos
-> (SourcePos -> ParsecT s st m ()) -> ParsecT s st m ()
forall a b.
ParsecT s st m a -> (a -> ParsecT s st m b) -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (st -> st) -> ParsecT s st m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((st -> st) -> ParsecT s st m ())
-> (SourcePos -> st -> st) -> SourcePos -> ParsecT s st m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SourcePos -> st -> st
forall st. HasLastStrPosition st => Maybe SourcePos -> st -> st
setLastStrPos (Maybe SourcePos -> st -> st)
-> (SourcePos -> Maybe SourcePos) -> SourcePos -> st -> st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just

-- | Whether we are right after the end of a string.
notAfterString :: (Stream s m a, HasLastStrPosition st) => ParsecT s st m Bool
notAfterString :: forall s (m :: * -> *) a st.
(Stream s m a, HasLastStrPosition st) =>
ParsecT s st m Bool
notAfterString = do
  SourcePos
pos <- ParsecT s st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  st
st  <- ParsecT s st m st
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool -> ParsecT s st m Bool
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ParsecT s st m Bool) -> Bool -> ParsecT s st m Bool
forall a b. (a -> b) -> a -> b
$ st -> Maybe SourcePos
forall st. HasLastStrPosition st => st -> Maybe SourcePos
getLastStrPos st
st Maybe SourcePos -> Maybe SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
/= SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just SourcePos
pos

data QuoteContext
    = InSingleQuote   -- ^ Used when parsing inside single quotes
    | InDoubleQuote   -- ^ Used when parsing inside double quotes
    | NoQuote         -- ^ Used when not parsing inside quotes
    deriving (QuoteContext -> QuoteContext -> Bool
(QuoteContext -> QuoteContext -> Bool)
-> (QuoteContext -> QuoteContext -> Bool) -> Eq QuoteContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QuoteContext -> QuoteContext -> Bool
== :: QuoteContext -> QuoteContext -> Bool
$c/= :: QuoteContext -> QuoteContext -> Bool
/= :: QuoteContext -> QuoteContext -> Bool
Eq, Int -> QuoteContext -> ShowS
[QuoteContext] -> ShowS
QuoteContext -> String
(Int -> QuoteContext -> ShowS)
-> (QuoteContext -> String)
-> ([QuoteContext] -> ShowS)
-> Show QuoteContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QuoteContext -> ShowS
showsPrec :: Int -> QuoteContext -> ShowS
$cshow :: QuoteContext -> String
show :: QuoteContext -> String
$cshowList :: [QuoteContext] -> ShowS
showList :: [QuoteContext] -> ShowS
Show)