module Text.Jira.Parser.Core
(
JiraParser
, ParserState (..)
, defaultState
, parseJira
, withStateFlag
, updateLastStrPos
, updateLastSpcPos
, notAfterString
, afterString
, afterSpace
, endOfPara
, notFollowedBy'
, 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
{ stateInLink :: Bool
, stateInList :: Bool
, stateInTable :: Bool
, stateLastSpcPos :: Maybe SourcePos
, stateLastStrPos :: Maybe SourcePos
}
defaultState :: ParserState
defaultState = ParserState
{ stateInLink = False
, stateInList = False
, stateInTable = False
, stateLastSpcPos = Nothing
, stateLastStrPos = Nothing
}
withStateFlag :: (Bool -> ParserState -> ParserState)
-> JiraParser a
-> JiraParser a
withStateFlag flagSetter parser = try $
let setFlag = modifyState . flagSetter
in setFlag True *> parser <* setFlag False
updateLastStrPos :: JiraParser ()
updateLastStrPos = do
pos <- getPosition
modifyState $ \st -> st { stateLastStrPos = Just pos }
updateLastSpcPos :: JiraParser ()
updateLastSpcPos = do
pos <- getPosition
modifyState $ \st -> st { stateLastSpcPos = Just pos }
afterString :: JiraParser Bool
afterString = do
curPos <- getPosition
prevPos <- stateLastStrPos <$> getState
return (Just curPos == prevPos)
notAfterString :: JiraParser Bool
notAfterString = not <$> afterString
afterSpace :: JiraParser Bool
afterSpace = do
curPos <- getPosition
lastSpacePos <- stateLastSpcPos <$> getState
return (Just curPos == lastSpacePos)
parseJira :: JiraParser a -> Text -> Either ParseError a
parseJira parser = runParser parser defaultState ""
skipSpaces :: JiraParser ()
skipSpaces = skipMany (char ' ')
blankline :: JiraParser ()
blankline = try $ skipSpaces *> void newline
parameters :: JiraParser (Maybe Text, [Parameter])
parameters = option (Nothing, []) $ do
_ <- char ':'
lang <- optionMaybe (try language)
params <- try (Parameter <$> key <*> (char '=' *> value)) `sepBy` pipe
return (lang, params)
where
pipe = char '|'
key = pack <$> many1 (noneOf "\"'\t\n\r |{}=")
value = pack <$> many1 (noneOf "\"'\n\r|{}=")
language = key <* (pipe <|> lookAhead (char '}'))
endOfPara :: JiraParser ()
endOfPara = eof
<|> lookAhead blankline
<|> lookAhead headerStart
<|> lookAhead quoteStart
<|> lookAhead horizontalRule
<|> lookAhead listItemStart
<|> lookAhead tableStart
<|> lookAhead panelStart
where
headerStart = void $ char 'h' *> oneOf "123456" <* char '.'
quoteStart = void $ string "bq."
listItemStart = void $ skipSpaces *> many1 (oneOf "#*-") <* char ' '
tableStart = void $ skipSpaces *> many1 (char '|')
panelStart = void $ char '{' *> choice (map (try . string) blockNames)
horizontalRule = void $ try (string "----") *> blankline
blockNames :: [String]
blockNames = ["code", "color", "noformat", "panel", "quote"]
notFollowedBy' :: Show a => JiraParser a -> JiraParser ()
notFollowedBy' p =
let failIfSucceeds = unexpected . show <$> try p
unitParser = return (return ())
in try $ join (failIfSucceeds <|> unitParser)