jira-wiki-markup 0.1.1 → 1.0.0

raw patch · 16 files changed

+1036/−172 lines, 16 filesdep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +28/−0
• README.md +5/−3
• jira-wiki-markup.cabal +11/−3
• src/Text/Jira/Markup.hs +95/−18
• src/Text/Jira/Parser.hs +10/−3
• src/Text/Jira/Parser/Block.hs +32/−22
• src/Text/Jira/Parser/Core.hs +23/−6
• src/Text/Jira/Parser/Inline.hs +119/−58
• src/Text/Jira/Parser/PlainText.hs +46/−0
• src/Text/Jira/Parser/Shared.hs +62/−0
• src/Text/Jira/Printer.hs +252/−0
• test/Text/Jira/Parser/BlockTests.hs +33/−4
• test/Text/Jira/Parser/InlineTests.hs +133/−55
• test/Text/Jira/ParserTests.hs +34/−0
• test/Text/Jira/PrinterTests.hs +151/−0
• test/jira-wiki-markup-test.hs +2/−0

@@ -3,6 +3,34 @@ `jira-wiki-markup` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +1.0.0+=====++Released 2019-12-17.++* Add `Doc` datatype representing a full document; `parse` now returns+  this type.+* Improve parsing:+  - double-backslash is recognized as linebreak;+  - emoticons are parsed as `Emoji`;+  - special sequences of dashes are translated into their unicode+    representation;+  - naked URLs are parsed as `AutoLink`;+  - blocks of colored text are parsed as `Color`;+  - interpretation of special characters as markup can be forced by+    surrounding them with curly braces.+* A parser `plainText` was added available to read markup-less text.+* *Inline*-parser `symbol` was renamed to `specialChar`.+* Add printer module to render the document AST as Jira markup.+* Markup datatype changes:+  - new *Block* elements `Color` and `HorizontalRule`.+  - new *Inline* elements `Emoji`, and `Styled`.+  - *Inline* constructors `Subscript`, `Superscript`, `Emph`, `Strong`,+    `Inserted`, and `Deleted` have been remove. Use `Styled` instead.+  - Constructor `Image` now takes a list of parameters as an additional+    argument.+* CI runs also test GHC 8.8.+ 0.1.1 ===== 

@@ -7,9 +7,11 @@ [![Build status](https://travis-ci.com/tarleb/jira-wiki-markup.svg?branch=master)](https://travis-ci.com/tarleb/jira-wiki-markup) [![Windows build status](https://ci.appveyor.com/api/projects/status/github/tarleb/jira-wiki-markup?branch=master&svg=true)](https://ci.appveyor.com/project/tarleb/jira-wiki-markup) -This package provides a parser for [Jira wiki markup]. It converts the-raw text into an abstract syntax tree. The tree is easy to handle and to-different to different output formats.+This package provides a parser and printer for [Jira wiki markup]. It+converts the raw text into an abstract syntax tree. The tree is easy to+handle and to translate into different output formats.++[Jira wiki markup]: https://jira.atlassian.com/secure/WikiRendererHelpAction.jspa?section=all  # License 

@@ -1,6 +1,6 @@ cabal-version:       2.0 name:                jira-wiki-markup-version:             0.1.1+version:             1.0.0 synopsis:            Handle Jira wiki markup description:         Parse jira wiki text into an abstract syntax tree for easy                      transformation to other formats.@@ -15,7 +15,11 @@ build-type:          Simple extra-doc-files:     README.md                    , CHANGELOG.md-tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.4+tested-with:         GHC == 8.0.2+                   , GHC == 8.2.2+                   , GHC == 8.4.4+                   , GHC == 8.6.4+                   , GHC == 8.8.1  source-repository head   type:                git@@ -28,8 +32,12 @@                      , Text.Jira.Parser.Block                      , Text.Jira.Parser.Core                      , Text.Jira.Parser.Inline+                     , Text.Jira.Parser.PlainText+                     , Text.Jira.Parser.Shared+                     , Text.Jira.Printer    build-depends:       base    >= 4.9   && < 5+                     , mtl     >= 2.2   && < 2.3                      , parsec  >= 3.1   && < 3.2                      , text    >= 1.1.1 && < 1.3 @@ -50,7 +58,6 @@   build-depends:       base    >= 4.9   && < 5                      , text    >= 1.1.1 && < 1.3                      , jira-wiki-markup-                         ghc-options:         -Wall                        -threaded@@ -72,6 +79,7 @@   other-modules:       Text.Jira.ParserTests                      , Text.Jira.Parser.BlockTests                      , Text.Jira.Parser.InlineTests+                     , Text.Jira.PrinterTests    build-depends:       base    >= 4.9   && < 5                      , jira-wiki-markup

@@ -11,42 +11,61 @@ Jira markup types. -} module Text.Jira.Markup-  ( Block (..)+  ( Doc (..)+  , Block (..)   , Inline (..)+  , InlineStyle (..)   , ListStyle (..)   , URL (..)+  , ColorName (..)+  , Icon (..)   , Row (..)   , Cell (..)   , Language (..)   , Parameter (..)   , normalizeInlines+  , iconText   ) where  import Data.Text (Text, append) +-- | Jira document+newtype Doc = Doc { fromDoc :: [Block] }+  deriving (Eq, Ord, Show)+ -- | Inline Jira markup elements. data Inline-  = Anchor Text              -- ^ anchor for internal links-  | Deleted [Inline]         -- ^ deleted (struk-out) text-  | Emph [Inline]            -- ^ emphasized text-  | Entity Text              -- ^ named or numeric HTML entity-  | Image URL                -- ^ an image-  | Inserted [Inline]        -- ^ text marked as having been inserted-  | Linebreak                -- ^ hard linebreak-  | Link [Inline] URL        -- ^ hyperlink with alias-  | Monospaced [Inline]      -- ^ text rendered with monospaced font-  | Str Text                 -- ^ simple, markup-less string-  | Space                    -- ^ space between words-  | Strong [Inline]          -- ^ strongly emphasized text-  | Subscript [Inline]       -- ^ subscript text-  | Superscript [Inline]     -- ^ superscript text+  = Anchor Text                         -- ^ anchor for internal links+  | AutoLink URL                        -- ^ URL which is also a link+  | Emoji Icon                          -- ^ emoticon+  | Entity Text                         -- ^ named or numeric HTML entity+  | Image [Parameter] URL               -- ^ an image+  | Linebreak                           -- ^ hard linebreak+  | Link [Inline] URL                   -- ^ hyperlink with alias+  | Monospaced [Inline]                 -- ^ text rendered with monospaced font+  | Space                               -- ^ space between words+  | SpecialChar Char                    -- ^ single char with special meaning+  | Str Text                            -- ^ simple, markup-less string+  | Styled InlineStyle [Inline]         -- ^ styled text   deriving (Eq, Ord, Show) +-- | Supported inline text effect styles.+data InlineStyle+  = Emphasis                            -- ^ emphasized text+  | Insert                              -- ^ text marked as having been inserted+  | Strikeout                           -- ^ deleted (struk-out) text+  | Strong                              -- ^ strongly emphasized text+  | Subscript                           -- ^ subscript text+  | Superscript                         -- ^ superscript text+  deriving (Eq, Ord, Show)+ -- | Blocks of text. data Block   = Code Language [Parameter] Text      -- ^ Code block with panel parameters+  | Color ColorName [Block]             -- ^ text displayed in a specific color   | BlockQuote [Block]                  -- ^ Block of quoted content   | Header Int [Inline]                 -- ^ Header with level and text+  | HorizontalRule                      -- ^ horizontal ruler   | List ListStyle [[Block]]            -- ^ List   | NoFormat [Parameter] Text           -- ^ Unformatted text   | Panel [Parameter] [Block]           -- ^ Formatted panel@@ -56,11 +75,15 @@  -- | Style used for list items. data ListStyle-  = CircleBullets            -- ^ List with round bullets-  | SquareBullets            -- ^ List with square bullets-  | Enumeration              -- ^ Enumeration, i.e., numbered items+  = CircleBullets                       -- ^ List with round bullets+  | SquareBullets                       -- ^ List with square bullets+  | Enumeration                         -- ^ Enumeration, i.e., numbered items   deriving (Eq, Ord, Show) +-- | Text color+newtype ColorName = ColorName Text+  deriving (Eq, Ord, Show)+ -- | Unified resource location newtype URL = URL { fromURL :: Text }   deriving (Eq, Ord, Show)@@ -85,6 +108,33 @@   , parameterValue :: Text   } deriving (Eq, Ord, Show) +-- | Graphical emoticons+data Icon+  = IconSlightlySmiling+  | IconFrowning+  | IconTongue+  | IconSmiling+  | IconWinking+  | IconThumbsUp+  | IconThumbsDown+  | IconInfo+  | IconCheckmark+  | IconX+  | IconAttention+  | IconPlus+  | IconMinus+  | IconQuestionmark+  | IconOn+  | IconOff+  | IconStar+  | IconStarRed+  | IconStarGreen+  | IconStarBlue+  | IconStarYellow+  | IconFlag+  | IconFlagOff+  deriving (Enum, Eq, Ord, Show)+ -- | Normalize a list of inlines, merging elements where possible. normalizeInlines :: [Inline] -> [Inline] normalizeInlines = \case@@ -96,3 +146,30 @@   Linebreak : Space : xs -> Linebreak : normalizeInlines xs   Str s1 : Str s2 : xs   -> Str (s1 `append` s2) : normalizeInlines xs   x : xs                 -> x : normalizeInlines xs++-- | Gets the characters used to represent an emoji.+iconText :: Icon -> Text+iconText = \case+  IconSlightlySmiling -> ":)"+  IconFrowning        -> ":("+  IconTongue          -> ":P"+  IconSmiling         -> ":D"+  IconWinking         -> ";)"+  IconThumbsUp        -> "(y)"+  IconThumbsDown      -> "(n)"+  IconInfo            -> "(i)"+  IconCheckmark       -> "(/)"+  IconX               -> "(x)"+  IconAttention       -> "(!)"+  IconPlus            -> "(+)"+  IconMinus           -> "(-)"+  IconQuestionmark    -> "(?)"+  IconOn              -> "(on)"+  IconOff             -> "(off)"+  IconStar            -> "(*)"+  IconStarRed         -> "(*r)"+  IconStarGreen       -> "(*g)"+  IconStarBlue        -> "(*b)"+  IconStarYellow      -> "(*y)"+  IconFlag            -> "(flag)"+  IconFlagOff         -> "(flagoff)"

@@ -11,10 +11,12 @@ -} module Text.Jira.Parser   ( parse+  , doc   , module Text.Jira.Markup   , module Text.Jira.Parser.Core   , module Text.Jira.Parser.Inline   , module Text.Jira.Parser.Block+  , module Text.Jira.Parser.PlainText   ) where  import Data.Text (Text)@@ -22,8 +24,13 @@ import Text.Jira.Parser.Block import Text.Jira.Parser.Core import Text.Jira.Parser.Inline+import Text.Jira.Parser.PlainText import Text.Parsec hiding (parse) --- | Parses a document into a list of blocks.-parse :: Text -> Either ParseError [Block]-parse = parseJira (many1 block)+-- | Parses a document into a Jira AST.+parse :: Text -> Either ParseError Doc+parse = parseJira doc++-- | Parses a list of jira blocks into a @'Doc'@ element.+doc :: JiraParser Doc+doc = Doc <$> many block <?> "doc"

@@ -14,7 +14,9 @@     -- * Parsers for block types   , blockQuote   , code+  , color   , header+  , horizontalRule   , list   , noformat   , panel@@ -37,9 +39,11 @@   , list   , table   , blockQuote+  , horizontalRule   , code   , noformat   , panel+  , color   , para   ] <* skipWhitespace @@ -47,8 +51,9 @@ para :: JiraParser Block para = (<?> "para") . try $ do   isInList <- stateInList <$> getState-  when isInList $+  when isInList $ do     notFollowedBy' blankline+    notFollowedBy' horizontalRule   Para . normalizeInlines <$> many1 inline  -- | Parses a header line into a @Header@.@@ -88,14 +93,14 @@     firstItemAtDepth :: Int -> JiraParser [Block]     firstItemAtDepth depth = try $ listContent (depth + 1) <|>       do-        blocks <- nonListContent+        blocks <- nonListContent depth         nestedLists <- try . many $ listAtDepth (depth + 1)         return $ blocks ++ nestedLists      listItemAtDepth :: Int -> JiraParser Char -> JiraParser [Block]     listItemAtDepth depth bulletChar = atDepth depth *>-        try (bulletChar *> nonListContent) <|>-        try (anyBulletMarker *> listContent depth)+      (try (bulletChar *> nonListContent depth) <|>+       try (anyBulletMarker *> listContent depth))      listContent :: Int -> JiraParser [Block]     listContent depth = do@@ -106,13 +111,14 @@     anyBulletMarker :: JiraParser Char     anyBulletMarker = oneOf "*-#" -    nonListContent :: JiraParser [Block]-    nonListContent = try $+    nonListContent :: Int -> JiraParser [Block]+    nonListContent depth = try $       let nonListBlock = notFollowedBy' (many1 (oneOf "#-*")) *> block       in char ' ' *> do-        first <- block-        rest  <- many nonListBlock-        return (first : rest)+        first   <- block+        nonList <- many nonListBlock+        lists   <- many (listAtDepth (depth + 1))+        return (first : nonList ++ lists)  -- | Parses a table into a @Table@ element. table :: JiraParser Block@@ -146,9 +152,12 @@ -- | Parses a code block into a @Code@ element. code :: JiraParser Block code = try $ do-  (lang, params) <- string "{code" *> parameters <* char '}' <* blankline+  (langName, params) <- string "{code" *> parameters <* char '}' <* blankline+  let lang = maybe defaultLanguage Language langName   content <- anyChar `manyTill` try (string "{code}" *> blankline)   return $ Code lang params (pack content)+  where+    defaultLanguage = Language (pack "java")  -- | Parses a block quote into a @'Quote'@ element. blockQuote :: JiraParser Block@@ -161,6 +170,11 @@                   (string "{quote}" *> optional blankline *>                    block `manyTill` try (string "{quote}")) +-- | Parses four consecutive hyphens as @'HorizontalRule'@.+horizontalRule :: JiraParser Block+horizontalRule = HorizontalRule <$+  try (string "----" *> blankline)+ -- | Parses a preformatted text into a @NoFormat@ element. noformat :: JiraParser Block noformat = try $ do@@ -175,19 +189,15 @@   content <- block `manyTill` try (string "{panel}" *> blankline)   return $ Panel params content --- | Parses a set of panel parameters-parameters :: JiraParser (Language, [Parameter])-parameters = option (defaultLanguage, []) $ do-  _      <- char ':'-  lang   <- option defaultLanguage (try language)-  params <- try (Parameter <$> key <*> (char '=' *> value)) `sepBy` pipe-  return (lang, params)+-- | Parses colored text into a @'Color'@ element.+color :: JiraParser Block+color= try $ do+  name <- string "{color:" *> (colorName <|> colorCode) <* char '}'+  content <- block `manyTill` try (string "{color}" *> blankline)+  return $ Color (ColorName $ pack name) content   where-    defaultLanguage = Language (pack "java")-    pipe     = char '|'-    key      = pack <$> many1 (noneOf "\"'\t\n\r |{}=")-    value    = pack <$> many1 (noneOf "\"'\n\r|{}=")-    language = Language <$> key <* (pipe <|> lookAhead (char '}'))+    colorName = many letter+    colorCode = optional (char '#') *> count 6 digit  -- | Skip whitespace till we reach the next block skipWhitespace :: JiraParser ()

@@ -26,10 +26,12 @@   , blankline   , skipSpaces   , blockNames+  , parameters   ) where  import Control.Monad (join, void)-import Data.Text (Text)+import Data.Text (Text, pack)+import Text.Jira.Markup import Text.Parsec  -- | Jira Parsec parser@@ -88,22 +90,37 @@ blankline :: JiraParser () blankline = try $ skipSpaces *> void newline +-- | Parses a set of panel parameters+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 '}'))+ -- | Succeeds if the parser is looking at the end of a paragraph. endOfPara :: JiraParser () endOfPara = eof   <|> lookAhead blankline   <|> lookAhead headerStart+  <|> lookAhead horizontalRule   <|> lookAhead listItemStart   <|> lookAhead tableStart   <|> lookAhead panelStart   where-    headerStart   = void $ char 'h' *> oneOf "123456" <* char '.'-    listItemStart = void $ many1 (oneOf "#*-") *> char ' '-    tableStart    = void $ skipSpaces *> many1 (char '|') *> char ' '-    panelStart    = void $ char '{' *> choice (map string blockNames)+    headerStart    = void $ char 'h' *> oneOf "123456" <* char '.'+    listItemStart  = void $ many1 (oneOf "#*-") <* char ' '+    tableStart     = void $ skipSpaces *> many1 (char '|') *> char ' '+    panelStart     = void $ char '{' *> choice (map (try . string) blockNames)+    horizontalRule = void $ try (string "----") *> blankline  blockNames :: [String]-blockNames = ["code", "noformat", "panel", "quote"]+blockNames = ["code", "color", "noformat", "panel", "quote"]  -- | Variant of parsec's @notFollowedBy@ function which properly fails even if -- the given parser does not consume any input (like @eof@ does).

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-| Module      : Text.Jira.Parser.Inline Copyright   : © 2019 Albert Krewinkel@@ -14,64 +16,67 @@   ( inline     -- * Inline component parsers   , anchor-  , deleted-  , emph+  , autolink+  , dash+  , emoji   , entity-  , inserted   , image   , linebreak   , link   , monospaced+  , specialChar   , str-  , strong-  , subscript-  , superscript-  , symbol+  , styled   , whitespace+    -- * Constants+  , specialChars   ) where  import Control.Monad (guard, void)-import Data.Char (isLetter)+import Data.Char (isLetter, isPunctuation, ord)+#if !MIN_VERSION_base(4,13,0) import Data.Monoid ((<>), All (..))-import Data.Text (pack, singleton)+#else+import Data.Monoid (All (..))+#endif+import Data.Text (append, pack) import Text.Jira.Markup import Text.Jira.Parser.Core+import Text.Jira.Parser.Shared import Text.Parsec  -- | Parses any inline element. inline :: JiraParser Inline inline = notFollowedBy' blockEnd *> choice   [ whitespace+  , emoji+  , dash+  , autolink   , str   , linebreak   , link   , image-  , emph-  , strong-  , subscript-  , superscript-  , deleted-  , inserted+  , styled   , monospaced   , anchor   , entity-  , symbol+  , specialChar   ] <?> "inline"   where     blockEnd = char '{' *> choice (map string blockNames) <* char '}' --- | Characters with a special meaning, i.e., those used for markup.+-- | Characters which, depending on context, can have a special meaning. specialChars :: String-specialChars = " \n" ++ symbolChars---- | Special characters which can be part of a string.-symbolChars :: String-symbolChars = "_+-*^~|[]{}!&\\"+specialChars = "_+-*^~|[]{}(!&\\" --- | Parses an in-paragraph newline as a @Linebreak@ element.+-- | 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 (newline <* notFollowedBy' endOfPara)-  <?> "linebreak"+linebreak = Linebreak <$ try (+  choice [ void $ newline <* notFollowedBy' endOfPara+         , void $ string "\\\\" <* notFollowedBy' (char '\\')+         ]+  ) <?> "linebreak"  -- | Parses whitespace and return a @Space@ element. whitespace :: JiraParser Inline@@ -81,9 +86,11 @@ str :: JiraParser Inline str = Str . pack <$> (alphaNums <|> otherNonSpecialChars) <?> "string"   where+    nonStrChars = " \n" ++ specialChars     alphaNums = many1 alphaNum <* updateLastStrPos-    otherNonSpecialChars = many1 (noneOf specialChars)+    otherNonSpecialChars = many1 (noneOf nonStrChars) + -- | Parses an HTML entity into an @'Entity'@ element. entity :: JiraParser Inline entity = Entity . pack@@ -92,21 +99,34 @@     numerical = (:) <$> char '#' <*> many1 digit     named = many1 letter +-- | Parses textual representation of an icon into an @'Emoji'@ element.+emoji :: JiraParser Inline+emoji = Emoji <$> icon <* notFollowedBy' letter <?> "emoji"++-- | Parses ASCII representation of en-dash or em-dash.+dash :: JiraParser Inline+dash = try $ do+  guard =<< notAfterString+  _ <- string "--"+  choice [ Str "—" <$ char '-'   -- em dash+         , pure (Str "–")          -- en dash+         ] <* lookAhead (void (char ' ') <|> eof)+ -- | Parses a special character symbol as a @Str@.-symbol :: JiraParser Inline-symbol = Str . singleton <$> (escapedChar <|> symbolChar)-  <?> "symbol"+specialChar :: JiraParser Inline+specialChar = SpecialChar <$> (escapedChar <|> plainSpecialChar)+  <?> "special char"   where-    escapedChar = try (char '\\' *> oneOf symbolChars)+    escapedChar = try (char '\\' *> satisfy isPunctuation) -    symbolChar = do+    plainSpecialChar = do       inTablePred <- do         b <- stateInTable <$> getState         return $ if b then All . (/= '|') else mempty       inLinkPred  <- do         b <- stateInLink  <$> getState         return $ if b then All . (`notElem` ("]|\n" :: String)) else mempty-      oneOf $ filter (getAll . (inTablePred <> inLinkPred)) symbolChars+      oneOf $ filter (getAll . (inTablePred <> inLinkPred)) specialChars   --@@ -120,8 +140,12 @@  -- | Parse image into an @Image@ element. image :: JiraParser Inline-image = fmap (Image . URL . pack) . try $-  char '!' *> noneOf "\r\t\n" `manyTill` char '!'+image = try $ do+  -- does not use @url@, as is may contain relative locations.+  src <- char '!' *> (URL . pack <$> many1 (noneOf "\r\t\n|]!"))+  (_, params) <- option (Nothing, []) (char '|' *> parameters)+  _ <- char '!'+  return $ Image params src  -- | Parse link into a @Link@ element. link :: JiraParser Inline@@ -129,43 +153,80 @@   guard . not . stateInLink =<< getState   withStateFlag (\b st -> st { stateInLink = b }) $ do     _ <- char '['-    alias <- option [] $ try (many inline <* char '|')-    url   <- URL . pack <$> many1 (noneOf "|] \n")+    alias   <- option [] $ try (many inline <* char '|')+    linkUrl <- email <|> url     _ <- char ']'-    return $ Link alias url+    return $ Link alias linkUrl +autolink :: JiraParser Inline+autolink = AutoLink <$> (email <|> url) <?> "email or other URL"++-- | Parse a URL with scheme @file@, @ftp@, @http@, @https@, @irc@, @nntp@, or+-- @news@.+url :: JiraParser URL+url = try $ do+  urlScheme <- scheme+  sep <- pack <$> string "://"+  rest <- pack <$> many urlChar+  return $ URL (urlScheme `append` sep `append` rest)+  where+    scheme = do+      first <- letter+      case first of+        'f' -> ("file" <$ string "ile") <|> ("ftp" <$ string "tp")+        'h' -> string "ttp" *> option "http" ("https" <$ char 's')+        'i' -> "irc" <$ string "rc"+        'n' -> ("nntp" <$ string "ntp") <|> ("news" <$ string "ews")+        _   -> fail "not looking at a known scheme"++-- | Parses an E-mail URL.+email :: JiraParser URL+email = URL . pack <$> try+  ((++) <$> string "mailto:" <*> many1 urlChar)++-- | Parses a character which is allowed in URLs+urlChar :: JiraParser Char+urlChar = satisfy $ \c ->+  c `notElem` ("|]" :: String) && ord c >= 32 && ord c <= 127++ -- -- Markup ----- | Parses deleted text into @Deleted@.-deleted :: JiraParser Inline-deleted = Deleted <$> ('-' `delimitingMany` inline) <?> "deleted" --- | Parses emphasized text into @Emph@.-emph :: JiraParser Inline-emph = Emph <$> ('_' `delimitingMany` inline) <?> "emphasis"+-- | Parses styled text+styled :: JiraParser Inline+styled = (simpleStyled <|> forceStyled) <?> "styled text"+  where+    simpleStyled = try $ do+      styleChar <- lookAhead $ oneOf "-_+*~^"+      content   <- styleChar `delimitingMany` inline+      let style = delimiterStyle styleChar+      return $ Styled style content --- | Parses inserted text into @Inserted@.-inserted :: JiraParser Inline-inserted = Inserted <$> ('+' `delimitingMany` inline) <?> "inserted"+    forceStyled = try $ do+      styleChar <- char '{' *> oneOf "-_+*~^" <* char '}'+      let closing = try $ string ['{', styleChar, '}']+      let style   = delimiterStyle styleChar+      content   <- manyTill inline closing+      return $ Styled style content +-- | Returns the markup kind from the delimiting markup character.+delimiterStyle :: Char -> InlineStyle+delimiterStyle = \case+  '*' -> Strong+  '+' -> Insert+  '-' -> Strikeout+  '^' -> Superscript+  '_' -> Emphasis+  '~' -> Subscript+  c   -> error ("Unknown delimiter character: " ++ [c])+ -- | Parses monospaced text into @Monospaced@. monospaced :: JiraParser Inline monospaced = Monospaced   <$> enclosed (try $ string "{{") (try $ string "}}") inline   <?> "monospaced"---- | Parses strongly emphasized text into @Strong@.-strong :: JiraParser Inline-strong = Strong <$> ('*' `delimitingMany` inline) <?> "strong"---- | Parses subscript text into @Subscript@.-subscript :: JiraParser Inline-subscript = Subscript <$> ('~' `delimitingMany` inline) <?> "subscript"---- | Parses superscript text into @Superscript@.-superscript :: JiraParser Inline-superscript = Superscript <$> ('^' `delimitingMany` inline) <?> "superscript"  -- -- Helpers

@@ -0,0 +1,46 @@+{-|+Module      : Text.Jira.Parser.PlainText+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+Stability   : alpha+Portability : portable++Functions for parsing markup-less strings.+-}++module Text.Jira.Parser.PlainText+  ( plainText+  ) where++import Data.Text (Text, append, pack)+import Text.Jira.Markup+import Text.Jira.Parser.Core+import Text.Jira.Parser.Inline (specialChars)+import Text.Jira.Parser.Shared (icon)+import Text.Parsec++-- | Parses into an @'Inline'@ elements which represent plain text. The+-- result consists of any number of @'Str'@, @'SpecialChar'@, or+-- @'Space'@ elements.+--+-- This parser can be used to convert un-escaped strings into proper+-- Jira markup elements.+plainText :: Text -> Either ParseError [Inline]+plainText = parseJira (normalizeInlines <$> many plainInlineParser)+  where+    plainInlineParser :: JiraParser Inline+    plainInlineParser = choice+      [ Space <$ skipMany1 (char ' ')+      , escapeIcon+      , plainSpecialChar+      , Str . pack <$> many1 (noneOf (' ':specialChars))+      ] <?> "text-only inline"++-- | Escapes text which would otherwise render as an icon.+escapeIcon :: Parsec Text u Inline+escapeIcon = Str . ("\\" `append`) . iconText <$> icon++plainSpecialChar :: Parsec Text u Inline+plainSpecialChar = SpecialChar <$> oneOf specialChars

@@ -0,0 +1,62 @@+{-# LANGUAGE LambdaCase #-}+{-|+Module      : Text.Jira.Parser.Shared+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+Stability   : alpha+Portability : portable++Parsers whch are shared between multiple modules.+-}+module Text.Jira.Parser.Shared+  ( icon+  ) where++import Data.Char (isLetter)+import Data.Text (Text)+import Text.Jira.Markup+import Text.Parsec++-- | Parses an icon+icon :: Parsec Text u Icon+icon = smiley <|> otherIcon++smiley :: Parsec Text u Icon+smiley = try $ choice+  [ IconWinking <$ string ";)"+  , char ':' *> anyChar >>= \case+      'D' -> pure IconSmiling+      ')' -> pure IconSlightlySmiling+      '(' -> pure IconFrowning+      'P' -> pure IconTongue+      c   -> fail ("unknown smiley: :" ++ [c])+  ]++otherIcon :: Parsec Text u Icon+otherIcon = try $ do+  let isIconChar c = isLetter c || (c `elem` ("/!+-?*" :: String))+  name <- char '('+          *> many1 (satisfy isIconChar)+          <* char ')'+  case name of+    "y"       -> pure IconThumbsUp+    "n"       -> pure IconThumbsDown+    "i"       -> pure IconInfo+    "/"       -> pure IconCheckmark+    "x"       -> pure IconX+    "!"       -> pure IconAttention+    "+"       -> pure IconPlus+    "-"       -> pure IconMinus+    "?"       -> pure IconQuestionmark+    "on"      -> pure IconOn+    "off"     -> pure IconOff+    "*"       -> pure IconStar+    "*r"      -> pure IconStarRed+    "*g"      -> pure IconStarGreen+    "*b"      -> pure IconStarBlue+    "*y"      -> pure IconStarYellow+    "flag"    -> pure IconFlag+    "flagoff" -> pure IconFlagOff+    _         -> fail ("not a known emoji" ++ name)

@@ -0,0 +1,252 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-|+Module      : Text.Jira.Parser+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+Stability   : alpha+Portability : portable++Generate Jira wiki markup text from an abstract syntax tree.+-}+module Text.Jira.Printer+  ( pretty+  , renderBlock+  , renderInline+  , prettyBlocks+  , prettyInlines+  , JiraPrinter+  , PrinterState (..)+  , startState+  , withDefault+  ) where++import Data.Char (isAlphaNum)+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ((<>))+#endif+import Control.Monad ((<=<))+import Control.Monad.Reader (Reader, runReader, asks, local)+import Data.Text (Text)+import Text.Jira.Markup+import qualified Data.Text as T++-- | Render Jira document as Jira wiki formatted text.+pretty :: Doc -> Text+pretty (Doc blks) = prettyBlocks blks++-- | Render a list of Jira blocks as Jira wiki formatted text.+prettyBlocks :: [Block] -> Text+prettyBlocks blks = runReader (renderBlocks blks) startState++-- | Renders a list of Jira inline markup elements.+prettyInlines :: [Inline] -> Text+prettyInlines = \case+  [] ->+    ""+  s@Str{} : Styled style inlns : rest ->+    renderInline s <> renderStyledSafely style inlns <> prettyInlines rest+  Styled style inlns : s@(Str t) : rest | startsWithAlphaNum t ->+    renderStyledSafely style inlns <> renderInline s <> prettyInlines rest+  s@Str{} : SpecialChar c : rest@(Str {}:_) ->+    (renderInline s `T.snoc` c) <> prettyInlines rest+  s@Space : SpecialChar c : rest@(Space {}:_) ->+    (renderInline s `T.snoc` c) <> prettyInlines rest+  s@Linebreak : SpecialChar c : rest@(Space {}:_) ->+    (renderInline s `T.snoc` c) <> prettyInlines rest+  (x:xs) ->+    renderInline x <> prettyInlines xs++  where+    startsWithAlphaNum t = case T.uncons t of+      Just (c, _) -> isAlphaNum c+      _           -> False++-- | Internal state used by the printer.+data PrinterState = PrinterState+  { stateInTable   :: Bool+  , stateListLevel :: Text+  }++type JiraPrinter a = Reader PrinterState a++-- | Run with default state.+withDefault :: JiraPrinter a -> a+withDefault = flip runReader startState++-- | Default start state of the printer.+startState :: PrinterState+startState = PrinterState+  { stateInTable = False+  , stateListLevel = ""+  }++-- | Render a block as Jira wiki format.+renderBlocks :: [Block] -> JiraPrinter Text+renderBlocks = concatBlocks <=< mapM renderBlock++-- | Combine the texts produced from rendering a list of blocks.+concatBlocks :: [Text] -> JiraPrinter Text+concatBlocks = return . T.intercalate "\n"++-- | Add a newline character unless we are within a list or table.+appendNewline :: Text -> JiraPrinter Text+appendNewline text = do+  listLevel <- asks stateListLevel+  inTable   <- asks stateInTable+  return $+    -- add final newline only if we are neither within a table nor a list.+    if inTable || not (T.null listLevel)+    then text+    else text <> "\n"++-- | Render a block as Jira wiki format.+renderBlock :: Block -> JiraPrinter Text+renderBlock = \case+  Code lang params content -> return $ T.concat+                              [ "{code:"+                              , T.intercalate "|"+                                (renderLang lang : map renderParam params)+                              , "}\n"+                              , content+                              , "\n{code}"+                              ]+  Color colorName blocks   -> renderBlocks blocks >>= \blks -> return $ T.concat+                              [ "{color:", colorText colorName, "}\n"+                              , blks+                              , "{color}"+                              ]+  BlockQuote [Para xs]     -> return $ "bq. " <> prettyInlines xs+  BlockQuote blocks        -> renderBlocks blocks >>= \blks -> return $ T.concat+                              [ "{quote}\n"+                              , blks+                              , "\n{quote}"]+  Header lvl inlines       -> return $ T.concat+                              [ "h",  T.pack (show lvl), ". "+                              , prettyInlines inlines+                              ]+  HorizontalRule           -> return "----"+  List style items         -> listWithMarker items (styleChar style) >>=+                              appendNewline+  NoFormat params content  -> return $ T.concat+                              [ "{noformat"+                              , renderBlockParams params+                              , "}\n"+                              , content+                              , "{noformat}"+                              ]+  Panel params blocks     -> renderBlocks blocks >>= \blks ->+                             return $ T.concat+                             [ "{panel"+                             , renderBlockParams params+                             , "}\n"+                             , blks+                             , "{panel}"+                             ]+  Para inlines              -> appendNewline $ prettyInlines inlines+  Table rows                ->+    local (\st -> st { stateInTable = True }) $+      fmap T.unlines (mapM renderRow rows)++-- | Returns the ext representation of a color+colorText :: ColorName -> Text+colorText (ColorName c) = c++renderLang :: Language -> Text+renderLang (Language lang) = lang++renderBlockParams :: [Parameter] -> Text+renderBlockParams = \case+  [] -> mempty+  xs -> T.cons ':' (renderParams xs)++renderParams :: [Parameter] -> Text+renderParams = T.intercalate "|" . map renderParam++renderParam :: Parameter -> Text+renderParam (Parameter key value) = key <> "=" <> value++renderRow :: Row -> JiraPrinter Text+renderRow (Row cells) = do+  rendered <- mapM renderCell cells+  let closing = if all isHeaderCell cells then " ||" else " |"+  return $ T.unwords rendered <> closing+  where+    isHeaderCell HeaderCell {} = True+    isHeaderCell BodyCell {}   = False++renderCell :: Cell -> JiraPrinter Text+renderCell cell = let (cellStart, blocks) = case cell of+                        (HeaderCell bs) -> ("|| ", bs)+                        (BodyCell bs) -> ("| ", bs)+                  in (cellStart <>) <$> renderBlocks blocks++styleChar :: ListStyle -> Char+styleChar = \case+  CircleBullets -> '*'+  SquareBullets -> '-'+  Enumeration   -> '#'++-- | Create a list using the given character as bullet item marker.+listWithMarker :: [[Block]]+               -> Char+               -> JiraPrinter Text+listWithMarker items marker = do+  let addItem s = s { stateListLevel = stateListLevel s `T.snoc` marker }+  renderedBlocks <- local addItem $ mapM listItemToJira items+  return $ T.intercalate "\n" renderedBlocks++-- | Convert bullet or ordered list item (list of blocks) to Jira.+listItemToJira :: [Block]+               -> JiraPrinter Text+listItemToJira items = do+  contents <- renderBlocks items+  marker <- asks stateListLevel+  return $ case items of+    List{} : _ -> contents+    _          -> marker <> " " <> contents++-- | Renders a single inline item as Jira markup.+renderInline :: Inline -> Text+renderInline = \case+  Anchor name            -> "{anchor:" <> name <> "}"+  AutoLink url           -> urlText url+  Emoji icon             -> iconText icon+  Entity entity          -> "&" <> entity <> ";"+  Image params url       -> "!" <> urlText url <>+                            if null params+                            then "!"+                            else "|" <> renderParams params <> "!"+  Linebreak              -> "\n"+  Link inlines (URL url) -> "[" <> prettyInlines inlines <> "|" <> url <> "]"+  Monospaced inlines     -> "{{" <> prettyInlines inlines <> "}}"+  Space                  -> " "+  SpecialChar c          -> case c of+                              -- backslash is unescapable, render as entity+                              '\\' -> "&bsol;"+                              _    -> "\\" `T.snoc` c+  Str txt                -> txt+  Styled style inlines   -> renderWrapped (delimiterChar style) inlines++renderStyledSafely :: InlineStyle -> [Inline] -> Text+renderStyledSafely style =+  let delim = T.pack ['{', delimiterChar style, '}']+  in (delim <>) . (<> delim) . prettyInlines++delimiterChar :: InlineStyle -> Char+delimiterChar = \case+  Emphasis -> '_'+  Insert -> '+'+  Strong -> '*'+  Strikeout -> '-'+  Subscript -> '~'+  Superscript -> '^'++-- | Text rendering of an URL.+urlText :: URL -> Text+urlText (URL url) = url++renderWrapped :: Char -> [Inline] -> Text+renderWrapped c = T.cons c . flip T.snoc c . prettyInlines

@@ -45,6 +45,10 @@       , testCase "ended by blank line" $         parseJira para "Hello\n\n" @?=         Right (Para [Str "Hello"])++      , testCase "deleted text after linebreak" $+        parseJira para "foo\n-deleted-\n" @?=+        Right (Para [Str "foo", Linebreak, Styled Strikeout [Str "deleted"]])       ]      , testGroup "header"@@ -78,6 +82,12 @@         isLeft (parseJira header " h1. nope\n") @? "leading spaces"       ] +    , testGroup "horizontalRule"+      [ testCase "single ruler" $+        parseJira horizontalRule "----\n" @?=+        Right HorizontalRule+      ]+     , testGroup "list"       [ testCase "single item list" $         parseJira list "* hello\n" @?=@@ -157,14 +167,18 @@       , testCase "item after nested list" $         let text = Text.unlines                    [ "* first"-                   , "** nested"                    , "* second"+                   , "** nested1"+                   , "** nested2"+                   , "* third"                    ]         in parseJira list text @?=            Right (List CircleBullets-                  [ [ Para [Str "first"]-                    , List CircleBullets [[Para [Str "nested"]]]]-                  , [ Para [Str "second"]]])+                  [ [ Para [Str "first"] ]+                  , [ Para [Str "second"]+                    , List CircleBullets [ [Para [Str "nested1"]]+                                         , [Para [Str "nested2"]]]]+                  , [ Para [Str "third"]] ])        , testCase "nested lists" $         let text = Text.unlines@@ -287,6 +301,13 @@         Right (Panel [Parameter "title" "test"] [Para [Str "line"]])       ] +    , testGroup "color"+      [ testCase "single paragraph" $+        parseJira color "{color:red}This is red.\n{color}\n" @?=+        Right (Color (ColorName "red")+               [Para [Str "This", Space, Str "is", Space, Str "red."]])+      ]+     , testGroup "blockQuote"       [ testCase "single line quite before eof" $         parseJira blockQuote "bq. this text" @?=@@ -319,6 +340,14 @@     , testCase "para after header" $       parseJira ((,) <$> block <*> block) "h2.header\nparagraph\n" @?=       Right (Header 2 [Str "header"], Para [Str "paragraph"])++    , testCase "para before horizontal rule " $+      parseJira ((,) <$> block <*> return HorizontalRule) "paragraph\n----\n" @?=+      Right (Para [Str "paragraph"], HorizontalRule)++    , testCase "para after horizontal rule " $+      parseJira ((,) <$> block <*> block) "----\nparagraph\n" @?=+      Right (HorizontalRule, Para [Str "paragraph"])      , testCase "para after list" $       parseJira ((,) <$> block <*> block) "* foo\n\nbar\n" @?=

@@ -39,14 +39,45 @@         "str should only be parsed into Space"       ] -    , testGroup "symbol"-      [ testCase "special symbol" $-        parseJira symbol "!" @?= Right (Str "!")+    , testGroup "specialChar"+      [ testCase "plain special char" $+        parseJira specialChar "!" @?= Right (SpecialChar '!')        , testCase "escaped symbol" $-        parseJira symbol "\\{" @?= Right (Str "{")+        parseJira specialChar "\\{" @?= Right (SpecialChar '{')       ] +    , testGroup "dash"+      [ testCase "en dash" $+        parseJira dash "--" @?= Right (Str "–")++      , testCase "em dash" $+        parseJira dash "---" @?= Right (Str "—")+      ]++    , testGroup "emoji"+      [ testCase "smiling face" $+        parseJira emoji ":D" @?= Right (Emoji IconSmiling)++      , testCase "winking face" $+        parseJira emoji ";)" @?= Right (Emoji IconWinking)++      , testCase "checkmark" $+        parseJira emoji "(/)" @?= Right (Emoji IconCheckmark)++      , testCase "red x" $+        parseJira emoji "(x)" @?= Right (Emoji IconX)++      , testCase "thumbs up" $+        parseJira emoji "(y)" @?= Right (Emoji IconThumbsUp)++      , testCase "green star" $+        parseJira emoji "(*g)" @?= Right (Emoji IconStarGreen)++      , testCase "may not be followed by a letter" $+        isLeft (parseJira emoji "(x)nope") @? "no letters after emojis"+      ]+     , testGroup "whitespace"       [ testCase "space" $         parseJira whitespace " " @?= Right Space@@ -95,43 +126,58 @@         "entities must not be empty"       ] -    , testCase "deleted" $-      parseJira deleted "-far-fetched-" @?=-      Right (Deleted [Str "far", Str "-", Str "fetched"])+    , testGroup "styled" -    , testGroup "emph"-      [ testCase "single word" $-        parseJira emph "_single_" @?= Right (Emph [Str "single"])+      [ testCase "deleted" $+        parseJira styled "-far-fetched-" @?=+        Right (Styled Strikeout [Str "far", SpecialChar '-', Str "fetched"]) -      , testCase "multi word" $-        parseJira emph "_multiple words_" @?=-        Right (Emph [Str "multiple", Space, Str "words"])+      , testGroup "emphasis"+        [ testCase "single word" $+          parseJira styled "_single_" @?= Right (Styled Emphasis [Str "single"]) -      , testCase "symbol before opening underscore" $-        parseJira (str *> emph) "#_bar_" @?=-        Right (Emph [Str "bar"])+        , testCase "multi word" $+          parseJira styled "_multiple words_" @?=+          Right (Styled Emphasis [Str "multiple", Space, Str "words"]) -      , testCase "neither symbol nor space before opening underscore" $-        isLeft (parseJira (str *> emph) "foo_bar_") @? "space after opening char"+        , testCase "forced markup" $+          parseJira styled "{_}forced{_}" @?=+          Right (Styled Emphasis [Str "forced"]) -      , testCase "disallow space after opening underscore" $-        isLeft (parseJira emph "_ nope_") @? "space after underscore"+        , testCase "symbol before opening underscore" $+          parseJira (str *> styled) "#_bar_" @?=+          Right (Styled Emphasis [Str "bar"]) -      , testCase "require word boundary after closing underscore" $-        isLeft (parseJira emph "_nope_nope") @? "no boundary after closing"+        , testCase "neither symbol nor space before opening underscore" $+          isLeft (parseJira (str *> styled) "foo_bar_") @? "space after opening char" -      , testCase "zero with space as word boundary" $-        parseJira ((,) <$> emph <*> str) "_yup_\8203next" @?=-        Right (Emph [Str "yup"], Str "\8203next")+        , testCase "disallow space after opening underscore" $+          isLeft (parseJira styled "_ nope_") @? "space after underscore" -      , testCase "fails for strong" $-        isLeft (parseJira emph "*strong*") @? "strong as emph"-      ]+        , testCase "require word boundary after closing underscore" $+          isLeft (parseJira styled "_nope_nope") @? "no boundary after closing" -    , testCase "inserted" $-      parseJira inserted "+multiple words+" @?=-      Right (Inserted [Str "multiple", Space, Str "words"])+        , testCase "zero with space as word boundary" $+          parseJira ((,) <$> styled <*> str) "_yup_\8203next" @?=+          Right (Styled Emphasis [Str "yup"], Str "\8203next")+        ] +      , testCase "inserted" $+        parseJira styled "+multiple words+" @?=+        Right (Styled Insert [Str "multiple", Space, Str "words"])++      , testCase "strong" $+        parseJira styled "*single*" @?= Right (Styled Strong [Str "single"])++      , testCase "subscript" $+        parseJira styled "~multiple words~" @?=+        Right (Styled Subscript [Str "multiple", Space, Str "words"])++      , testCase "superscript" $+        parseJira styled "^multiple words^" @?=+        Right (Styled Superscript [Str "multiple", Space, Str "words"])+    ]+     , testCase "monospaced" $       parseJira monospaced "{{multiple words}}" @?=       Right (Monospaced [Str "multiple", Space, Str "words"])@@ -141,6 +187,10 @@         parseJira linebreak "\na" @?=         Right Linebreak +      , testCase "double-backslash linebreak" $+        parseJira linebreak "\\\\" @?=+        Right Linebreak+       , testCase "linebreak at eof fails" $         isLeft (parseJira linebreak "\n") @? "newline before eof" @@ -152,32 +202,25 @@        , testCase "linebreak before header fails" $         isLeft (parseJira linebreak "\nh1.foo\n") @? "newline before header"-      ] -    , testGroup "strong"-      [ testCase "single word" $-        parseJira strong "*single*" @?= Right (Strong [Str "single"])--      , testCase "multi word" $-        parseJira strong "*multiple words*" @?=-        Right (Strong [Str "multiple", Space, Str "words"])--      , testCase "fails for emph" $-        isLeft (parseJira strong "_emph_") @? "emph as strong"+      , testCase "three backslashes do not cause a linebreak" $+        isLeft (parseJira linebreak "\\\\\\") @? "three backslashes"       ] -    , testCase "subscript" $-      parseJira subscript "~multiple words~" @?=-      Right (Subscript [Str "multiple", Space, Str "words"])--    , testCase "superscript" $-      parseJira superscript "^multiple words^" @?=-      Right (Superscript [Str "multiple", Space, Str "words"])-     , testCase "anchor" $       parseJira anchor "{anchor:testing}" @?=       Right (Anchor "testing") +    , testGroup "autolink"+      [ testCase "hypertext link" $+        parseJira autolink "https://example.org/foo" @?=+        Right (AutoLink (URL "https://example.org/foo"))++      , testCase "email" $+        parseJira autolink "mailto:nobody@test.invalid" @?=+        Right (AutoLink (URL "mailto:nobody@test.invalid"))+      ]+     , testGroup "link"       [ testCase "unaliased link" $         parseJira link "[https://example.org]" @?=@@ -189,14 +232,19 @@        , testCase "alias with emphasis" $         parseJira link "[_important_ example|https://example.org]" @?=-        Right (Link [Emph [Str "important"], Space, Str "example"]+        Right (Link [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"))       ]      , testGroup "image"       [ testCase "local file" $         parseJira image "!image.jpg!" @?=-        Right (Image (URL "image.jpg"))+        Right (Image [] (URL "image.jpg"))        , testCase "no newlines" $         isLeft (parseJira image "!hello\nworld.png!") @?@@ -207,15 +255,45 @@   , testGroup "inline parser"     [ testCase "simple sentence" $       parseJira (normalizeInlines <$> many1 inline) "Hello, World!" @?=-      Right [Str "Hello,", Space, Str "World!"]+      Right [Str "Hello,", Space, Str "World", SpecialChar '!']      , testCase "with entity" $       parseJira (many1 inline) "shopping at P&amp;C" @?=       Right [ Str "shopping", Space, Str "at", Space-            , Str "P", Entity "amp", Str "C"]+            , Str "P", Entity "amp", Str "C"+            ] +    , testCase "autolink followed by pipe" $+      parseJira (many1 inline) "https://jira.example/file.txt|" @?=+      Right [AutoLink (URL "https://jira.example/file.txt"), SpecialChar '|']+     , testCase "backslash-escaped char" $       parseJira (normalizeInlines <$> many1 inline) "opening brace: \\{" @?=-      Right [ Str "opening", Space, Str "brace:", Space, Str "{"]+      Right [Str "opening", Space, Str "brace:", Space, SpecialChar '{']++    , testCase "icon after word" $+      parseJira (many1 inline) "checkmark(/)" @?=+      Right [Str "checkmark", Emoji IconCheckmark]++    , testCase "smiley after word" $+      parseJira (normalizeInlines <$> many1 inline) "smiley:)" @?=+      Right [Str "smiley", Emoji IconSlightlySmiling]++    , testCase "escaped smiley after word" $+      parseJira (normalizeInlines <$> many1 inline) "closing paren\\:)" @?=+      Right [Str "closing", Space, Str "paren", SpecialChar ':', Str ")"]++    , testCase "smiley between words" $+      parseJira (normalizeInlines <$> many1 inline) "verdict: :D funny" @?=+      Right [Str "verdict:", Space, Emoji IconSmiling, Space, Str "funny"]++    , testCase "dash with spaces" $+      parseJira (many1 inline) "one  -- two" @?=+      Right [Str "one", Space, Str "–", Space, Str "two"]+++    , testCase "forced markup" $+      parseJira (many1 inline) "H{~}2{~}O" @?=+      Right [Str "H", Styled Subscript [Str "2"], Str "O"]     ]   ]

@@ -13,6 +13,8 @@  import Data.Text () import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Text.Jira.Parser import qualified Text.Jira.Parser.BlockTests import qualified Text.Jira.Parser.InlineTests @@ -20,4 +22,36 @@ tests = testGroup "Parser"   [ Text.Jira.Parser.InlineTests.tests   , Text.Jira.Parser.BlockTests.tests+  , testGroup "doc"+    [ testCase "empty document" $+      parse "" @?=+      Right (Doc [])++    , testCase "simple document" $+      parse "h1. test\nThis is ok." @?=+      Right (Doc [ Header 1 [Str "test"]+                 , Para [Str "This", Space, Str "is", Space, Str "ok."]])+    ]++  , testGroup "plainText"+    [ testCase "word" $+      plainText "kthxbye" @?=+      Right [Str "kthxbye"]++    , testCase "words" $+      plainText "be Berlin" @?=+      Right [Str "be", Space, Str "Berlin"]++    , testCase "smiley" $+      plainText ":)" @?=+      Right [Str "\\:)"]++    , testCase "icon after word" $+      plainText "f(x)" @?=+      Right [Str "f\\(x)"]++    , testCase "special chars" $+      plainText "*not strong*" @?=+      Right [SpecialChar '*', Str "not", Space, Str "strong", SpecialChar '*']+    ]   ]

@@ -0,0 +1,151 @@+{-|+Module      : Text.Jira.PrinterTests+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+Stability   : alpha+Portability : portable++Tests for the jira wiki printer.+-}+module Text.Jira.PrinterTests (tests) where++import Prelude hiding (unlines)+import Data.Text (Text, unlines)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Text.Jira.Markup+import Text.Jira.Printer++tests :: TestTree+tests = testGroup "Printer"+  [ testGroup "doc"+    [ testCase "empty document" $+      pretty (Doc []) @?= ""+    ]++  , testGroup "blocks"+    [ testCase "simple paragraph" $+      let para = Para [Str "Hello,", Space, Str "World!"]+      in renderBlock' para @?= "Hello, World!\n"++    , testCase "two paragraphs" $+      let para1 = Para [Str "First", Space, Str "paragraph."]+          para2 = Para [Str "Second", Space, Str "paragraph."]+      in prettyBlocks [para1, para2] @?= unlines+         [ "First paragraph."+         , ""+         , "Second paragraph."+         ]++    , testGroup "header"+      [ testCase "simple" $+        let header = Header 1 [Str "test", Space, Str "header"]+        in renderBlock' header @?= "h1. test header"++      , testCase "header" $+        let header = Header 5 [Str "test", Space, Str "header"]+        in renderBlock' header @?= "h5. test header"+      ]++    , testCase "horizontal rule" $+      renderBlock' HorizontalRule @?= "----"++    , testCase "color" $+      renderBlock' (Color (ColorName "blue") [Para [Str "yabadee"]]) @?=+      "{color:blue}\nyabadee\n{color}"++    , testGroup "list"+      [ testCase "simple list" $+        let list = List SquareBullets [ [Para [Str "first"]]+                                      , [Para [Str "second"]]+                                      , [Para [Str "third"]]+                                      ]+        in renderBlock' list @?= unlines+           [ "- first"+           , "- second"+           , "- third"+           ]++      , testCase "nested list" $+        let list = List CircleBullets+                   [ [Para [Str "first"]]+                   , [ List Enumeration   [ [Para [Str "second-1"]]+                                          , [Para [Str "second-2"]]]]+                   , [ Para [Str "third"]+                     , List CircleBullets [ [Para [Str "third-1"]]+                                          , [Para [Str "third-2"]]]]+                   ]+        in renderBlock' list @?= unlines+           [ "* first"+           , "*# second-1"+           , "*# second-2"+           , "* third"+           , "** third-1"+           , "** third-2"+           ]+      ]++    , testCase "table" $+      let headerRow = Row [ HeaderCell [Para [Str "one"]]+                          , HeaderCell [Para [Str "two"]]+                          ]+          bodyRow = Row [ BodyCell [Para [Str "1"]]+                        , BodyCell [Para [Str "2"]]+                        ]+          table = Table [headerRow, bodyRow]+      in renderBlock' table @?= "|| one || two ||\n| 1 | 2 |\n"++    , testCase "para after table" $+      let table = Table [Row [BodyCell [Para [Str "boring"]]]]+          para = Para [Str "after", Space, Str "table"]+      in prettyBlocks [table, para] @?= "| boring |\n\nafter table\n"++    , testCase "para after list" $+      let list = List Enumeration [[Para [Str "boring"]]]+          para = Para [Str "after", Space, Str "table"]+      in prettyBlocks [list, para] @?= "# boring\n\nafter table\n"+    ]++  , testGroup "isolated inline"+    [ testCase "SpecialChar" $+      renderInline (SpecialChar '*') @?= "\\*"++    , testCase "AutoLink" $+      renderInline (AutoLink (URL "https://example.org")) @?=+      "https://example.org"++    , testCase "Emoji" $+      renderInline (Emoji IconSmiling) @?= ":D"++    , testCase "Styled Emphasis" $+      renderInline (Styled Emphasis [Str "Hello,", Space, Str "World!"]) @?=+      "_Hello, World!_"++    , testCase "Styled Strong" $+      renderInline (Styled Strong [Str "Hello,", Space, Str "World!"]) @?=+      "*Hello, World!*"+    ]++  , testGroup "combined inlines"+    [ testCase "special char between words" $+      prettyInlines [Str "easy", SpecialChar '-', Str "peasy"] @?=+      "easy-peasy"++    , testCase "special char before word" $+      prettyInlines [SpecialChar '*', Str "star"] @?=+      "\\*star"++    , testCase "markup within word" $+      prettyInlines [Str "H", Styled Subscript [Str "2"], Str "O"] @?=+      "H{~}2{~}O"++    , testCase "markup followed by punctuation" $+      prettyInlines [Styled Emphasis [Str "Word"], Str "."] @?=+      "_Word_."+    ]+  ]++renderBlock' :: Block -> Text+renderBlock' = withDefault . renderBlock

@@ -14,6 +14,7 @@ import Data.Text () import Test.Tasty (TestTree, defaultMain, testGroup) import qualified Text.Jira.ParserTests+import qualified Text.Jira.PrinterTests  -- | Run the tests for jira-wiki-markup. main :: IO ()@@ -22,4 +23,5 @@ tests :: TestTree tests = testGroup "jira-wiki-markup"   [ Text.Jira.ParserTests.tests+  , Text.Jira.PrinterTests.tests   ]