jira-wiki-markup-1.1.4/0000755000000000000000000000000007346545000013071 5ustar0000000000000000jira-wiki-markup-1.1.4/CHANGELOG.md0000644000000000000000000000521707346545000014707 0ustar0000000000000000Changelog ========= `jira-wiki-markup` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. 1.1.4 ----- Released 2020-03-27 * Fix parsing of image parameters. Thumbnails and images with parameters were previously not recognized as images. 1.1.3 ----- Released 2020-03-19 * Fixed table detection in endOfParagraph parser: Tables were expected to have a space between the leading pipe(s) and the cell content. Lines like `||Name|` were erroneously not recognized as the beginning of a new block. 1.1.2 ----- Released 2020-03-18 * Don't escape colon/semicolon unless necessary: it is necessary to escape colons or semicolons only if they could otherwise become part of a smiley. 1.1.1 ----- Released 2020-03-18 * Colon `:` and semicolon `;` are now parsed as special characters, since they can be the first characters of an emoji. * Fixed parsing of words which contain non-special symbol characters: word boundaries were not set correctly if a word contained a dot `.` or similar chars. * Fixed incorrect emphasis parsing: digits were erroneously allows as the first characters after closing emphasis characters. 1.1.0 ----- Released 2020-03-13. * Lists are now allowed to be indented; i.e., lists are still recognized if list markers are preceded by spaces. * Support for colored inlines has been added. * New constructor `ColorInline` for type `Inline` (API change). 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 made 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 ----- * Ensure proper parsing of backslash-escaped characters. 0.1.0 ----- * Initially created. [1]: https://pvp.haskell.org [2]: https://github.com/tarleb/jira-wiki-markup/releases jira-wiki-markup-1.1.4/LICENSE0000644000000000000000000000206707346545000014103 0ustar0000000000000000MIT License Copyright © 2019–2020 Albert Krewinkel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. jira-wiki-markup-1.1.4/README.md0000644000000000000000000000223407346545000014351 0ustar0000000000000000# jira-wiki-markup [![Hackage](https://img.shields.io/hackage/v/jira-wiki-markup.svg)](https://hackage.haskell.org/package/jira-wiki-markup) [![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE) [![Stackage Lts](http://stackage.org/package/jira-wiki-markup/badge/lts)](http://stackage.org/lts/package/jira-wiki-markup) [![Stackage Nightly](http://stackage.org/package/jira-wiki-markup/badge/nightly)](http://stackage.org/nightly/package/jira-wiki-markup) [![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 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 This package is licensed under the MIT license. See the `LICENSE` file for details. jira-wiki-markup-1.1.4/app/0000755000000000000000000000000007346545000013651 5ustar0000000000000000jira-wiki-markup-1.1.4/app/Main.hs0000644000000000000000000000063507346545000015075 0ustar0000000000000000{-| Parse Jira wiki markup from stdin. -} module Main (main) where import Prelude hiding (interact) import Control.Exception (throw) import Data.Text (pack) import Data.Text.IO (interact) import System.Exit (ExitCode (ExitFailure)) import Text.Jira.Parser (parse) main :: IO () main = interact parse' where parse' t = case parse t of Left _ -> throw (ExitFailure 1) Right r -> pack (show r) jira-wiki-markup-1.1.4/jira-wiki-markup.cabal0000644000000000000000000000677707346545000017261 0ustar0000000000000000cabal-version: 2.0 name: jira-wiki-markup version: 1.1.4 synopsis: Handle Jira wiki markup description: Parse jira wiki text into an abstract syntax tree for easy transformation to other formats. homepage: https://github.com/tarleb/jira-wiki-markup bug-reports: https://github.com/tarleb/jira-wiki-markup/issues license: MIT license-file: LICENSE author: Albert Krewinkel maintainer: tarleb@zeitkraut.de copyright: © 2019–2020 Albert Krewinkel category: Text 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.5 , GHC == 8.8.3 source-repository head type: git location: https://github.com/tarleb/jira-wiki-markup.git library hs-source-dirs: src exposed-modules: Text.Jira.Markup , Text.Jira.Parser , 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 ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Widentities -Wredundant-constraints default-language: Haskell2010 default-extensions: OverloadedStrings executable jira-wiki-markup hs-source-dirs: app main-is: Main.hs build-depends: base >= 4.9 && < 5 , text >= 1.1.1 && < 1.3 , jira-wiki-markup ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Widentities -Wredundant-constraints default-language: Haskell2010 default-extensions: OverloadedStrings test-suite jira-wiki-markup-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: jira-wiki-markup-test.hs 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 , parsec >= 3.1 && < 3.2 , tasty , tasty-hunit , text >= 1.1.1 && < 1.3 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Widentities -Wredundant-constraints default-language: Haskell2010 default-extensions: OverloadedStrings jira-wiki-markup-1.1.4/src/Text/Jira/0000755000000000000000000000000007346545000015471 5ustar0000000000000000jira-wiki-markup-1.1.4/src/Text/Jira/Markup.hs0000644000000000000000000001260407346545000017267 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-| Module : Text.Jira.Markup Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : portable Jira markup types. -} module Text.Jira.Markup ( 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 | AutoLink URL -- ^ URL which is also a link | 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 | 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 | Para [Inline] -- ^ Paragraph of text | Table [Row] -- ^ Table deriving (Eq, Ord, Show) -- | Style used for list items. data ListStyle = 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) -- | Table row, containing an arbitrary number of cells. newtype Row = Row { fromRow :: [Cell] } deriving (Eq, Ord, Show) -- | Table cell with block content data Cell = BodyCell [Block] | HeaderCell [Block] deriving (Eq, Ord, Show) -- | Programming language used for syntax highlighting. newtype Language = Language Text deriving (Eq, Ord, Show) -- | Panel parameter data Parameter = Parameter { parameterKey :: Text , 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 [] -> [] [Space] -> [] [Linebreak] -> [] Space : Space : xs -> Space : normalizeInlines xs Space : Linebreak : xs -> Linebreak : normalizeInlines xs 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)" jira-wiki-markup-1.1.4/src/Text/Jira/Parser.hs0000644000000000000000000000154507346545000017266 0ustar0000000000000000{-| Module : Text.Jira.Parser Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : portable Parse Jira wiki markup. -} 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) import Text.Jira.Markup 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 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" jira-wiki-markup-1.1.4/src/Text/Jira/Parser/0000755000000000000000000000000007346545000016725 5ustar0000000000000000jira-wiki-markup-1.1.4/src/Text/Jira/Parser/Block.hs0000644000000000000000000001453107346545000020317 0ustar0000000000000000{-| Module : Text.Jira.Parser.Block Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : portable Parse Jira wiki blocks. -} module Text.Jira.Parser.Block ( block -- * Parsers for block types , blockQuote , code , color , header , horizontalRule , list , noformat , panel , para , table ) where import Control.Monad (guard, void, when) import Data.Char (digitToInt) import Data.Text (pack) import Text.Jira.Markup import Text.Jira.Parser.Core import Text.Jira.Parser.Inline import Text.Parsec -- | Parses any block element. block :: JiraParser Block block = choice [ header , list , table , blockQuote , horizontalRule , code , noformat , panel , color , para ] <* skipWhitespace -- | Parses a paragraph into a @Para@. para :: JiraParser Block para = ( "para") . try $ do isInList <- stateInList <$> getState when isInList $ do notFollowedBy' blankline notFollowedBy' horizontalRule Para . normalizeInlines <$> many1 inline -- | Parses a header line into a @Header@. header :: JiraParser Block header = ( "header") . try $ do level <- digitToInt <$> (char 'h' *> oneOf "123456" <* char '.') content <- skipMany (char ' ') *> inline `manyTill` (void newline <|> eof) return $ Header level (normalizeInlines content) -- | Parses a list into @List@. list :: JiraParser Block list = ( "list") . try $ do guard . not . stateInList =<< getState withStateFlag (\b st -> st { stateInList = b }) $ listAtDepth 0 where listAtDepth :: Int -> JiraParser Block listAtDepth depth = try $ atDepth depth *> listAtDepth' depth listAtDepth' :: Int -> JiraParser Block listAtDepth' depth = try $ do bulletChar <- anyBulletMarker first <- firstItemAtDepth depth rest <- many (try $ listItemAtDepth depth (char bulletChar)) return $ List (style bulletChar) (first:rest) style :: Char -> ListStyle style c = case c of '-' -> SquareBullets '*' -> CircleBullets '#' -> Enumeration _ -> error ("the impossible happened: unknown style for bullet " ++ [c]) atDepth :: Int -> JiraParser () atDepth depth = try $ skipSpaces <* count depth anyBulletMarker firstItemAtDepth :: Int -> JiraParser [Block] firstItemAtDepth depth = try $ listContent (depth + 1) <|> do 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 depth) <|> try (anyBulletMarker *> listContent depth)) listContent :: Int -> JiraParser [Block] listContent depth = do first <- listAtDepth' depth rest <- many (listAtDepth depth) return (first : rest) anyBulletMarker :: JiraParser Char anyBulletMarker = oneOf "*-#" nonListContent :: Int -> JiraParser [Block] nonListContent depth = try $ let nonListBlock = do notFollowedBy' (skipSpaces *> many1 (oneOf "#-*")) block in char ' ' *> do first <- block nonList <- many nonListBlock lists <- many (listAtDepth (depth + 1)) return (first : nonList ++ lists) -- | Parses a table into a @Table@ element. table :: JiraParser Block table = do guard . not . stateInTable =<< getState withStateFlag (\b st -> st { stateInTable = b }) $ Table <$> many1 row -- | Parses a table row. row :: JiraParser Row row = fmap Row . try $ many1 cell <* optional (skipMany (oneOf " |") *> newline) -- | Parses a table cell. cell :: JiraParser Cell cell = try $ do mkCell <- cellStart bs <- many1 block return $ mkCell bs -- | Parses the beginning of a table cell and returns a function which -- constructs a cell of the appropriate type when given the cell's content. cellStart :: JiraParser ([Block] -> Cell) cellStart = try $ skipSpaces *> char '|' *> option BodyCell (HeaderCell <$ many1 (char '|')) <* skipSpaces <* notFollowedBy' newline -- | Parses a code block into a @Code@ element. code :: JiraParser Block code = try $ do (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 blockQuote = try $ singleLineBq <|> multiLineBq where singleLineBq = BlockQuote . (:[]) . Para <$> (string "bq. " *> skipMany (char ' ') *> inline `manyTill` (void newline <|> eof)) multiLineBq = BlockQuote <$> (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 (_, params) <- string "{noformat" *> parameters <* char '}' <* newline content <- anyChar `manyTill` try (string "{noformat}" *> blankline) return $ NoFormat params (pack content) -- | Parses a preformatted text into a @NoFormat@ element. panel :: JiraParser Block panel = try $ do (_, params) <- string "{panel" *> parameters <* char '}' <* newline content <- block `manyTill` try (string "{panel}" *> blankline) return $ Panel params content -- | 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 colorName = many letter colorCode = optional (char '#') *> count 6 digit -- | Skip whitespace till we reach the next block skipWhitespace :: JiraParser () skipWhitespace = optional $ do isInList <- stateInList <$> getState isInTable <- stateInTable <$> getState case (isInList, isInTable) of (True, _) -> blankline (_, True) -> skipSpaces _ -> skipMany blankline jira-wiki-markup-1.1.4/src/Text/Jira/Parser/Core.hs0000644000000000000000000001015607346545000020154 0ustar0000000000000000{-| Module : Text.Jira.Parser.Core Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : portable Core components of the Jira wiki markup parser. -} module Text.Jira.Parser.Core ( -- * Jira parser and state JiraParser , ParserState (..) , defaultState , parseJira , withStateFlag -- * String position tracking , updateLastStrPos , notAfterString -- * Parsing helpers , endOfPara , notFollowedBy' , blankline , skipSpaces , blockNames , parameters ) where import Control.Monad (join, void) import Data.Text (Text, pack) import Text.Jira.Markup import Text.Parsec -- | Jira Parsec parser type JiraParser = Parsec Text ParserState -- | Parser state used to keep track of various parameteres. data ParserState = ParserState { stateInLink :: Bool -- ^ whether the parser is within a link , stateInList :: Bool -- ^ whether the parser is within a list , stateInTable :: Bool -- ^ whether the parser is within a table , stateLastStrPos :: Maybe SourcePos -- ^ position at which the last string -- ended } -- | Default parser state (i.e., start state) defaultState :: ParserState defaultState = ParserState { stateInLink = False , stateInList = False , stateInTable = False , stateLastStrPos = Nothing } -- | Set a flag in the parser to @True@ before running a parser, then -- set the flag's value to @False@. withStateFlag :: (Bool -> ParserState -> ParserState) -> JiraParser a -> JiraParser a withStateFlag flagSetter parser = try $ let setFlag = modifyState . flagSetter in setFlag True *> parser <* setFlag False -- | Updates the state, marking the current input position as the end of a -- string. updateLastStrPos :: JiraParser () updateLastStrPos = do pos <- getPosition modifyState $ \st -> st { stateLastStrPos = Just pos } -- | Checks whether the parser is directly after a string. notAfterString :: JiraParser Bool notAfterString = do curPos <- getPosition prevPos <- stateLastStrPos <$> getState return (Just curPos /= prevPos) -- | Parses a string with the given Jira parser. parseJira :: JiraParser a -> Text -> Either ParseError a parseJira parser = runParser parser defaultState "" -- | Skip zero or more space chars. skipSpaces :: JiraParser () skipSpaces = skipMany (char ' ') -- | Parses an empty line, i.e., a line with no chars or whitespace only. 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 $ 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"] -- | Variant of parsec's @notFollowedBy@ function which properly fails even if -- the given parser does not consume any input (like @eof@ does). notFollowedBy' :: Show a => JiraParser a -> JiraParser () notFollowedBy' p = let failIfSucceeds = unexpected . show <$> try p unitParser = return (return ()) in try $ join (failIfSucceeds <|> unitParser) jira-wiki-markup-1.1.4/src/Text/Jira/Parser/Inline.hs0000644000000000000000000001712407346545000020504 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-| Module : Text.Jira.Parser.Inline Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : portable Parse Jira wiki inline markup. -} module Text.Jira.Parser.Inline ( inline -- * Inline component parsers , anchor , autolink , colorInline , dash , emoji , entity , image , linebreak , link , monospaced , specialChar , str , styled , whitespace -- * Constants , specialChars ) where import Control.Monad (guard, void) import Data.Char (isAlphaNum, isPunctuation, ord) #if !MIN_VERSION_base(4,13,0) import Data.Monoid ((<>), All (..)) #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 , styled , colorInline , monospaced , anchor , entity , specialChar ] "inline" where blockEnd = char '{' *> choice (map string blockNames) <* char '}' -- | Characters which, depending on context, can have a special meaning. specialChars :: String specialChars = "_+-*^~|[]{}(!&\\:;" -- | 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 ( choice [ void $ newline <* notFollowedBy' endOfPara , void $ string "\\\\" <* notFollowedBy' (char '\\') ] ) "linebreak" -- | Parses whitespace and return a @Space@ element. whitespace :: JiraParser Inline whitespace = Space <$ skipMany1 (char ' ') "whitespace" -- | Parses a simple, markup-less string into a @Str@ element. str :: JiraParser Inline str = Str . pack . mconcat <$> many1 (alphaNums <|> otherNonSpecialChars) "string" where nonStrChars = " \n" ++ specialChars alphaNums = many1 alphaNum <* updateLastStrPos otherNonSpecialChars = many1 . satisfy $ \c -> not (isAlphaNum c || c `elem` nonStrChars) -- | Parses an HTML entity into an @'Entity'@ element. entity :: JiraParser Inline entity = Entity . pack <$> try (char '&' *> (numerical <|> named) <* char ';') where 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@. specialChar :: JiraParser Inline specialChar = SpecialChar <$> (escapedChar <|> plainSpecialChar) "special char" where escapedChar = try (char '\\' *> satisfy isPunctuation) 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)) specialChars -- -- Anchors, links and images -- -- | Parses an anchor into an @Anchor@ element. anchor :: JiraParser Inline anchor = Anchor . pack . filter (/= ' ') <$> try (string "{anchor:" *> noneOf "\n" `manyTill` char '}') -- | Parse image into an @Image@ element. image :: JiraParser Inline image = try $ do -- does not use @url@, as is may contain relative locations. src <- char '!' *> (URL . pack <$> many1 (noneOf "\r\t\n|]!")) params <- option [] (char '|' *> (thumbnail <|> imgParams `sepBy` comma)) _ <- char '!' return $ Image params src where thumbnail = [Parameter "thumbnail" ""] <$ try (string "thumbnail") imgParams = try (Parameter <$> key <*> (char '=' *> value)) key = pack <$> many1 (noneOf ",\"'\t\n\r |{}=!") value = pack <$> many1 (noneOf ",\"'\n\r|{}=!") comma = char ',' *> skipSpaces -- | Parse link into a @Link@ element. link :: JiraParser Inline link = try $ do guard . not . stateInLink =<< getState withStateFlag (\b st -> st { stateInLink = b }) $ do _ <- char '[' alias <- option [] $ try (many inline <* char '|') linkUrl <- email <|> url _ <- char ']' 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 -- -- Color -- -- | Text in a different color. colorInline :: JiraParser Inline colorInline = try $ do name <- string "{color:" *> (colorName <|> colorCode) <* char '}' content <- inline `manyTill` try (string "{color}") return $ ColorInline (ColorName $ pack name) content where colorName = many1 letter colorCode = (:) <$> option '#' (char '#') <*> count 6 digit -- -- Markup -- -- | 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 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" -- -- Helpers -- -- | Parse text delimited by a character. delimitingMany :: Char -> JiraParser a -> JiraParser [a] delimitingMany c = enclosed (char c) (char c) enclosed :: JiraParser opening -> JiraParser closing -> JiraParser a -> JiraParser [a] enclosed opening closing parser = try $ do guard =<< notAfterString opening *> notFollowedBy space *> manyTill parser closing' where closing' = try $ closing <* lookAhead wordBoundary wordBoundary = void (satisfy (not . isAlphaNum)) <|> eof jira-wiki-markup-1.1.4/src/Text/Jira/Parser/PlainText.hs0000644000000000000000000000254307346545000021175 0ustar0000000000000000{-| Module : Text.Jira.Parser.PlainText Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel 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 jira-wiki-markup-1.1.4/src/Text/Jira/Parser/Shared.hs0000644000000000000000000000321207346545000020465 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-| Module : Text.Jira.Parser.Shared Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel 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) jira-wiki-markup-1.1.4/src/Text/Jira/Printer.hs0000644000000000000000000002157207346545000017457 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-| Module : Text.Jira.Parser Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel 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 -- Colon and semicolon only need escaping if they could otherwise -- become part of a smiley. SpecialChar c : rest@(x : _) | c `elem` [':', ';'] && not (isSmileyStr x) -> T.singleton c <> prettyInlines rest [SpecialChar c] | c `elem` [':', ';'] -> T.singleton c (x:xs) -> renderInline x <> prettyInlines xs where startsWithAlphaNum t = case T.uncons t of Just (c, _) -> isAlphaNum c _ -> False isSmileyStr = \case Str x | x `elem` ["D", ")", "(", "P"] -> True _ -> 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 ColorInline color ils -> "{color:" <> colorText color <> "}" <> prettyInlines ils <> "{color}" 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 '\\' -> "\" _ -> "\\" `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 jira-wiki-markup-1.1.4/test/Text/Jira/Parser/0000755000000000000000000000000007346545000017115 5ustar0000000000000000jira-wiki-markup-1.1.4/test/Text/Jira/Parser/BlockTests.hs0000644000000000000000000003473207346545000021537 0ustar0000000000000000{-| Module : Text.Jira.Parser.BlockTests Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : portable Tests for jira wiki block parsers. -} module Text.Jira.Parser.BlockTests (tests) where import Data.Either (isLeft) import Data.Text () import Text.Jira.Markup import Text.Jira.Parser.Block import Text.Jira.Parser.Core import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=), (@?)) import qualified Data.Text as Text tests :: TestTree tests = testGroup "Blocks" [ testGroup "components" [ testGroup "para" [ testCase "two lines" $ parseJira block "one\ntwo\n" @?= Right (Para [Str "one", Linebreak, Str "two"]) , testCase "ended by newline" $ parseJira para "Hello, World\n" @?= Right (Para [Str "Hello,", Space, Str "World"]) , testCase "ended by eof" $ parseJira para "Hello, World" @?= Right (Para [Str "Hello,", Space, Str "World"]) , testCase "ended by spaces and newline" $ parseJira para "Hello, World \n" @?= Right (Para [Str "Hello,", Space, Str "World"]) , 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" [ testCase "Level 1" $ parseJira header "h1. Intro\n" @?= Right (Header 1 [Str "Intro"]) , testCase "many spaces before title" $ parseJira header "h2. space\n" @?= Right (Header 2 [Str "space"]) , testCase "no space after dot" $ parseJira header "h3.hug\n" @?= Right (Header 3 [Str "hug"]) , testCase "empty header" $ parseJira header "h4.\n" @?= Right (Header 4 []) , testCase "Level 6" $ parseJira header "h6. More\n" @?= Right (Header 6 [Str "More"]) , testCase "Level 7 fails" $ isLeft (parseJira header "h7. More\n") @? "level 7 header" , testCase "Level 0 fails" $ isLeft (parseJira header "h0. More\n") @? "level 0 header" , testCase "leading spaces are disallowed" $ 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" @?= Right (List CircleBullets [[Para [Str "hello"]]]) , testCase "simple list" $ let text = Text.unlines [ "* one" , "* two" ] in parseJira list text @?= Right (List CircleBullets [ [Para [Str "one"]] , [Para [Str "two"]]]) , testCase "list followed by different list" $ parseJira ((,) <$> list <*> list) "- first\n* second\n" @?= Right ( List SquareBullets [[Para [Str "first"]]] , List CircleBullets [[Para [Str "second"]]]) , testCase "nested lists" $ parseJira list "* first\n** nested\n" @?= Right (List CircleBullets [ [ Para [Str "first"] , List CircleBullets [[Para [Str "nested"]]] ] ]) , testCase "deeply nested list" $ parseJira list "*-* nested\n*-* list\n" @?= Right (List CircleBullets [ [ List SquareBullets [[ List CircleBullets [ [Para [Str "nested"]] , [Para [Str "list"]]] ]] ] ]) , testCase "markers can vary" $ parseJira list "#-* nested\n*** list\n" @?= Right (List Enumeration [[ List SquareBullets [[ List CircleBullets [ [Para [Str "nested"]] , [Para [Str "list"]] ] ]] ]]) , testCase "single nested list after paragraph" $ let text = Text.unlines [ "* line" , "continued" , "** nested" ] in parseJira list text @?= Right (List CircleBullets [ [ Para [Str "line", Linebreak, Str "continued"] , List CircleBullets [[Para [Str "nested"]]]]]) , testCase "multiple nested lists after paragraph" $ let text = Text.unlines [ "* line" , "continued" , "** nested" , "*# another" ] in parseJira list text @?= Right (List CircleBullets [ [ Para [Str "line", Linebreak, Str "continued"] , List CircleBullets [[Para [Str "nested"]]] , List Enumeration [[Para [Str "another"]]]]]) , testCase "item after nested list" $ let text = Text.unlines [ "* first" , "* second" , "** nested1" , "** nested2" , "* third" ] in parseJira list text @?= Right (List CircleBullets [ [ Para [Str "first"] ] , [ Para [Str "second"] , List CircleBullets [ [Para [Str "nested1"]] , [Para [Str "nested2"]]]] , [ Para [Str "third"]] ]) , testCase "nested lists" $ let text = Text.unlines [ "** eins" , "*- zwei" , "** drei" ] in parseJira list text @?= Right (List CircleBullets [ [ List CircleBullets [[Para [Str "eins"]]] , List SquareBullets [[Para [Str "zwei"]]] , List CircleBullets [[Para [Str "drei"]]] ] ]) , testCase "indentation is ignored" $ let text = Text.unlines [ " * One" , " * Two" , " ** Two.One" , " * Three" ] in parseJira list text @?= Right (List CircleBullets [ [ Para [Str "One"] ] , [ Para [Str "Two"] , List CircleBullets [[Para [Str "Two.One"]]]] , [ Para [Str "Three"] ] ]) ] , testGroup "Table" [ testCase "single cell" $ parseJira table "| Lua \n" @?= Right (Table [Row [BodyCell [Para [Str "Lua"]]]]) , testCase "header cell" $ parseJira table "|| Language\n" @?= Right (Table [Row [HeaderCell [Para [Str "Language"]]]]) , testCase "2x2 table" $ parseJira table (Text.unlines [ "|| Language || Type ||" , "| Lua | dynamic |\n"]) @?= Right (Table [ Row [ HeaderCell [Para [Str "Language"]] , HeaderCell [Para [Str "Type"]] ] , Row [ BodyCell [Para [Str "Lua"]] , BodyCell [Para [Str "dynamic"]] ] ]) , testCase "row headeres" $ parseJira table (Text.unlines [ "|| Language | Haskell ||" , "|| Type | static |\n"]) @?= Right (Table [ Row [ HeaderCell [Para [Str "Language"]] , BodyCell [Para [Str "Haskell"]] ] , Row [ HeaderCell [Para [Str "Type"]] , BodyCell [Para [Str "static"]] ] ]) , testCase "list in table" $ parseJira table "| * foo\n* bar\n" @?= Right (Table [ Row [BodyCell [List CircleBullets [ [Para [Str "foo"]] , [Para [Str "bar"]] ]]]]) , testCase "multiple line cells" $ parseJira table "| foo\nbar | baz |\n" @?= Right (Table [ Row [ BodyCell [Para [Str "foo", Linebreak, Str "bar"]] , BodyCell [Para [Str "baz"]]]]) , testCase "multiple lists in cell" $ parseJira table "| * foo\n- bar\n" @?= Right (Table [Row [BodyCell [ List CircleBullets [[Para [Str "foo"]]] , List SquareBullets [[Para [Str "bar"]]]]]]) ] , testGroup "code" [ testCase "no language" $ parseJira code "{code}\nprint('Hi Mom!'){code}\n" @?= Right (Code (Language "java") [] "print('Hi Mom!')") , testCase "with language" $ parseJira code "{code:swift}\nfunc foo() -> Int { return 4 }{code}\n" @?= Right (Code (Language "swift") [] "func foo() -> Int { return 4 }") , testCase "with parameters" $ parseJira code "{code:title=coffee|bgColor=#ccc}\nblack(){code}\n" @?= Right (Code (Language "java") [Parameter "title" "coffee", Parameter "bgColor" "#ccc"] "black()") , testCase "with language and parameter" $ parseJira code "{code:haskell|title=Hello World}\nputStrLn \"Hello, World!\"{code}\n" @?= Right (Code (Language "haskell") [Parameter "title" "Hello World"] "putStrLn \"Hello, World!\"") ] , testGroup "noformat" [ testCase "no parameters" $ parseJira noformat "{noformat}\nline 1\nline 2{noformat}\n" @?= Right (NoFormat [] "line 1\nline 2") , testCase "with parameters" $ parseJira noformat "{noformat:title=test}\nline 1\nline 2{noformat}\n" @?= Right (NoFormat [Parameter "title" "test"] "line 1\nline 2") ] , testGroup "panel" [ testCase "two-line paragraph" $ parseJira panel "{panel}\nline 1\nline 2\n{panel}\n" @?= Right (Panel [] [Para [Str "line", Space, Str "1", Linebreak, Str "line", Space, Str "2"]]) -- FIXME: the next two shouldn't require a blank line after the contents , testCase "list" $ parseJira panel "{panel}\n* first\n* second\n\n{panel}\n" @?= Right (Panel [] [List CircleBullets [ [Para [Str "first"]] , [Para [Str "second"]]]]) , testCase "with parameters" $ parseJira panel "{panel:title=test}\nline\n{panel}\n" @?= 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" @?= Right (BlockQuote [Para [Str "this", Space, Str "text"]]) , testCase "single line blockquote" $ parseJira blockQuote "bq. this test\n" @?= Right (BlockQuote [Para [Str "this", Space, Str "test"]]) , testCase "multi-paragraph block quote" $ parseJira blockQuote "{quote}\npara1\n\npara2\n{quote}\n" @?= Right (BlockQuote [ Para [Str "para1"] , Para [Str "para2"]]) , testCase "condensed block quote" $ parseJira blockQuote "{quote}life is good{quote}\n" @?= Right (BlockQuote [Para [Str "life", Space, Str "is", Space, Str "good"]]) ] ] , testGroup "block combinations" [ testCase "single paragraph" $ parseJira block "Lorem ipsum." @?= Right (Para [Str "Lorem", Space, Str "ipsum."]) , testCase "para before header" $ parseJira ((,) <$> block <*> block) "paragraph\nh1.header\n" @?= Right (Para [Str "paragraph"], Header 1 [Str "header"]) , 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" @?= Right (List CircleBullets [[Para [Str "foo"]]], Para [Str "bar"]) , testCase "successive lists of same type" $ parseJira ((,) <$> block <*> block) "* foo\n\n* bar\n" @?= Right ( List CircleBullets [[Para [Str "foo"]]] , List CircleBullets [[Para [Str "bar"]]]) , testCase "para before table" $ parseJira ((,) <$> block <*> block) "tabletest\n||Name|\n|Test|\n" @?= Right ( Para [Str "tabletest"] , Table [ Row [HeaderCell [Para [Str "Name"]]] , Row [BodyCell [Para [Str "Test"]]] ] ) , testCase "para after table" $ parseJira ((,) <$> block <*> block) "|| point |\nhuh\n" @?= Right ( Table [Row [HeaderCell [Para [Str "point"]]]] , Para [Str "huh"]) , testCase "para after blankline terminated table" $ parseJira ((,) <$> block <*> block) "|| love\n\npeace\n" @?= Right ( Table [Row [HeaderCell [Para [Str "love"]]]] , Para [Str "peace"]) , testCase "para before code" $ parseJira ((,) <$> block <*> block) "nice\n{code}\nhappy(){code}\n" @?= Right ( Para [Str "nice"] , Code (Language "java") [] "happy()") , testCase "para after code" $ parseJira ((,) <$> block <*> block) "{code}\nfn(){code}\ntext" @?= Right ( Code (Language "java") [] "fn()" , Para [Str "text"]) , testCase "para before noformat" $ parseJira ((,) <$> block <*> block) "wholesome\n{noformat}\nenjoy{noformat}\n" @?= Right ( Para [Str "wholesome"] , NoFormat [] "enjoy") , testCase "para after noformat" $ parseJira ((,) <$> block <*> block) "{noformat}\nlala{noformat}\ntext" @?= Right ( NoFormat [] "lala" , Para [Str "text"]) ] ] jira-wiki-markup-1.1.4/test/Text/Jira/Parser/InlineTests.hs0000644000000000000000000002637607346545000021730 0ustar0000000000000000{-| Module : Text.Jira.Parser.InlineTests Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : portable Tests for the jira wiki inline markup parsers. -} module Text.Jira.Parser.InlineTests (tests) where import Data.Either (isLeft) import Data.Text () import Text.Jira.Markup import Text.Jira.Parser.Core import Text.Jira.Parser.Inline import Text.Parsec (many1) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=), (@?)) tests :: TestTree tests = testGroup "Inline" [ testGroup "components" [ testGroup "str" [ testCase "simple word" $ parseJira str "word" @?= Right (Str "word") , testCase "non-special symbols" $ parseJira str ",.#%" @?= Right (Str ",.#%") , testCase "umlauts" $ parseJira str "äéíöüßðå" @?= Right (Str "äéíöüßðå") , testCase "mix of alphanums and non-special chars" $ parseJira str "20.09" @?= Right (Str "20.09") , testCase "space fails" $ isLeft (parseJira str " ") @? "str should only be parsed into Space" ] , testGroup "specialChar" [ testCase "plain special char" $ parseJira specialChar "!" @?= Right (SpecialChar '!') , testCase "escaped symbol" $ 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 , testCase "tab" $ isLeft (parseJira whitespace "\t") @? "TAB is not considered whitespace" , testCase "nonbreaking space fails" $ isLeft (parseJira whitespace "\160") @? "NBSP is not considered whitespace" , testCase "zero width space fails" $ isLeft (parseJira whitespace "\8203") @? "ZWSP is not considered whitespace" , testCase "newline fails" $ isLeft (parseJira whitespace "\n") @? "newline is not considered whitespace" ] , testGroup "entity" [ testCase "named entity" $ parseJira entity "©" @?= Right (Entity "copy") , testCase "numerical entity" $ parseJira entity "A" @?= Right (Entity "#65") , testCase "invalid entity" $ parseJira entity "&haskell;" @?= Right (Entity "haskell") , testCase "space" $ isLeft (parseJira entity "&a b;") @? "entities may not contain spaces" , testCase "symbol" $ isLeft (parseJira entity "&a-b;") @? "entities may not contain symbols" , testCase "number without hash" $ isLeft (parseJira entity "&65;") @? "numerical entities must start with &#" , testCase "no name" $ isLeft (parseJira entity "&;") @? "entities must not be empty" ] , testGroup "styled" [ testCase "deleted" $ parseJira styled "-far-fetched-" @?= Right (Styled Strikeout [Str "far", SpecialChar '-', Str "fetched"]) , testGroup "emphasis" [ testCase "single word" $ parseJira styled "_single_" @?= Right (Styled Emphasis [Str "single"]) , testCase "multi word" $ parseJira styled "_multiple words_" @?= Right (Styled Emphasis [Str "multiple", Space, Str "words"]) , testCase "forced markup" $ parseJira styled "{_}forced{_}" @?= Right (Styled Emphasis [Str "forced"]) , testCase "symbol before opening underscore" $ parseJira (str *> styled) "#_bar_" @?= Right (Styled Emphasis [Str "bar"]) , testCase "neither symbol nor space before opening underscore" $ isLeft (parseJira (str *> styled) "foo_bar_") @? "space after opening char" , testCase "disallow space after opening underscore" $ isLeft (parseJira styled "_ nope_") @? "space after underscore" , testCase "require word boundary after closing underscore" $ isLeft (parseJira styled "_nope_nope") @? "no boundary after closing" , 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"]) , testGroup "linebreak" [ testCase "linebreak before text" $ 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" , testCase "linebreak before blank line fails" $ isLeft (parseJira linebreak "\n\n") @? "newline before blank line" , testCase "linebreak before list fails" $ isLeft (parseJira linebreak "\n\n") @? "newline before list" , testCase "linebreak before header fails" $ isLeft (parseJira linebreak "\nh1.foo\n") @? "newline before header" , testCase "three backslashes do not cause a linebreak" $ isLeft (parseJira linebreak "\\\\\\") @? "three backslashes" ] , 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]" @?= Right (Link [] (URL "https://example.org")) , testCase "aliased link" $ parseJira link "[Example|https://example.org]" @?= Right (Link [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"] (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")) , testCase "no newlines" $ isLeft (parseJira image "!hello\nworld.png!") @? "no newlines in image names" , testCase "thumbnail" $ parseJira image "!image.png|thumbnail!" @?= Right (Image [Parameter "thumbnail" ""] (URL "image.png")) , testCase "parameters" $ parseJira image "!image.gif|align=right, vspace=4!" @?= let params = [ Parameter "align" "right" , Parameter "vspace" "4" ] in Right (Image params (URL "image.gif")) ] , testGroup "color" [ testCase "colored word" $ parseJira colorInline "{color:red}red{color}" @?= Right (ColorInline (ColorName "red") [Str "red"]) , testCase "hex color" $ parseJira colorInline "{color:#526487}blueish{color}" @?= Right (ColorInline (ColorName "#526487") [Str "blueish"]) , testCase "hex color without hash" $ parseJira colorInline "{color:526487}blueish{color}" @?= Right (ColorInline (ColorName "#526487") [Str "blueish"]) ] ] , testGroup "inline parser" [ testCase "simple sentence" $ parseJira (normalizeInlines <$> many1 inline) "Hello, World!" @?= Right [Str "Hello,", Space, Str "World", SpecialChar '!'] , testCase "with entity" $ parseJira (many1 inline) "shopping at P&C" @?= Right [ Str "shopping", Space, Str "at", Space , 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", SpecialChar ':', 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", SpecialChar ':', 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"] , testCase "color in sentence" $ parseJira (many1 inline) "This is {color:red}red{color}." @?= Right [ Str "This", Space, Str "is", Space , ColorInline (ColorName "red") [Str "red"] , Str "." ] , testCase "hypen between numbers" $ -- the hypens used to be treated as deletion markers. parseJira (many1 inline) "-15 02-3" @?= Right [ SpecialChar '-', Str "15" , Space, Str "02" , SpecialChar '-', Str "3" ] ] ] jira-wiki-markup-1.1.4/test/Text/Jira/0000755000000000000000000000000007346545000015661 5ustar0000000000000000jira-wiki-markup-1.1.4/test/Text/Jira/ParserTests.hs0000644000000000000000000000265007346545000020477 0ustar0000000000000000{-| Module : Text.Jira.ParserTests Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : portable Tests for the jira wiki parser. -} module Text.Jira.ParserTests (tests) where 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 tests :: TestTree 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 '*'] ] ] jira-wiki-markup-1.1.4/test/Text/Jira/PrinterTests.hs0000644000000000000000000001264207346545000020670 0ustar0000000000000000{-| Module : Text.Jira.PrinterTests Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel 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!*" , testCase "Colored inlines" $ renderInline (ColorInline (ColorName "red") [Str "This", Space, Str "is", Space, Str "red."]) @?= "{color:red}This is red.{color}" ] , 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_." , testCase "colon as last character" $ prettyInlines [Str "end", SpecialChar ':'] @?= "end:" , testCase "semicolon is escaped before close paren" $ -- would be treated as "winking smiley" otherwise prettyInlines [SpecialChar ';', Str ")"] @?= "\\;)" , testCase "colon is not escaped before space" $ prettyInlines [SpecialChar ':', Space, Str "end"] @?= ": end" , testCase "colon not escaped before opening paren" $ -- escaping the paren is enough prettyInlines [SpecialChar ':', SpecialChar '('] @?= ":\\(" ] ] renderBlock' :: Block -> Text renderBlock' = withDefault . renderBlock jira-wiki-markup-1.1.4/test/0000755000000000000000000000000007346545000014050 5ustar0000000000000000jira-wiki-markup-1.1.4/test/jira-wiki-markup-test.hs0000644000000000000000000000114407346545000020544 0ustar0000000000000000{-| Module : Main Copyright : © 2019–2020 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : portable Tests for the jira-wiki-markup package. -} module Main (main) where 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 () main = defaultMain tests tests :: TestTree tests = testGroup "jira-wiki-markup" [ Text.Jira.ParserTests.tests , Text.Jira.PrinterTests.tests ]