{-|
Module      : Text.Jira.Parser.Core
Copyright   : © 2019–2023 Albert Krewinkel
License     : MIT

Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>
Stability   : alpha
Portability : portable

Core components of the Jira wiki markup parser.
-}
module Text.Jira.Parser.Core
  (
  -- * Jira parser and state
    JiraParser
  , ParserState (..)
  , defaultState
  , parseJira
  , withStateFlag
  -- * String position tracking
  , updateLastStrPos
  , updateLastSpcPos
  , notAfterString
  , afterString
  , afterSpace
  -- * Parsing helpers
  , endOfPara
  , notFollowedBy'
  , many1Till
  , blankline
  , skipSpaces
  , blockNames
  , parameters
  ) where

import Control.Monad (join, void)
import Data.Text (Text, pack)
import Text.Jira.Markup
import Text.Parsec

-- | Jira Parsec parser
type JiraParser = Parsec Text ParserState

-- | Parser state used to keep track of various parameteres.
data ParserState = ParserState
  { ParserState -> Bool
stateInLink      :: Bool            -- ^ whether the parser is within a link
  , ParserState -> Bool
stateInList      :: Bool            -- ^ whether the parser is within a list
  , ParserState -> Bool
stateInMarkup    :: Bool            -- ^ whether the parser is within markup
  , ParserState -> Bool
stateInTable     :: Bool            -- ^ whether the parser is within a table
  , ParserState -> Maybe SourcePos
stateLastSpcPos  :: Maybe SourcePos -- ^ most recent space char position
  , ParserState -> Maybe SourcePos
stateLastStrPos  :: Maybe SourcePos -- ^ position at which the last string
                                        --   ended
  }

-- | Default parser state (i.e., start state)
defaultState :: ParserState
defaultState :: ParserState
defaultState = ParserState
  { stateInLink :: Bool
stateInLink      = Bool
False
  , stateInList :: Bool
stateInList      = Bool
False
  , stateInMarkup :: Bool
stateInMarkup    = Bool
False
  , stateInTable :: Bool
stateInTable     = Bool
False
  , stateLastSpcPos :: Maybe SourcePos
stateLastSpcPos  = forall a. Maybe a
Nothing
  , stateLastStrPos :: Maybe SourcePos
stateLastStrPos  = forall a. Maybe a
Nothing
  }

-- | Set a flag in the parser to @True@ before running a parser, then
-- set the flag's value to @False@.
withStateFlag :: (Bool -> ParserState -> ParserState)
              -> JiraParser a
              -> JiraParser a
withStateFlag :: forall a.
(Bool -> ParserState -> ParserState)
-> JiraParser a -> JiraParser a
withStateFlag Bool -> ParserState -> ParserState
flagSetter JiraParser a
parser = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$
  let setFlag :: Bool -> ParsecT s ParserState Identity ()
setFlag = forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ParserState -> ParserState
flagSetter
  in forall {s}. Bool -> ParsecT s ParserState Identity ()
setFlag Bool
True forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> JiraParser a
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall {s}. Bool -> ParsecT s ParserState Identity ()
setFlag Bool
False

-- | Updates the state, marking the current input position as the end of a
-- string.
updateLastStrPos :: JiraParser ()
updateLastStrPos :: JiraParser ()
updateLastStrPos = do
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st { stateLastStrPos :: Maybe SourcePos
stateLastStrPos = forall a. a -> Maybe a
Just SourcePos
pos }

-- | Updates the state, marking the current input position as the end of a
-- string.
updateLastSpcPos :: JiraParser ()
updateLastSpcPos :: JiraParser ()
updateLastSpcPos = do
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState forall a b. (a -> b) -> a -> b
$ \ParserState
st -> ParserState
st { stateLastSpcPos :: Maybe SourcePos
stateLastSpcPos = forall a. a -> Maybe a
Just SourcePos
pos }

-- | Returns @'True'@ if the current parser position is directly
-- after a word/string. Returns @'False'@ if the parser is
-- looking at the first character of the input.
afterString :: JiraParser Bool
afterString :: JiraParser Bool
afterString = do
  SourcePos
curPos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Maybe SourcePos
prevPos <- ParserState -> Maybe SourcePos
stateLastStrPos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just SourcePos
curPos forall a. Eq a => a -> a -> Bool
== Maybe SourcePos
prevPos)

-- | Returns true when the current parser position is either at
-- the beginning of the document or if the preceding characters
-- did not belong to a string.
notAfterString :: JiraParser Bool
notAfterString :: JiraParser Bool
notAfterString = Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JiraParser Bool
afterString

-- | Returns @'True'@ iff the character before the current parser
-- position was a space.
afterSpace :: JiraParser Bool
afterSpace :: JiraParser Bool
afterSpace = do
  SourcePos
curPos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Maybe SourcePos
lastSpacePos <- ParserState -> Maybe SourcePos
stateLastSpcPos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just SourcePos
curPos forall a. Eq a => a -> a -> Bool
== Maybe SourcePos
lastSpacePos)

-- | Parses a string with the given Jira parser.
parseJira :: JiraParser a -> Text -> Either ParseError a
parseJira :: forall a. JiraParser a -> Text -> Either ParseError a
parseJira JiraParser a
parser = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> SourceName -> s -> Either ParseError a
runParser JiraParser a
parser ParserState
defaultState SourceName
""

-- | Skip zero or more space chars.
skipSpaces :: JiraParser ()
skipSpaces :: JiraParser ()
skipSpaces = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')

-- | Parses an empty line, i.e., a line with no chars or whitespace only.
blankline :: JiraParser ()
blankline :: JiraParser ()
blankline = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ JiraParser ()
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline

-- | Parses a set of panel parameters
parameters :: JiraParser (Maybe Text, [Parameter])
parameters :: JiraParser (Maybe Text, [Parameter])
parameters = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (forall a. Maybe a
Nothing, []) forall a b. (a -> b) -> a -> b
$ do
  Char
_      <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  Maybe Text
lang   <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall {u}. ParsecT Text u Identity Text
language)
  [Parameter]
params <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text -> Text -> Parameter
Parameter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT Text u Identity Text
key forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {u}. ParsecT Text u Identity Text
value)) forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` forall {u}. ParsecT Text u Identity Char
pipe
  forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
lang, [Parameter]
params)
  where
    pipe :: ParsecT Text u Identity Char
pipe     = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
    key :: ParsecT Text u Identity Text
key      = SourceName -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
noneOf SourceName
"\"'\t\n\r |{}=")
    value :: ParsecT Text u Identity Text
value    = SourceName -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
noneOf SourceName
"\"'\n\r|{}=")
    language :: ParsecT Text u Identity Text
language = forall {u}. ParsecT Text u Identity Text
key forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (forall {u}. ParsecT Text u Identity Char
pipe forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'))

-- | Like @manyTill@, but reads at least one item.
many1Till :: (Show end)
          => JiraParser a
          -> JiraParser end
          -> JiraParser [a]
many1Till :: forall end a.
Show end =>
JiraParser a -> JiraParser end -> JiraParser [a]
many1Till JiraParser a
p JiraParser end
end = do
  forall a. Show a => JiraParser a -> JiraParser ()
notFollowedBy' JiraParser end
end
  a
first <- JiraParser a
p
  [a]
rest <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill JiraParser a
p JiraParser end
end
  forall (m :: * -> *) a. Monad m => a -> m a
return (a
firstforall a. a -> [a] -> [a]
:[a]
rest)

-- | Succeeds if the parser is looking at the end of a paragraph.
endOfPara :: JiraParser ()
endOfPara :: JiraParser ()
endOfPara = forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead JiraParser ()
blankline
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall {u}. ParsecT Text u Identity ()
headerStart
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall {u}. ParsecT Text u Identity ()
quoteStart
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead JiraParser ()
horizontalRule
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead JiraParser ()
listItemStart
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead JiraParser ()
tableStart
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall {u}. ParsecT Text u Identity ()
panelStart
  where
    headerStart :: ParsecT Text u Identity ()
headerStart    = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'h' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
oneOf SourceName
"123456" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
    quoteStart :: ParsecT Text u Identity ()
quoteStart     = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
"bq."
    listItemStart :: JiraParser ()
listItemStart  = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ JiraParser ()
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
oneOf SourceName
"#*-") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
    tableStart :: JiraParser ()
tableStart     = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ JiraParser ()
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|')
    panelStart :: ParsecT Text u Identity ()
panelStart     = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (forall a b. (a -> b) -> [a] -> [b]
map (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string) [SourceName]
blockNames)
    horizontalRule :: JiraParser ()
horizontalRule = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
"----") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> JiraParser ()
blankline

blockNames :: [String]
blockNames :: [SourceName]
blockNames = [SourceName
"code", SourceName
"color", SourceName
"noformat", SourceName
"panel", SourceName
"quote"]

-- | Variant of parsec's @notFollowedBy@ function which properly fails even if
-- the given parser does not consume any input (like @eof@ does).
notFollowedBy' :: Show a => JiraParser a -> JiraParser ()
notFollowedBy' :: forall a. Show a => JiraParser a -> JiraParser ()
notFollowedBy' JiraParser a
p =
  let failIfSucceeds :: ParsecT Text ParserState Identity (ParsecT Text u Identity a)
failIfSucceeds = forall s (m :: * -> *) t u a.
Stream s m t =>
SourceName -> ParsecT s u m a
unexpected forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> SourceName
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try JiraParser a
p
      unitParser :: ParsecT Text ParserState Identity (JiraParser ())
unitParser = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return ())
  in forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (forall {u} {a}.
ParsecT Text ParserState Identity (ParsecT Text u Identity a)
failIfSucceeds forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text ParserState Identity (JiraParser ())
unitParser)