diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,27 @@ `jira-wiki-markup` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +1.3.0 +----- + +Released 2020-04-04 + +* Support was added for additional syntax constructs: + + - citation markup (`??citation??`), + - links to attachments (`[title^attachment.ext]`), and + - user links (`[~username]`). + +* Changes to module `Text.Jira.Markup`: + + * A new data type `LinkType` is exported from the module. + + * Changes to type `Inline`: + + - a new constructor `Citation` has been added; + - the `Link` constructor now takes an additional + parameter of type `LinkType`. + 1.2.1 ----- 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.2.1 +version: 1.3.0 synopsis: Handle Jira wiki markup description: Parse jira wiki text into an abstract syntax tree for easy transformation to other formats. diff --git a/src/Text/Jira/Markup.hs b/src/Text/Jira/Markup.hs --- a/src/Text/Jira/Markup.hs +++ b/src/Text/Jira/Markup.hs @@ -15,6 +15,7 @@ , Block (..) , Inline (..) , InlineStyle (..) + , LinkType (..) , ListStyle (..) , URL (..) , ColorName (..) @@ -37,12 +38,13 @@ data Inline = Anchor Text -- ^ anchor for internal links | AutoLink URL -- ^ URL which is also a link + | Citation [Inline] -- ^ source of a citation | ColorInline ColorName [Inline] -- ^ colored inline text | Emoji Icon -- ^ emoticon | Entity Text -- ^ named or numeric HTML entity | Image [Parameter] URL -- ^ an image | Linebreak -- ^ hard linebreak - | Link [Inline] URL -- ^ hyperlink with alias + | Link LinkType [Inline] URL -- ^ hyperlink with alias | Monospaced [Inline] -- ^ text rendered with monospaced font | Space -- ^ space between words | SpecialChar Char -- ^ single char with special meaning @@ -58,6 +60,14 @@ | Strong -- ^ strongly emphasized text | Subscript -- ^ subscript text | Superscript -- ^ superscript text + deriving (Eq, Ord, Show) + +-- | Type of a link. +data LinkType + = Attachment -- ^ link to an attachment + | Email -- ^ link to an email address + | External -- ^ external resource, like a website + | User -- ^ link to a user deriving (Eq, Ord, Show) -- | Blocks of text. 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 @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} {-| Module : Text.Jira.Parser.Inline Copyright : © 2019–2020 Albert Krewinkel @@ -16,6 +17,7 @@ -- * Inline component parsers , anchor , autolink + , citation , colorInline , dash , emoji @@ -60,6 +62,7 @@ , colorInline , monospaced , anchor + , citation , entity , specialChar ] "inline" @@ -68,7 +71,7 @@ -- | Characters which, depending on context, can have a special meaning. specialChars :: String -specialChars = "_+-*^~|[]{}(!&\\:;" +specialChars = "_+-*^~|[]{}(?!&\\:;" -- | Parses an in-paragraph newline as a @Linebreak@ element. Both newline -- characters and double-backslash are recognized as line-breaks. @@ -130,7 +133,7 @@ return $ if b then All . (/= '|') else mempty inLinkPred <- do b <- stateInLink <$> getState - return $ if b then All . (`notElem` ("]|\n" :: String)) else mempty + return $ if b then All . (`notElem` ("]^|\n" :: String)) else mempty oneOf $ filter (getAll . (inTablePred <> inLinkPred)) specialChars @@ -164,13 +167,19 @@ guard . not . stateInLink =<< getState withStateFlag (\b st -> st { stateInLink = b }) $ do _ <- char '[' - alias <- option [] $ try (many inline <* char '|') - linkUrl <- email <|> url + (alias, sep) <- option ([], '|') . try $ (,) <$> many inline <*> oneOf "^|" + (linkType, linkURL) <- if sep == '|' + then (Email,) <$> email <|> + (External,) <$> url <|> + (User,) <$> userLink + else (Attachment,) . URL . pack <$> many1 urlChar _ <- char ']' - return $ Link alias linkUrl + return $ Link linkType alias linkURL +-- | Parse a plain URL or mail address as @'AutoLink'@ element. autolink :: JiraParser Inline -autolink = AutoLink <$> (email <|> url) "email or other URL" +autolink = AutoLink <$> (email' <|> url) "email or other URL" + where email' = (\(URL e) -> URL ("mailto:" <> e)) <$> email -- | Parse a URL with scheme @file@, @ftp@, @http@, @https@, @irc@, @nntp@, or -- @news@. @@ -190,11 +199,14 @@ 'n' -> ("nntp" <$ string "ntp") <|> ("news" <$ string "ews") _ -> fail "not looking at a known scheme" --- | Parses an E-mail URL. +-- | Parses an email URI, returns the mail address without schema. email :: JiraParser URL -email = URL . pack <$> try - ((++) <$> string "mailto:" <*> many1 urlChar) +email = URL . pack <$> try (string "mailto:" *> many1 urlChar) +-- | Parses a user-identifying resource name +userLink :: JiraParser URL +userLink = URL . pack <$> (char '~' *> many (noneOf "|]\n\r")) + -- | Parses a character which is allowed in URLs urlChar :: JiraParser Char urlChar = satisfy $ \c -> @@ -248,6 +260,11 @@ monospaced = Monospaced <$> enclosed (try $ string "{{") (try $ string "}}") inline "monospaced" + +citation :: JiraParser Inline +citation = Citation + <$> enclosed (try $ string "??") (try $ string "??") inline + "citation" -- -- Helpers diff --git a/src/Text/Jira/Printer.hs b/src/Text/Jira/Printer.hs --- a/src/Text/Jira/Printer.hs +++ b/src/Text/Jira/Printer.hs @@ -62,6 +62,9 @@ T.singleton c <> prettyInlines rest [SpecialChar c] | c `elem` [':', ';'] -> T.singleton c + -- Questionmarks don't have to be escaped unless in groups of two + SpecialChar '?' : rest | not (startsWithQuestionMark rest) -> + "?" <> prettyInlines rest (x:xs) -> renderInline x <> prettyInlines xs @@ -73,6 +76,10 @@ Str x | x `elem` ["D", ")", "(", "P"] -> True _ -> False + startsWithQuestionMark = \case + SpecialChar '?' : _ -> True + _ -> False + -- | Internal state used by the printer. data PrinterState = PrinterState { stateInTable :: Bool @@ -221,14 +228,15 @@ renderInline :: Inline -> Text renderInline = \case Anchor name -> "{anchor:" <> name <> "}" - AutoLink url -> urlText url + AutoLink url -> fromURL url + Citation ils -> "??" <> prettyInlines ils <> "??" ColorInline color ils -> "{color:" <> colorText color <> "}" <> prettyInlines ils <> "{color}" Emoji icon -> iconText icon Entity entity -> "&" <> entity <> ";" - Image ps url -> "!" <> urlText url <> renderImageParams ps <> "!" + Image ps url -> "!" <> fromURL url <> renderImageParams ps <> "!" Linebreak -> "\n" - Link inlines (URL url) -> "[" <> prettyInlines inlines <> "|" <> url <> "]" + Link lt ils url -> renderLink lt ils url Monospaced inlines -> "{{" <> prettyInlines inlines <> "}}" Space -> " " SpecialChar c -> case c of @@ -243,6 +251,17 @@ let delim = T.pack ['{', delimiterChar style, '}'] in (delim <>) . (<> delim) . prettyInlines +renderLink :: LinkType -> [Inline] -> URL -> Text +renderLink linkType inlines url = case linkType of + Attachment -> "[" <> prettyInlines inlines <> "^" <> fromURL url <> "]" + Email -> link' $ "mailto:" <> fromURL url + External -> link' $ fromURL url + User -> link' $ "~" <> fromURL url + where + link' urlText = case inlines of + [] -> "[" <> urlText <> "]" + _ -> "[" <> prettyInlines inlines <> "|" <> urlText <> "]" + delimiterChar :: InlineStyle -> Char delimiterChar = \case Emphasis -> '_' @@ -251,10 +270,6 @@ Strikeout -> '-' Subscript -> '~' Superscript -> '^' - --- | Text rendering of an URL. -urlText :: URL -> Text -urlText (URL url) = url -- | Render image parameters (i.e., separate by comma). renderImageParams :: [Parameter] -> Text 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 @@ -228,24 +228,52 @@ Right (AutoLink (URL "mailto:nobody@test.invalid")) ] + , testGroup "citation" + [ testCase "name" $ + parseJira citation "??John Doe??" @?= + Right (Citation [Str "John", Space, Str "Doe"]) + + , testCase "with markup" $ + parseJira citation "??Jane *Example* Doe??" @?= + Right (Citation [ Str "Jane", Space, Styled Strong [Str "Example"] + , Space, Str "Doe"]) + ] + , testGroup "link" [ testCase "unaliased link" $ parseJira link "[https://example.org]" @?= - Right (Link [] (URL "https://example.org")) + Right (Link External [] (URL "https://example.org")) , testCase "aliased link" $ parseJira link "[Example|https://example.org]" @?= - Right (Link [Str "Example"] (URL "https://example.org")) + Right (Link External [Str "Example"] (URL "https://example.org")) , testCase "alias with emphasis" $ parseJira link "[_important_ example|https://example.org]" @?= - Right (Link [Styled Emphasis [Str "important"], Space, Str "example"] + Right (Link External + [Styled Emphasis [Str "important"], Space, Str "example"] (URL "https://example.org")) , testCase "mail address" $ parseJira link "[send mail|mailto:me@nope.invalid]" @?= - Right (Link [Str "send", Space, Str "mail"] - (URL "mailto:me@nope.invalid")) + Right (Link Email [Str "send", Space, Str "mail"] + (URL "me@nope.invalid")) + + , testCase "attachment link" $ + parseJira link "[testing^test.xml]" @?= + Right (Link Attachment [Str "testing"] (URL "test.xml")) + + , testCase "attachment without description" $ + parseJira link "[^results.txt]" @?= + Right (Link Attachment [] (URL "results.txt")) + + , testCase "user link" $ + parseJira link "[testing|~account-id:something]" @?= + Right (Link User [Str "testing"] (URL "account-id:something")) + + , testCase "user without description" $ + parseJira link "[~username]" @?= + Right (Link User [] (URL "username")) ] , testGroup "image" diff --git a/test/Text/Jira/PrinterTests.hs b/test/Text/Jira/PrinterTests.hs --- a/test/Text/Jira/PrinterTests.hs +++ b/test/Text/Jira/PrinterTests.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module : Text.Jira.PrinterTests Copyright : © 2019–2020 Albert Krewinkel @@ -12,7 +13,8 @@ module Text.Jira.PrinterTests (tests) where import Prelude hiding (unlines) -import Data.Text (Text, unlines) +import Data.String (IsString (fromString)) +import Data.Text (Text, pack, unlines) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) import Text.Jira.Markup @@ -116,6 +118,10 @@ renderInline (AutoLink (URL "https://example.org")) @?= "https://example.org" + , testCase "citation" $ + renderInline (Citation [Str "John", Space, Str "Doe"]) @?= + "??John Doe??" + , testCase "Emoji" $ renderInline (Emoji IconSmiling) @?= ":D" @@ -128,6 +134,28 @@ in renderInline (Image params (URL "example.jpg")) @?= "!example.jpg|align=right, vspace=4!" + , testGroup "link" + [ testCase "external link" $ + renderInline (Link External [Str "example"] "https://example.org") @?= + "[example|https://example.org]" + + , testCase "email link" $ + renderInline (Link Email [Str "example"] "me@example.org") @?= + "[example|mailto:me@example.org]" + + , testCase "attachment" $ + renderInline (Link Attachment [Str "a", Space, Str "b"] "test.txt") @?= + "[a b^test.txt]" + + , testCase "attachment without description" $ + renderInline (Link Attachment [] "something.txt") @?= + "[^something.txt]" + + , testCase "user" $ + renderInline (Link User [Str "John", Space, Str "Doe"] "ab34-cdef") @?= + "[John Doe|~ab34-cdef]" + ] + , testCase "Styled Emphasis" $ renderInline (Styled Emphasis [Str "Hello,", Space, Str "World!"]) @?= "_Hello, World!_" @@ -176,8 +204,21 @@ -- escaping the paren is enough prettyInlines [SpecialChar ':', SpecialChar '('] @?= ":\\(" + + , testGroup "question marks" + [ testCase "escaped if followed by question mark" $ + prettyInlines [SpecialChar '?', SpecialChar '?'] @?= + "\\??" + + , testCase "unescaped before space" $ + prettyInlines [SpecialChar '?', Space, Str "foo"] @?= + "? foo" + ] ] ] renderBlock' :: Block -> Text renderBlock' = withDefault . renderBlock + +instance IsString URL where + fromString = URL . pack