{- |
   Module      : Text.Pandoc.Readers.Org.Parsing
   Copyright   : Copyright (C) 2014-2021 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Org-mode parsing utilities.

Most functions are simply re-exports from @Text.Pandoc.Parsing@, some
functions are adapted to Org-mode specific functionality.
-}
module Text.Pandoc.Readers.Org.Parsing
  ( OrgParser
  , anyLine
  , anyLineNewline
  , indentWith
  , blanklines
  , newline
  , parseFromString
  , skipSpaces1
  , inList
  , withContext
  , getExportSetting
  , updateLastForbiddenCharPos
  , updateLastPreCharPos
  , orgArgKey
  , orgArgWord
  , orgArgWordChar
  , orgTagWord
  , orgTagWordChar
  -- * Re-exports from Text.Pandoc.Parser
  , ParserContext (..)
  , textStr
  , countChar
  , manyChar
  , many1Char
  , manyTillChar
  , many1Till
  , many1TillChar
  , notFollowedBy'
  , spaceChar
  , nonspaceChar
  , skipSpaces
  , blankline
  , enclosed
  , stringAnyCase
  , charsInBalanced
  , uri
  , withRaw
  , readWithM
  , guardEnabled
  , updateLastStrPos
  , notAfterString
  , ParserState (..)
  , registerHeader
  , QuoteContext (..)
  , singleQuoteStart
  , singleQuoteEnd
  , doubleQuoteStart
  , doubleQuoteEnd
  , dash
  , ellipses
  , citeKey
  , gridTableWith
  , insertIncludedFileF
  -- * Re-exports from Text.Pandoc.Parsec
  , runParser
  , runParserT
  , getInput
  , char
  , letter
  , digit
  , alphaNum
  , skipMany1
  , spaces
  , anyChar
  , satisfy
  , string
  , count
  , eof
  , noneOf
  , oneOf
  , lookAhead
  , notFollowedBy
  , many
  , many1
  , manyTill
  , (<|>)
  , (<?>)
  , choice
  , try
  , sepBy
  , sepBy1
  , sepEndBy1
  , endBy1
  , option
  , optional
  , optionMaybe
  , getState
  , updateState
  , SourcePos
  , getPosition
  ) where

import Data.Text (Text)
import Text.Pandoc.Readers.Org.ParserState

import Text.Pandoc.Parsing hiding (anyLine, blanklines, newline,
                                   parseFromString)
import qualified Text.Pandoc.Parsing as P

import Control.Monad (guard)
import Control.Monad.Reader (ReaderT)

-- | The parser used to read org files.
type OrgParser m = ParserT Text OrgParserState (ReaderT OrgParserLocal m)

--
-- Adaptions and specializations of parsing utilities
--

-- | Parse any line of text
anyLine :: Monad m => OrgParser m Text
anyLine :: OrgParser m Text
anyLine =
  OrgParser m Text
forall (m :: * -> *) st. Monad m => ParserT Text st m Text
P.anyLine
    OrgParser m Text
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
-> OrgParser m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall (m :: * -> *). Monad m => OrgParser m ()
updateLastPreCharPos
    OrgParser m Text
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
-> OrgParser m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall (m :: * -> *). Monad m => OrgParser m ()
updateLastForbiddenCharPos

-- | Like @'Text.Pandoc.Parsing'@, but resets the position of the last character
-- allowed before emphasised text.
parseFromString :: Monad m => OrgParser m a -> Text -> OrgParser m a
parseFromString :: OrgParser m a -> Text -> OrgParser m a
parseFromString OrgParser m a
parser Text
str' = do
  (OrgParserState -> OrgParserState)
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OrgParserState -> OrgParserState)
 -> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ())
-> (OrgParserState -> OrgParserState)
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall a b. (a -> b) -> a -> b
$ \OrgParserState
s -> OrgParserState
s{ orgStateLastPreCharPos :: Maybe SourcePos
orgStateLastPreCharPos = Maybe SourcePos
forall a. Maybe a
Nothing }
  a
result <- OrgParser m a -> Text -> OrgParser m a
forall s (m :: * -> *) st r.
(Stream s m Char, IsString s) =>
ParserT s st m r -> Text -> ParserT s st m r
P.parseFromString OrgParser m a
parser Text
str'
  (OrgParserState -> OrgParserState)
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OrgParserState -> OrgParserState)
 -> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ())
-> (OrgParserState -> OrgParserState)
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall a b. (a -> b) -> a -> b
$ \OrgParserState
s -> OrgParserState
s { orgStateLastPreCharPos :: Maybe SourcePos
orgStateLastPreCharPos = Maybe SourcePos
forall a. Maybe a
Nothing }
  a -> OrgParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Skip one or more tab or space characters.
skipSpaces1 :: Monad m => OrgParser m ()
skipSpaces1 :: OrgParser m ()
skipSpaces1 = ParsecT Text OrgParserState (ReaderT OrgParserLocal m) Char
-> OrgParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT Text OrgParserState (ReaderT OrgParserLocal m) Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
spaceChar

-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.
newline :: Monad m => OrgParser m Char
newline :: OrgParser m Char
newline =
  OrgParser m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
P.newline
       OrgParser m Char
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
-> OrgParser m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall (m :: * -> *). Monad m => OrgParser m ()
updateLastPreCharPos
       OrgParser m Char
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
-> OrgParser m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall (m :: * -> *). Monad m => OrgParser m ()
updateLastForbiddenCharPos

-- | Like @Text.Parsec.Char.blanklines@, but causes additional state changes.
blanklines :: Monad m => OrgParser m Text
blanklines :: OrgParser m Text
blanklines =
  OrgParser m Text
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Text
P.blanklines
       OrgParser m Text
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
-> OrgParser m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall (m :: * -> *). Monad m => OrgParser m ()
updateLastPreCharPos
       OrgParser m Text
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
-> OrgParser m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall (m :: * -> *). Monad m => OrgParser m ()
updateLastForbiddenCharPos

-- | Succeeds when we're in list context.
inList :: Monad m => OrgParser m ()
inList :: OrgParser m ()
inList = do
  ParserContext
ctx <- OrgParserState -> ParserContext
orgStateParserContext (OrgParserState -> ParserContext)
-> ParsecT
     Text OrgParserState (ReaderT OrgParserLocal m) OrgParserState
-> ParsecT
     Text OrgParserState (ReaderT OrgParserLocal m) ParserContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  Text OrgParserState (ReaderT OrgParserLocal m) OrgParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool -> OrgParser m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ParserContext
ctx ParserContext -> ParserContext -> Bool
forall a. Eq a => a -> a -> Bool
== ParserContext
ListItemState)

-- | Parse in different context
withContext :: Monad m
            => ParserContext -- ^ New parser context
            -> OrgParser m a   -- ^ Parser to run in that context
            -> OrgParser m a
withContext :: ParserContext -> OrgParser m a -> OrgParser m a
withContext ParserContext
context OrgParser m a
parser = do
  ParserContext
oldContext <- OrgParserState -> ParserContext
orgStateParserContext (OrgParserState -> ParserContext)
-> ParsecT
     Text OrgParserState (ReaderT OrgParserLocal m) OrgParserState
-> ParsecT
     Text OrgParserState (ReaderT OrgParserLocal m) ParserContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  Text OrgParserState (ReaderT OrgParserLocal m) OrgParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  (OrgParserState -> OrgParserState)
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OrgParserState -> OrgParserState)
 -> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ())
-> (OrgParserState -> OrgParserState)
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall a b. (a -> b) -> a -> b
$ \OrgParserState
s -> OrgParserState
s{ orgStateParserContext :: ParserContext
orgStateParserContext = ParserContext
context }
  a
result <- OrgParser m a
parser
  (OrgParserState -> OrgParserState)
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OrgParserState -> OrgParserState)
 -> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ())
-> (OrgParserState -> OrgParserState)
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall a b. (a -> b) -> a -> b
$ \OrgParserState
s -> OrgParserState
s{ orgStateParserContext :: ParserContext
orgStateParserContext = ParserContext
oldContext }
  a -> OrgParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

--
-- Parser state functions
--

-- | Get an export setting.
getExportSetting :: Monad m =>  (ExportSettings -> a) -> OrgParser m a
getExportSetting :: (ExportSettings -> a) -> OrgParser m a
getExportSetting ExportSettings -> a
s = ExportSettings -> a
s (ExportSettings -> a)
-> (OrgParserState -> ExportSettings) -> OrgParserState -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrgParserState -> ExportSettings
orgStateExportSettings (OrgParserState -> a)
-> ParsecT
     Text OrgParserState (ReaderT OrgParserLocal m) OrgParserState
-> OrgParser m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  Text OrgParserState (ReaderT OrgParserLocal m) OrgParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

-- | Set the current position as the last position at which a forbidden char
-- was found (i.e. a character which is not allowed at the inner border of
-- markup).
updateLastForbiddenCharPos :: Monad m => OrgParser m ()
updateLastForbiddenCharPos :: OrgParser m ()
updateLastForbiddenCharPos = ParsecT Text OrgParserState (ReaderT OrgParserLocal m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition ParsecT Text OrgParserState (ReaderT OrgParserLocal m) SourcePos
-> (SourcePos -> OrgParser m ()) -> OrgParser m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourcePos
p ->
  (OrgParserState -> OrgParserState) -> OrgParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OrgParserState -> OrgParserState) -> OrgParser m ())
-> (OrgParserState -> OrgParserState) -> OrgParser m ()
forall a b. (a -> b) -> a -> b
$ \OrgParserState
s -> OrgParserState
s{ orgStateLastForbiddenCharPos :: Maybe SourcePos
orgStateLastForbiddenCharPos = SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just SourcePos
p}

-- | Set the current parser position as the position at which a character was
-- seen which allows inline markup to follow.
updateLastPreCharPos :: Monad m => OrgParser m ()
updateLastPreCharPos :: OrgParser m ()
updateLastPreCharPos = ParsecT Text OrgParserState (ReaderT OrgParserLocal m) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition ParsecT Text OrgParserState (ReaderT OrgParserLocal m) SourcePos
-> (SourcePos -> OrgParser m ()) -> OrgParser m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourcePos
p ->
  (OrgParserState -> OrgParserState) -> OrgParser m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((OrgParserState -> OrgParserState) -> OrgParser m ())
-> (OrgParserState -> OrgParserState) -> OrgParser m ()
forall a b. (a -> b) -> a -> b
$ \OrgParserState
s -> OrgParserState
s{ orgStateLastPreCharPos :: Maybe SourcePos
orgStateLastPreCharPos = SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just SourcePos
p}

--
-- Org key-value parsing
--

-- | Read the key of a plist style key-value list.
orgArgKey :: Monad m => OrgParser m Text
orgArgKey :: OrgParser m Text
orgArgKey = OrgParser m Text -> OrgParser m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (OrgParser m Text -> OrgParser m Text)
-> OrgParser m Text -> OrgParser m Text
forall a b. (a -> b) -> a -> b
$
  ParserT Text OrgParserState (ReaderT OrgParserLocal m) ()
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m ()
skipSpaces ParserT Text OrgParserState (ReaderT OrgParserLocal m) ()
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) Char
-> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
             ParsecT Text OrgParserState (ReaderT OrgParserLocal m) Char
-> OrgParser m Text -> OrgParser m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text OrgParserState (ReaderT OrgParserLocal m) Char
-> OrgParser m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ParsecT Text OrgParserState (ReaderT OrgParserLocal m) Char
forall (m :: * -> *). Monad m => OrgParser m Char
orgArgWordChar

-- | Read the value of a plist style key-value list.
orgArgWord :: Monad m => OrgParser m Text
orgArgWord :: OrgParser m Text
orgArgWord = ParserT Text OrgParserState (ReaderT OrgParserLocal m) Char
-> OrgParser m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ParserT Text OrgParserState (ReaderT OrgParserLocal m) Char
forall (m :: * -> *). Monad m => OrgParser m Char
orgArgWordChar

-- | Chars treated as part of a word in plists.
orgArgWordChar :: Monad m => OrgParser m Char
orgArgWordChar :: OrgParser m Char
orgArgWordChar = OrgParser m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
alphaNum OrgParser m Char -> OrgParser m Char -> OrgParser m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> OrgParser m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"-_"

orgTagWord :: Monad m => OrgParser m Text
orgTagWord :: OrgParser m Text
orgTagWord = ParserT Text OrgParserState (ReaderT OrgParserLocal m) Char
-> OrgParser m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ParserT Text OrgParserState (ReaderT OrgParserLocal m) Char
forall (m :: * -> *). Monad m => OrgParser m Char
orgTagWordChar

orgTagWordChar :: Monad m => OrgParser m Char
orgTagWordChar :: OrgParser m Char
orgTagWordChar = OrgParser m Char
forall s (m :: * -> *) st. Stream s m Char => ParserT s st m Char
alphaNum OrgParser m Char -> OrgParser m Char -> OrgParser m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> OrgParser m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"@%#_"