diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,22 @@ `jira-wiki-markup` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +1.3.1 +----- + +Released 2020-06-14 + +* Added support for links to anchors. + +* Styled text may not wrap across multiple lines; linebreaks in + marked-up text are now forbidden. + +* Module Text.Jira.Parser.Core: new function `many1Till` which + behaves like `manyTill`, but requires at least on element to be + parsed. + +* Ensured the package works with GHC 8.10. + 1.3.0 ----- diff --git a/jira-wiki-markup.cabal b/jira-wiki-markup.cabal --- a/jira-wiki-markup.cabal +++ b/jira-wiki-markup.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: jira-wiki-markup -version: 1.3.0 +version: 1.3.1 synopsis: Handle Jira wiki markup description: Parse jira wiki text into an abstract syntax tree for easy transformation to other formats. @@ -20,6 +20,7 @@ , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.3 + , GHC == 8.10.1 source-repository head type: git @@ -47,6 +48,8 @@ -Wcompat -Widentities -Wredundant-constraints + if impl(ghc >= 8.4) + ghc-options: -fhide-source-paths default-language: Haskell2010 default-extensions: OverloadedStrings @@ -68,6 +71,8 @@ -Wcompat -Widentities -Wredundant-constraints + if impl(ghc >= 8.4) + ghc-options: -fhide-source-paths default-language: Haskell2010 default-extensions: OverloadedStrings @@ -97,6 +102,8 @@ -Wcompat -Widentities -Wredundant-constraints + if impl(ghc >= 8.4) + ghc-options: -fhide-source-paths default-language: Haskell2010 default-extensions: OverloadedStrings diff --git a/src/Text/Jira/Parser/Core.hs b/src/Text/Jira/Parser/Core.hs --- a/src/Text/Jira/Parser/Core.hs +++ b/src/Text/Jira/Parser/Core.hs @@ -26,6 +26,7 @@ -- * Parsing helpers , endOfPara , notFollowedBy' + , many1Till , blankline , skipSpaces , blockNames @@ -44,6 +45,7 @@ data ParserState = ParserState { stateInLink :: Bool -- ^ whether the parser is within a link , stateInList :: Bool -- ^ whether the parser is within a list + , stateInMarkup :: Bool -- ^ whether the parser is within markup , stateInTable :: Bool -- ^ whether the parser is within a table , stateLastSpcPos :: Maybe SourcePos -- ^ most recent space char position , stateLastStrPos :: Maybe SourcePos -- ^ position at which the last string @@ -55,6 +57,7 @@ defaultState = ParserState { stateInLink = False , stateInList = False + , stateInMarkup = False , stateInTable = False , stateLastSpcPos = Nothing , stateLastStrPos = Nothing @@ -130,6 +133,17 @@ key = pack <$> many1 (noneOf "\"'\t\n\r |{}=") value = pack <$> many1 (noneOf "\"'\n\r|{}=") language = key <* (pipe <|> lookAhead (char '}')) + +-- | Like @manyTill@, but reads at least one item. +many1Till :: (Show end) + => JiraParser a + -> JiraParser end + -> JiraParser [a] +many1Till p end = do + notFollowedBy' end + first <- p + rest <- manyTill p end + return (first:rest) -- | Succeeds if the parser is looking at the end of a paragraph. endOfPara :: JiraParser () diff --git a/src/Text/Jira/Parser/Inline.hs b/src/Text/Jira/Parser/Inline.hs --- a/src/Text/Jira/Parser/Inline.hs +++ b/src/Text/Jira/Parser/Inline.hs @@ -76,12 +76,13 @@ -- | Parses an in-paragraph newline as a @Linebreak@ element. Both newline -- characters and double-backslash are recognized as line-breaks. linebreak :: JiraParser Inline -linebreak = Linebreak <$ try ( +linebreak = ( "linebreak") . try $ do + guard . not . stateInMarkup =<< getState choice [ void $ newline <* notFollowedBy' endOfPara , void $ string "\\\\" <* notFollowedBy' (char '\\') ] - <* updateLastSpcPos - ) "linebreak" + updateLastSpcPos + return Linebreak -- | Parses whitespace and return a @Space@ element. whitespace :: JiraParser Inline @@ -171,6 +172,7 @@ (linkType, linkURL) <- if sep == '|' then (Email,) <$> email <|> (External,) <$> url <|> + (External,) <$> anchorLink <|> (User,) <$> userLink else (Attachment,) . URL . pack <$> many1 urlChar _ <- char ']' @@ -203,6 +205,10 @@ email :: JiraParser URL email = URL . pack <$> try (string "mailto:" *> many1 urlChar) +-- | Parses the link to an anchor name. +anchorLink :: JiraParser URL +anchorLink = URL . pack <$> ((:) <$> char '#' <*> many1 urlChar) + -- | Parses a user-identifying resource name userLink :: JiraParser URL userLink = URL . pack <$> (char '~' *> many (noneOf "|]\n\r")) @@ -233,7 +239,7 @@ where simpleStyled = try $ do styleChar <- lookAhead $ oneOf "-_+*~^" - content <- styleChar `delimitingMany` inline + content <- noNewlines $ styleChar `delimitingMany` inline let style = delimiterStyle styleChar return $ Styled style content @@ -241,9 +247,14 @@ styleChar <- char '{' *> oneOf "-_+*~^" <* char '}' let closing = try $ string ['{', styleChar, '}'] let style = delimiterStyle styleChar - content <- manyTill inline closing + content <- noNewlines $ manyTill inline closing return $ Styled style content +-- | Makes sure that the wrapped parser does not parse inline +-- linebreaks. +noNewlines :: JiraParser a -> JiraParser a +noNewlines = withStateFlag (\b st -> st { stateInMarkup = b }) + -- | Returns the markup kind from the delimiting markup character. delimiterStyle :: Char -> InlineStyle delimiterStyle = \case @@ -274,12 +285,13 @@ delimitingMany :: Char -> JiraParser a -> JiraParser [a] delimitingMany c = enclosed (char c) (char c) -enclosed :: JiraParser opening -> JiraParser closing +enclosed :: Show closing + => JiraParser opening -> JiraParser closing -> JiraParser a -> JiraParser [a] enclosed opening closing parser = try $ do guard =<< notAfterString - opening *> notFollowedBy space *> manyTill parser closing' + opening *> notFollowedBy space *> many1Till parser closing' where closing' = try $ do guard . not =<< afterSpace diff --git a/test/Text/Jira/Parser/InlineTests.hs b/test/Text/Jira/Parser/InlineTests.hs --- a/test/Text/Jira/Parser/InlineTests.hs +++ b/test/Text/Jira/Parser/InlineTests.hs @@ -164,6 +164,9 @@ , testCase "require word boundary after closing underscore" $ isLeft (parseJira styled "_nope_nope") @? "no boundary after closing" + , testCase "disallow newline in markup" $ + isLeft (parseJira styled "_eol\nnext line_") @? "newline in markup" + , testCase "zero with space as word boundary" $ parseJira ((,) <$> styled <*> str) "_yup_\8203next" @?= Right (Styled Emphasis [Str "yup"], Str "\8203next") @@ -254,6 +257,10 @@ [Styled Emphasis [Str "important"], Space, Str "example"] (URL "https://example.org")) + , testCase "link to anchor" $ + parseJira link "[see here|#there]" @?= + Right (Link External [Str "see", Space, Str "here"] (URL "#there")) + , testCase "mail address" $ parseJira link "[send mail|mailto:me@nope.invalid]" @?= Right (Link Email [Str "send", Space, Str "mail"] @@ -377,5 +384,11 @@ Right [ SpecialChar '-', Str ">" , Space, Str "step", Space , SpecialChar '-', Str ">" ] + + , testCase "long ascii arrow" $ + parseJira (many1 inline) "click --> done" @?= + Right [ Str "click", Space, SpecialChar '-', SpecialChar '-' + , Str ">", Space, Str "done"] + ] ]