jira-wiki-markup-1.5.1/0000755000000000000000000000000007346545000013072 5ustar0000000000000000jira-wiki-markup-1.5.1/CHANGELOG.md0000644000000000000000000001467607346545000014721 0ustar0000000000000000Changelog ========= `jira-wiki-markup` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. 1.5.1 ----- Released 2023-03-13. * Parser: Disallow image paths that start with a space. 1.5.0 ----- Released 2023-01-11. * Relaxed upper bounds for mtl, allow mtl 2.3. * Fixed handling of character sequences that would be interpreted as icons if they weren't followed by an alphanumeric character. See also [pandoc issue #8511][]. [pandoc issue #8511]: https://github.com/jgm/pandoc/issues/8511 1.4.0 ----- Released 2021-05-25. * Allow quoted image parameters. * Added support for "smart links". * **API Change**: Add new constructors `SmartCard` and `SmartLink` to Text.Jira.Markup.LinkType. 1.3.5 ----- Released 2021-05-24. * Allow spaces and most unicode characters in attachment links. * No longer require a newline character after `{noformat}`. * Only allow URI path segment characters in bare links. * The `file:` schema is no longer allowed in bare links; these rarely make sense. 1.3.4 ----- Released 2021-03-13. * Fixed parsing of autolinks (i.e., of bare URLs in the text). Previously an autolink would take up the rest of a line, as spaces were allowed characters in these items. * Emoji character sequences no longer cause parsing failures. This was due to missing backtracking when emoji parsing fails. * Block quotes are only rendered as `bq.` if they do not contain a linebreak. 1.3.3 ----- Released 2021-02-12. * Modified the Doc parser to skip leading blank lines. This fixes parsing of documents which start with multiple blank lines. * Prevent URLs within link aliases to be treated as autolinks. 1.3.2 ----- Released 2020-06-22. * Braces are now always escaped when printing; Jira treats braces specially, regardless of context. 1.3.1 ----- Released 2020-06-14 * Added support for links to anchors. * Styled text may not wrap across multiple lines; linebreaks in marked-up text are now forbidden. * Module Text.Jira.Parser.Core: new function `many1Till` which behaves like `manyTill`, but requires at least on element to be parsed. * Ensured the package works with GHC 8.10. 1.3.0 ----- Released 2020-04-04 * Support was added for additional syntax constructs: - citation markup (`??citation??`), - links to attachments (`[title^attachment.ext]`), and - user links (`[~username]`). * Changes to module `Text.Jira.Markup`: * A new data type `LinkType` is exported from the module. * Changes to type `Inline`: - a new constructor `Citation` has been added; - the `Link` constructor now takes an additional parameter of type `LinkType`. 1.2.1 ----- Released 2020-04-02 * Fixed rendering of image attributes: image attributes are separated by commas instead of pipes; the latter are used in block parameters. * Fixed parsing of blockquotes which are not preceeded by blank lines. * Ensure parsing of single-line blockquotes is possible even if there is no space between `bq.` marker and contents. * Fixed parsing of colors: parsing no longer fails for hexcolors which contain non-decimal digits. * Changes to module `Text.Jira.Parser.Shared`: - New parsing function `colorName` which parses a color descriptor, i.e. either a name or a hexcolor. 1.2.0 ----- Released 2020-03-28 * Added check that a closing markup char is not preceeded by a whitespace character. Previously, plain text was still incorrectly treated as markup. E.g., the dashes in `-> step ->` used to be interpreted as delimiters marking deleted text. * Allows empty table cells; table parsing failed if one of the cells did not contain any content. * Changes to module `Text.Jira.Parser.Core`: - A field `stateLastSpcPos` was added to data type `ParserState` to keep track of spaces. - Function `updateLastSpcPos` was added to update the aforementioned field. - Function `afterSpace` was added to test the field. 1.1.4 ----- Released 2020-03-27 * Fixed 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.5.1/LICENSE0000644000000000000000000000206707346545000014104 0ustar0000000000000000MIT License Copyright © 2019–2023 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.5.1/README.md0000644000000000000000000000265707346545000014363 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][License badge]](LICENSE) [![Stackage Lts][Stackage Lts badge]](http://stackage.org/lts/package/jira-wiki-markup) [![Stackage Nightly][Stackage Nightly badge]](http://stackage.org/nightly/package/jira-wiki-markup) [![GitHub build status][CI badge]][CI workflow] [![Windows build status][AppVeyor badge]](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. [License badge]: https://img.shields.io/badge/license-MIT-blue.svg [Stackage Lts badge]: http://stackage.org/package/jira-wiki-markup/badge/lts [Stackage Nightly badge]: http://stackage.org/package/jira-wiki-markup/badge/nightly [CI badge]: https://img.shields.io/github/actions/workflow/status/pandoc-ext/multibib/ci.yaml?logo=github&branch=main [AppVeyor badge]: https://ci.appveyor.com/api/projects/status/github/tarleb/jira-wiki-markup?branch=master&svg=true [Jira wiki markup]: https://jira.atlassian.com/secure/WikiRendererHelpAction.jspa?section=all [CI workflow]: https://github.com/tarleb/jira-wiki-markup/actions/workflows/ci.yaml # License This package is licensed under the MIT license. See the `LICENSE` file for details. jira-wiki-markup-1.5.1/app/0000755000000000000000000000000007346545000013652 5ustar0000000000000000jira-wiki-markup-1.5.1/app/Main.hs0000644000000000000000000000063507346545000015076 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.5.1/jira-wiki-markup.cabal0000644000000000000000000000652007346545000017244 0ustar0000000000000000cabal-version: 2.4 name: jira-wiki-markup version: 1.5.1 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–2023 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 , GHC == 8.10.4 , GHC == 9.0.2 , GHC == 9.2.5 , GHC == 9.4.4 source-repository head type: git location: https://github.com/tarleb/jira-wiki-markup.git common common-options build-depends: base >= 4.9 && < 5 , text >= 1.1.1 && < 1.3 || >= 2.0 && < 2.1 default-language: Haskell2010 default-extensions: OverloadedStrings ghc-options: -Wall -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wredundant-constraints -Wunused-type-patterns if impl(ghc >= 8.2) ghc-options: -Wmissing-home-modules if impl(ghc >= 8.4) ghc-options: -fhide-source-paths -Wpartial-fields if impl(ghc >= 8.10) ghc-options: -Wunused-packages if impl(ghc >= 9.0) ghc-options: -Winvalid-haddock library import: common-options 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: mtl >= 2.2 && < 2.4 , parsec >= 3.1 && < 3.2 executable jira-wiki-markup import: common-options hs-source-dirs: app main-is: Main.hs build-depends: jira-wiki-markup ghc-options: -threaded -rtsopts -with-rtsopts=-N test-suite jira-wiki-markup-test import: common-options 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: jira-wiki-markup , parsec >= 3.1 && < 3.2 , tasty , tasty-hunit ghc-options: -threaded -rtsopts -with-rtsopts=-N jira-wiki-markup-1.5.1/src/Text/Jira/0000755000000000000000000000000007346545000015472 5ustar0000000000000000jira-wiki-markup-1.5.1/src/Text/Jira/Markup.hs0000644000000000000000000001370307346545000017271 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-| Module : Text.Jira.Markup Copyright : © 2019–2023 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : portable Jira markup types. -} module Text.Jira.Markup ( Doc (..) , Block (..) , Inline (..) , InlineStyle (..) , LinkType (..) , 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 | Citation [Inline] -- ^ source of a citation | ColorInline ColorName [Inline] -- ^ colored inline text | Emoji Icon -- ^ emoticon | Entity Text -- ^ named or numeric HTML entity | Image [Parameter] URL -- ^ an image | Linebreak -- ^ hard linebreak | Link LinkType [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) -- | Type of a link. data LinkType = Attachment -- ^ link to an attachment | Email -- ^ link to an email address | External -- ^ external resource, like a website | SmartCard -- ^ smart-card link (external) | SmartLink -- ^ "smart" link with icon, short-name | User -- ^ link to a user 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.5.1/src/Text/Jira/Parser.hs0000644000000000000000000000157507346545000017272 0ustar0000000000000000{-| Module : Text.Jira.Parser Copyright : © 2019–2023 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 <$> (skipMany blankline *> many block) "doc" jira-wiki-markup-1.5.1/src/Text/Jira/Parser/0000755000000000000000000000000007346545000016726 5ustar0000000000000000jira-wiki-markup-1.5.1/src/Text/Jira/Parser/Block.hs0000644000000000000000000001454707346545000020327 0ustar0000000000000000{-| Module : Text.Jira.Parser.Block Copyright : © 2019–2023 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.Jira.Parser.Shared (colorName) 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 <- many 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 *> skipMany (char ' ') *> 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 '}' optional newline content <- anyChar `manyTill` try (string "{noformat}" *> optional 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 <* char '}' content <- block `manyTill` try (string "{color}" *> blankline) return $ Color (ColorName $ pack name) content -- | 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.5.1/src/Text/Jira/Parser/Core.hs0000644000000000000000000001277107346545000020162 0ustar0000000000000000{-| Module : Text.Jira.Parser.Core Copyright : © 2019–2023 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 , updateLastSpcPos , notAfterString , afterString , afterSpace -- * Parsing helpers , endOfPara , notFollowedBy' , many1Till , 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 , stateInMarkup :: Bool -- ^ whether the parser is within markup , stateInTable :: Bool -- ^ whether the parser is within a table , stateLastSpcPos :: Maybe SourcePos -- ^ most recent space char position , stateLastStrPos :: Maybe SourcePos -- ^ position at which the last string -- ended } -- | Default parser state (i.e., start state) defaultState :: ParserState defaultState = ParserState { stateInLink = False , stateInList = False , stateInMarkup = False , stateInTable = False , stateLastSpcPos = Nothing , 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 } -- | Updates the state, marking the current input position as the end of a -- string. updateLastSpcPos :: JiraParser () updateLastSpcPos = do pos <- getPosition modifyState $ \st -> st { stateLastSpcPos = Just pos } -- | Returns @'True'@ if the current parser position is directly -- after a word/string. Returns @'False'@ if the parser is -- looking at the first character of the input. afterString :: JiraParser Bool afterString = do curPos <- getPosition prevPos <- stateLastStrPos <$> getState return (Just curPos == prevPos) -- | Returns true when the current parser position is either at -- the beginning of the document or if the preceding characters -- did not belong to a string. notAfterString :: JiraParser Bool notAfterString = not <$> afterString -- | Returns @'True'@ iff the character before the current parser -- position was a space. afterSpace :: JiraParser Bool afterSpace = do curPos <- getPosition lastSpacePos <- stateLastSpcPos <$> getState return (Just curPos == lastSpacePos) -- | 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 '}')) -- | Like @manyTill@, but reads at least one item. many1Till :: (Show end) => JiraParser a -> JiraParser end -> JiraParser [a] many1Till p end = do notFollowedBy' end first <- p rest <- manyTill p end return (first:rest) -- | Succeeds if the parser is looking at the end of a paragraph. endOfPara :: JiraParser () endOfPara = eof <|> lookAhead blankline <|> lookAhead headerStart <|> lookAhead quoteStart <|> lookAhead horizontalRule <|> lookAhead listItemStart <|> lookAhead tableStart <|> lookAhead panelStart where headerStart = void $ char 'h' *> oneOf "123456" <* char '.' quoteStart = void $ string "bq." listItemStart = void $ skipSpaces *> many1 (oneOf "#*-") <* char ' ' tableStart = void $ skipSpaces *> many1 (char '|') panelStart = void $ char '{' *> choice (map (try . string) blockNames) horizontalRule = void $ try (string "----") *> blankline blockNames :: [String] blockNames = ["code", "color", "noformat", "panel", "quote"] -- | 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.5.1/src/Text/Jira/Parser/Inline.hs0000644000000000000000000002445207346545000020507 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} {-| Module : Text.Jira.Parser.Inline Copyright : © 2019–2023 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 , citation , colorInline , dash , emoji , entity , image , linebreak , link , monospaced , specialChar , str , styled , whitespace -- * Constants , specialChars ) where import Control.Monad (guard, void) import Data.Char (isAlphaNum, isAscii, isPunctuation, isSpace, 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 , citation , 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 $ do guard . not . stateInMarkup =<< getState choice [ void $ newline <* notFollowedBy' endOfPara , void $ string "\\\\" <* notFollowedBy' (char '\\') ] updateLastSpcPos return Linebreak -- | Parses whitespace and return a @Space@ element. whitespace :: JiraParser Inline whitespace = Space <$ skipMany1 (char ' ') <* updateLastSpcPos "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 = try (Emoji <$> icon "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 'SpecialChar'. specialChar :: JiraParser Inline specialChar = SpecialChar <$> (backslash <|> escapedChar <|> plainSpecialChar) "special char" where -- backslash before an icon-sequence that's not an emoji does *not* -- work as an escape character. backslash = try (char '\\' <* lookAhead (icon' *> alphaNum)) 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 '!' *> lookAhead (satisfy $ not . isSpace) *> (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 <$> (try quotedValue <|> unquotedValue) comma = char ',' *> skipSpaces quotedValue = char '"' *> manyTill (noneOf "\n\r") (char '"') unquotedValue = many1 (noneOf ",\"'\n\r|{}=!") -- | 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, sep) <- option ([], '|') . try $ (,) <$> many inline <*> oneOf "^|" (linkType, linkURL) <- if sep == '|' then (Email,) <$> email <|> (External,) <$> anchorLink <|> (User,) <$> userLink <|> externalLink else (Attachment,) . URL . pack <$> many1 (noneOf "\t\r\f\n]|:;/\\") _ <- char ']' return $ Link linkType alias linkURL -- | Parse a plain URL or mail address as @'AutoLink'@ element. autolink :: JiraParser Inline autolink = do guard . not . stateInLink =<< getState AutoLink <$> (email' <|> url True) "email or other URL" where email' = (\(URL e) -> URL ("mailto:" <> e)) <$> email -- | Parse a URL with scheme @file@, @ftp@, @http@, @https@, @irc@, -- @nntp@, or @news@; ignores @file@ if @isAutoLink@ is false. url :: Bool {-^ isAutoLink -} -> JiraParser URL url isAutoLink = try $ do let urlChar' = if isAutoLink then urlPathChar else urlChar <|> char ' ' 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" <$ (guard (not isAutoLink) *> 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 email URI, returns the mail address without schema. email :: JiraParser URL email = URL . pack <$> try (string "mailto:" *> many1 urlChar) -- | Parses the link to an anchor name. anchorLink :: JiraParser URL anchorLink = URL . pack <$> ((:) <$> char '#' <*> many1 urlChar) -- | Parses a user-identifying resource name userLink :: JiraParser URL userLink = URL . pack <$> (char '~' *> many (noneOf "|]\n\r")) -- | Parses an external link, i.e., either a plain link to an external -- website, or a \"smart\" link or card. externalLink :: JiraParser (LinkType, URL) externalLink = do url' <- url False mSmartType <- optionMaybe (char '|' *> smartLinkType) return $ case mSmartType of Nothing -> (External, url') Just st -> (st, url') -- | Finds the type of a "smart" link. smartLinkType :: JiraParser LinkType smartLinkType = string "smart-" *> choice [ SmartLink <$ string "link" , SmartCard <$ string "card" ] -- | Parses a character which is allowed in URLs urlChar :: JiraParser Char urlChar = satisfy $ \case ']' -> False -- "]" '|' -> False -- "|" x -> ord x > 32 && ord x <= 126 -- excludes space -- | Parses a character in an URL path. urlPathChar :: JiraParser Char urlPathChar = satisfy $ \case '!' -> True '#' -> True '$' -> True '%' -> True '&' -> True '\''-> True '(' -> True ')' -> True '*' -> True '+' -> True ',' -> True '-' -> True '.' -> True '/' -> True ':' -> True ';' -> True '=' -> True '?' -> True '@' -> True '\\'-> True '_' -> True '~' -> True x -> isAlphaNum x && isAscii x -- -- Color -- -- | Text in a different color. colorInline :: JiraParser Inline colorInline = try $ do name <- string "{color:" *> colorName <* char '}' content <- inline `manyTill` try (string "{color}") return $ ColorInline (ColorName $ pack name) content -- -- Markup -- -- | Parses styled text styled :: JiraParser Inline styled = (simpleStyled <|> forceStyled) "styled text" where simpleStyled = try $ do styleChar <- lookAhead $ oneOf "-_+*~^" content <- noNewlines $ 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 <- noNewlines $ manyTill inline closing return $ Styled style content -- | Makes sure that the wrapped parser does not parse inline -- linebreaks. noNewlines :: JiraParser a -> JiraParser a noNewlines = withStateFlag (\b st -> st { stateInMarkup = b }) -- | Returns the markup kind from the delimiting markup character. delimiterStyle :: Char -> InlineStyle delimiterStyle = \case '*' -> 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" citation :: JiraParser Inline citation = Citation <$> enclosed (try $ string "??") (try $ string "??") inline "citation" -- -- Helpers -- -- | Parse text delimited by a character. delimitingMany :: Char -> JiraParser a -> JiraParser [a] delimitingMany c = enclosed (char c) (char c) enclosed :: Show closing => JiraParser opening -> JiraParser closing -> JiraParser a -> JiraParser [a] enclosed opening closing parser = try $ do guard =<< notAfterString opening *> notFollowedBy space *> many1Till parser closing' where closing' = try $ do guard . not =<< afterSpace closing <* lookAhead wordBoundary wordBoundary = void (satisfy (not . isAlphaNum)) <|> eof jira-wiki-markup-1.5.1/src/Text/Jira/Parser/PlainText.hs0000644000000000000000000000254707346545000021202 0ustar0000000000000000{-| Module : Text.Jira.Parser.PlainText Copyright : © 2019–2023 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 <$> try icon plainSpecialChar :: Parsec Text u Inline plainSpecialChar = SpecialChar <$> oneOf specialChars jira-wiki-markup-1.5.1/src/Text/Jira/Parser/Shared.hs0000644000000000000000000000400307346545000020465 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-| Module : Text.Jira.Parser.Shared Copyright : © 2019–2023 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : portable Parsers whch are shared between multiple modules. -} module Text.Jira.Parser.Shared ( icon , icon' , colorName ) 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 = icon' <* notFollowedBy alphaNum -- | Like 'icon', but doesn't check whether the sequence is followed by -- a character that would prevent the interpretation as 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) colorName :: Parsec Text u String colorName = many1 letter <|> hexColor where hexColor = (:) <$> option '#' (char '#') <*> count 6 hexDigit jira-wiki-markup-1.5.1/src/Text/Jira/Printer.hs0000644000000000000000000002426407346545000017461 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-| Module : Text.Jira.Parser Copyright : © 2019–2023 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 -- Most special chars don't need escaping when surrounded by spaces or within -- a word. Braces are the exception, they should always be escaped. s@Str{} : SpecialChar c : rest@(Str {}:_) | not (isBrace c) -> (renderInline s `T.snoc` c) <> prettyInlines rest s@Space : SpecialChar c : rest@(Space {}:_) | not (isBrace c) -> (renderInline s `T.snoc` c) <> prettyInlines rest s@Linebreak : SpecialChar c : rest@(Space {}:_) | not (isBrace c) -> (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 -- Questionmarks don't have to be escaped unless in groups of two SpecialChar '?' : rest | not (startsWithQuestionMark rest) -> "?" <> prettyInlines rest (x:xs) -> renderInline x <> prettyInlines xs where isBrace = \case '{' -> True '}' -> True _ -> False startsWithAlphaNum t = case T.uncons t of Just (c, _) -> isAlphaNum c _ -> False isSmileyStr = \case Str x | x `elem` ["D", ")", "(", "P"] -> True _ -> False startsWithQuestionMark = \case SpecialChar '?' : _ -> 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] | Linebreak `notElem` xs -> return $ "bq. " <> prettyInlines xs BlockQuote blocks -> renderBlocks blocks >>= \blks -> return $ T.concat [ "{quote}\n" , blks , "{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 -> fromURL url Citation ils -> "??" <> prettyInlines ils <> "??" ColorInline color ils -> "{color:" <> colorText color <> "}" <> prettyInlines ils <> "{color}" Emoji icon -> iconText icon Entity entity -> "&" <> entity <> ";" Image ps url -> "!" <> fromURL url <> renderImageParams ps <> "!" Linebreak -> "\n" Link lt ils url -> renderLink lt ils 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 renderLink :: LinkType -> [Inline] -> URL -> Text renderLink linkType inlines url = case linkType of Attachment -> "[" <> prettyInlines inlines <> "^" <> fromURL url <> "]" Email -> link' $ "mailto:" <> fromURL url External -> link' $ fromURL url SmartCard -> smartLink (fromURL url) "smart-card" SmartLink -> smartLink (fromURL url) "smart-link" User -> link' $ "~" <> fromURL url where link' urlText = case inlines of [] -> "[" <> urlText <> "]" _ -> "[" <> prettyInlines inlines <> "|" <> urlText <> "]" smartLink urlText smartType = "[" <> prettyInlines inlines <> "|" <> urlText <> "|" <> smartType <> "]" delimiterChar :: InlineStyle -> Char delimiterChar = \case Emphasis -> '_' Insert -> '+' Strong -> '*' Strikeout -> '-' Subscript -> '~' Superscript -> '^' -- | Render image parameters (i.e., separate by comma). renderImageParams :: [Parameter] -> Text renderImageParams = \case [] -> "" ps | "thumbnail" `elem` map parameterKey ps -> "|thumbnail" ps -> "|" <> T.intercalate ", " (map renderParam ps) renderWrapped :: Char -> [Inline] -> Text renderWrapped c = T.cons c . flip T.snoc c . prettyInlines jira-wiki-markup-1.5.1/test/Text/Jira/Parser/0000755000000000000000000000000007346545000017116 5ustar0000000000000000jira-wiki-markup-1.5.1/test/Text/Jira/Parser/BlockTests.hs0000644000000000000000000004012407346545000021530 0ustar0000000000000000{-| Module : Text.Jira.Parser.BlockTests Copyright : © 2019–2023 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"]]]]]]) , testCase "empty cell in row" $ parseJira table (Text.unlines [ "|a|b|" , "| |b|" , "|a| |" ]) @?= Right (Table [ Row [BodyCell [Para [Str "a"]], BodyCell [Para [Str "b"]]] , Row [BodyCell [], BodyCell [Para [Str "b"]]] , Row [BodyCell [Para [Str "a"]], BodyCell []] ]) ] , 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") , testCase "without newline" $ parseJira noformat "{noformat}raw text{noformat}\n" @?= Right (NoFormat [] "raw text") ] , 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."]]) , testCase "paragraph preceeded by newline" $ parseJira color "{color:#cccccc}\nThis is gray.\n{color}\n" @?= Right (Color (ColorName "#cccccc") [Para [ Linebreak, Str "This", Space , Str "is", Space, Str "gray."]]) ] , testGroup "blockQuote" [ testCase "single line right 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 "single line w\\o leading space" $ parseJira blockQuote "bq.another test\n" @?= Right (BlockQuote [Para [Str "another", Space, Str "test"]]) , testCase "multiline block quote" $ parseJira blockQuote "{quote}\n quote\n me\n{quote}\n" @?= Right (BlockQuote [Para [Str "quote", Linebreak, Str "me"]]) , 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 before blockquote" $ parseJira ((,) <$> block <*> block) "before\nbq. a quote\n" @?= Right ( Para [Str "before"] , BlockQuote [Para [Str "a", Space, Str "quote"]]) , testCase "para after blockquote" $ parseJira ((,) <$> block <*> block) "bq. a quote\nafter\n" @?= Right ( BlockQuote [Para [Str "a", Space, Str "quote"]] , Para [Str "after"] ) , 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.5.1/test/Text/Jira/Parser/InlineTests.hs0000644000000000000000000003670207346545000021723 0ustar0000000000000000{-| Module : Text.Jira.Parser.InlineTests Copyright : © 2019–2023 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"]) , testCase "symbol before closing char" $ parseJira styled "-backwards<-" @?= Right (Styled Strikeout [Str "backwards<"]) , 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 "disallow newline in markup" $ isLeft (parseJira styled "_eol\nnext line_") @? "newline in markup" , testCase "zero with space as word boundary" $ parseJira ((,) <$> styled <*> str) "_yup_\8203next" @?= Right (Styled Emphasis [Str "yup"], Str "\8203next") ] , 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 "link followed by text" $ parseJira autolink "ftp://example.com/passwd has passwords" @?= Right (AutoLink (URL "ftp://example.com/passwd")) , testCase "email" $ parseJira autolink "mailto:nobody@test.invalid" @?= Right (AutoLink (URL "mailto:nobody@test.invalid")) , testCase "braces cannot be in bare links" $ parseJira autolink "https://example.edu/{*}" @?= Right (AutoLink (URL "https://example.edu/")) , testCase "file URIs are not autolinks" $ isLeft (parseJira autolink "file:///etc/fstab") @? "" ] , testGroup "citation" [ testCase "name" $ parseJira citation "??John Doe??" @?= Right (Citation [Str "John", Space, Str "Doe"]) , testCase "with markup" $ parseJira citation "??Jane *Example* Doe??" @?= Right (Citation [ Str "Jane", Space, Styled Strong [Str "Example"] , Space, Str "Doe"]) ] , testGroup "link" [ testCase "unaliased link" $ parseJira link "[https://example.org]" @?= Right (Link External [] (URL "https://example.org")) , testCase "aliased link" $ parseJira link "[Example|https://example.org]" @?= Right (Link External [Str "Example"] (URL "https://example.org")) , testCase "alias with emphasis" $ parseJira link "[_important_ example|https://example.org]" @?= Right (Link External [Styled Emphasis [Str "important"], Space, Str "example"] (URL "https://example.org")) , testCase "alias with URL" $ parseJira link "[https://example.org website|https://example.org]" @?= Right (Link External [ Str "https", SpecialChar ':', Str "//example.org" , Space, Str "website"] (URL "https://example.org")) , testCase "link to anchor" $ parseJira link "[see here|#there]" @?= Right (Link External [Str "see", Space, Str "here"] (URL "#there")) , testCase "mail address" $ parseJira link "[send mail|mailto:me@nope.invalid]" @?= Right (Link Email [Str "send", Space, Str "mail"] (URL "me@nope.invalid")) , testGroup "attachment link" [ testCase "simple attachment" $ parseJira link "[testing^test.xml]" @?= Right (Link Attachment [Str "testing"] (URL "test.xml")) , testCase "attachment without description" $ parseJira link "[^results.txt]" @?= Right (Link Attachment [] (URL "results.txt")) , testCase "filename with space and unicode" $ parseJira link "[^Straßenbahn Berlin.jpg]" @?= Right (Link Attachment [] (URL "Straßenbahn Berlin.jpg")) ] , testGroup "smart links" [ testCase "smart link" $ parseJira link "[hslua|https://github.com/hslua/hslua|smart-link]" @?= Right (Link SmartLink [Str "hslua"] (URL "https://github.com/hslua/hslua")) , testCase "smart card" $ parseJira link "[repo|https://github.com/tarleb/jira-wiki-markup|smart-card]" @?= Right (Link SmartCard [Str "repo"] (URL "https://github.com/tarleb/jira-wiki-markup")) ] , testCase "user link" $ parseJira link "[testing|~account-id:something]" @?= Right (Link User [Str "testing"] (URL "account-id:something")) , testCase "user without description" $ parseJira link "[~username]" @?= Right (Link User [] (URL "username")) ] , testGroup "image" [ 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")) , testCase "quoted parameter" $ parseJira image "!foo.jpg|alt=\"some foo!\"!" @?= let params = [ Parameter "alt" "some foo!"] in Right (Image params (URL "foo.jpg")) , testCase "first character cannot be a space" $ isLeft (parseJira image "! foo.jpg!") @? "An image cannot start with a space." ] , 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:526Ab7}blueish{color}" @?= Right (ColorInline (ColorName "#526Ab7") [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 "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 "smiley within word" $ parseJira (normalizeInlines <$> many1 inline) "C:DE" @?= Right [ Str "C", SpecialChar ':', Str "DE" ] , testCase "backslash is literal if it's not necessary" $ parseJira (normalizeInlines <$> many1 inline) "\\:PA" @?= Right [ SpecialChar '\\', SpecialChar ':', Str "PA"] , 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" ] , testCase "ascii arrows" $ -- the hypens used to be treated as deletion markers. parseJira (many1 inline) "-> step ->" @?= Right [ SpecialChar '-', Str ">" , Space, Str "step", Space , SpecialChar '-', Str ">" ] , testCase "long ascii arrow" $ parseJira (many1 inline) "click --> done" @?= Right [ Str "click", Space, SpecialChar '-', SpecialChar '-' , Str ">", Space, Str "done"] ] ] jira-wiki-markup-1.5.1/test/Text/Jira/0000755000000000000000000000000007346545000015662 5ustar0000000000000000jira-wiki-markup-1.5.1/test/Text/Jira/ParserTests.hs0000644000000000000000000000355307346545000020503 0ustar0000000000000000{-| Module : Text.Jira.ParserTests Copyright : © 2019–2023 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."]]) , testCase "leading blank lines" $ parse "\n\ntext\n" @?= Right (Doc [Para [Str "text"]]) ] , 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 "smiley and text" $ plainText ":D lol" @?= Right [Str "\\:D", Space, Str "lol"] , testCase "icon after word" $ plainText "f(x)" @?= Right [Str "f\\(x)"] , testCase "icon-sequence at start of word" $ plainText ":PA" @?= Right [SpecialChar ':', Str "PA"] , testCase "icon-sequence followed by digit" $ plainText ":P2" @?= Right [SpecialChar ':', Str "P2"] , testCase "special chars" $ plainText "*not strong*" @?= Right [SpecialChar '*', Str "not", Space, Str "strong", SpecialChar '*'] ] ] jira-wiki-markup-1.5.1/test/Text/Jira/PrinterTests.hs0000644000000000000000000002174107346545000020671 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module : Text.Jira.PrinterTests Copyright : © 2019–2023 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.String (IsString (fromString)) import Data.Text (Text, pack, 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 "block quote" [ testCase "single-line block quote" $ let bq = BlockQuote [Para [Str "Errare", Space, Str "humanum", Space, Str "est."] ] in prettyBlocks [bq] @?= "bq. Errare humanum est." , testCase "multi-line block quote" $ let bq = BlockQuote [Para [Str "Show", Linebreak, Str "me"]] in prettyBlocks [bq] @?= "{quote}\nShow\nme\n{quote}" , testCase "multi-paragraph block quote" $ let bq = BlockQuote [Para [Str "Only."], Para [Str "You."]] in prettyBlocks [bq] @?= "{quote}\nOnly.\n\nYou.\n{quote}" ] , testGroup "panel" [ testCase "simple panel" $ let panel = Panel [] [Para [Str "Contents!"]] in prettyBlocks [panel] @?= "{panel}\nContents!\n{panel}" , testCase "panel with title" $ let panel = Panel [Parameter "title" "Gimme"] [Para [Str "Contents!"]] in prettyBlocks [panel] @?= "{panel:title=Gimme}\nContents!\n{panel}" ] ] , testGroup "isolated inline" [ testCase "SpecialChar" $ renderInline (SpecialChar '*') @?= "\\*" , testCase "AutoLink" $ renderInline (AutoLink (URL "https://example.org")) @?= "https://example.org" , testCase "citation" $ renderInline (Citation [Str "John", Space, Str "Doe"]) @?= "??John Doe??" , testCase "Emoji" $ renderInline (Emoji IconSmiling) @?= ":D" , testCase "thumbnail" $ renderInline (Image [Parameter "thumbnail" ""] (URL "example.jpg")) @?= "!example.jpg|thumbnail!" , testCase "image attributes" $ let params = [Parameter "align" "right", Parameter "vspace" "4"] in renderInline (Image params (URL "example.jpg")) @?= "!example.jpg|align=right, vspace=4!" , testGroup "link" [ testCase "external link" $ renderInline (Link External [Str "example"] "https://example.org") @?= "[example|https://example.org]" , testCase "email link" $ renderInline (Link Email [Str "example"] "me@example.org") @?= "[example|mailto:me@example.org]" , testCase "attachment" $ renderInline (Link Attachment [Str "a", Space, Str "b"] "test.txt") @?= "[a b^test.txt]" , testCase "attachment without description" $ renderInline (Link Attachment [] "something.txt") @?= "[^something.txt]" , testCase "attachment with space and Unicode" $ renderInline (Link Attachment [] "Übergang links.txt") @?= "[^Übergang links.txt]" , testCase "user" $ renderInline (Link User [Str "John", Space, Str "Doe"] "ab34-cdef") @?= "[John Doe|~ab34-cdef]" , testCase "smart link" $ renderInline (Link SmartLink [Str "repo"] "https://github.com/tarleb/jira-wiki-markup") @?= "[repo|https://github.com/tarleb/jira-wiki-markup|smart-link]" , testCase "smart card" $ renderInline (Link SmartCard [Str "hslua"] "https://github.com/hslua/hslua") @?= "[hslua|https://github.com/hslua/hslua|smart-card]" ] , 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 "opening brace between words" $ prettyInlines [Str "a", SpecialChar '{', Str "b"] @?= "a\\{b" , testCase "other 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 is not escaped before non-emoji word" $ prettyInlines [Space, SpecialChar ':', Str "PA"] @?= " :PA" , testCase "closing brace between spaces" $ prettyInlines [Space, SpecialChar '}', Space] @?= " \\} " , testCase "colon not escaped before opening paren" $ -- escaping the paren is enough prettyInlines [SpecialChar ':', SpecialChar '('] @?= ":\\(" , testGroup "question marks" [ testCase "escaped if followed by question mark" $ prettyInlines [SpecialChar '?', SpecialChar '?'] @?= "\\??" , testCase "unescaped before space" $ prettyInlines [SpecialChar '?', Space, Str "foo"] @?= "? foo" ] ] ] renderBlock' :: Block -> Text renderBlock' = withDefault . renderBlock instance IsString URL where fromString = URL . pack jira-wiki-markup-1.5.1/test/0000755000000000000000000000000007346545000014051 5ustar0000000000000000jira-wiki-markup-1.5.1/test/jira-wiki-markup-test.hs0000644000000000000000000000114407346545000020545 0ustar0000000000000000{-| Module : Main Copyright : © 2019–2023 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 ]