module Text.Jira.Parser.Core
(
JiraParser
, ParserState (..)
, defaultState
, parseJira
, withStateFlag
, updateLastStrPos
, updateLastSpcPos
, notAfterString
, afterString
, afterSpace
, 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
type JiraParser = Parsec Text ParserState
data ParserState = ParserState
{ ParserState -> Bool
stateInLink :: Bool
, ParserState -> Bool
stateInList :: Bool
, ParserState -> Bool
stateInMarkup :: Bool
, ParserState -> Bool
stateInTable :: Bool
, ParserState -> Maybe SourcePos
stateLastSpcPos :: Maybe SourcePos
, ParserState -> Maybe SourcePos
stateLastStrPos :: Maybe SourcePos
}
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
}
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
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 }
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 }
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)
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
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)
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
""
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
' ')
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
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
'}'))
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)
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"]
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)