packages feed

jira-wiki-markup (empty) → 0.1.0

raw patch · 14 files changed

+1411/−0 lines, 14 filesdep +basedep +jira-wiki-markupdep +parsec

Dependencies added: base, jira-wiki-markup, parsec, tasty, tasty-hunit, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog++`jira-wiki-markup` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++0.0.0+=====++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/tarleb/jira-wiki-markup/releases
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2019 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.
+ README.md view
@@ -0,0 +1,10 @@+# 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)++Handle Jira wiki markup
+ app/Main.hs view
@@ -0,0 +1,20 @@+{-|+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.cabal view
@@ -0,0 +1,93 @@+cabal-version:       2.0+name:                jira-wiki-markup+version:             0.1.0+synopsis:            Handle Jira wiki markup+description:         Handle Jira wiki markup+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 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.4++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++  build-depends:       base    >= 4.9   && < 5+                     , 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++  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
+ src/Text/Jira/Markup.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE LambdaCase #-}+{-|+Module      : Text.Jira.Markup+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+Stability   : alpha+Portability : portable++Jira markup types.+-}+module Text.Jira.Markup+  ( Block (..)+  , Inline (..)+  , ListStyle (..)+  , URL (..)+  , Row (..)+  , Cell (..)+  , Language (..)+  , Parameter (..)+  , normalizeInlines+  ) where++import Data.Text (Text, append)++-- | Inline Jira markup elements.+data Inline+  = Anchor Text              -- ^ anchor for internal links+  | Deleted [Inline]         -- ^ deleted (struk-out) text+  | Emph [Inline]            -- ^ emphasized text+  | Entity Text              -- ^ named or numeric HTML entity+  | Image URL                -- ^ an image+  | Inserted [Inline]        -- ^ text marked as having been inserted+  | Linebreak                -- ^ hard linebreak+  | Link [Inline] URL        -- ^ hyperlink with alias+  | Monospaced [Inline]      -- ^ text rendered with monospaced font+  | Str Text                 -- ^ simple, markup-less string+  | Space                    -- ^ space between words+  | Strong [Inline]          -- ^ strongly emphasized text+  | Subscript [Inline]       -- ^ subscript text+  | Superscript [Inline]     -- ^ superscript text+  deriving (Eq, Ord, Show)++-- | Blocks of text.+data Block+  = Code Language [Parameter] Text      -- ^ Code block with panel parameters+  | BlockQuote [Block]                  -- ^ Block of quoted content+  | Header Int [Inline]                 -- ^ Header with level and text+  | 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)++-- | 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)++-- | 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
+ src/Text/Jira/Parser.hs view
@@ -0,0 +1,29 @@+{-|+Module      : Text.Jira.Parser+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+Stability   : alpha+Portability : portable++Parse Jira wiki markup.+-}+module Text.Jira.Parser+  ( parse+  , module Text.Jira.Markup+  , module Text.Jira.Parser.Core+  , module Text.Jira.Parser.Inline+  , module Text.Jira.Parser.Block+  ) 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.Parsec hiding (parse)++-- | Parses a document into a list of blocks.+parse :: Text -> Either ParseError [Block]+parse = parseJira (many1 block)
+ src/Text/Jira/Parser/Block.hs view
@@ -0,0 +1,200 @@+{-|+Module      : Text.Jira.Parser.Block+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+Stability   : alpha+Portability : portable++Parse Jira wiki blocks.+-}+module Text.Jira.Parser.Block+  ( block+    -- * Parsers for block types+  , blockQuote+  , code+  , header+  , 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+  , code+  , noformat+  , panel+  , para+  ] <* skipWhitespace++-- | Parses a paragraph into a @Para@.+para :: JiraParser Block+para = (<?> "para") . try $ do+  isInList <- stateInList <$> getState+  when isInList $+    notFollowedBy' blankline+  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 . void $ count depth anyBulletMarker++    firstItemAtDepth :: Int -> JiraParser [Block]+    firstItemAtDepth depth = try $ listContent (depth + 1) <|>+      do+        blocks <- nonListContent+        nestedLists <- try . many $ listAtDepth (depth + 1)+        return $ blocks ++ nestedLists++    listItemAtDepth :: Int -> JiraParser Char -> JiraParser [Block]+    listItemAtDepth depth bulletChar = atDepth depth *>+        try (bulletChar *> nonListContent) <|>+        try (anyBulletMarker *> listContent depth)++    listContent :: Int -> JiraParser [Block]+    listContent depth = do+        first <- listAtDepth' depth+        rest <- many (listAtDepth depth)+        return (first : rest)++    anyBulletMarker :: JiraParser Char+    anyBulletMarker = oneOf "*-#"++    nonListContent :: JiraParser [Block]+    nonListContent = try $+      let nonListBlock = notFollowedBy' (many1 (oneOf "#-*")) *> block+      in char ' ' *> do+        first <- block+        rest  <- many nonListBlock+        return (first : rest)++-- | 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+  (lang, params) <- string "{code" *> parameters <* char '}' <* blankline+  content <- anyChar `manyTill` try (string "{code}" *> blankline)+  return $ Code lang params (pack content)++-- | 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 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 a set of panel parameters+parameters :: JiraParser (Language, [Parameter])+parameters = option (defaultLanguage, []) $ do+  _      <- char ':'+  lang   <- option defaultLanguage (try language)+  params <- try (Parameter <$> key <*> (char '=' *> value)) `sepBy` pipe+  return (lang, params)+  where+    defaultLanguage = Language (pack "java")+    pipe     = char '|'+    key      = pack <$> many1 (noneOf "\"'\t\n\r |{}=")+    value    = pack <$> many1 (noneOf "\"'\n\r|{}=")+    language = Language <$> key <* (pipe <|> lookAhead (char '}'))++-- | 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
+ src/Text/Jira/Parser/Core.hs view
@@ -0,0 +1,114 @@+{-|+Module      : Text.Jira.Parser.Core+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+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+  ) where++import Control.Monad (join, void)+import Data.Text (Text)+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++-- | Succeeds if the parser is looking at the end of a paragraph.+endOfPara :: JiraParser ()+endOfPara = eof+  <|> lookAhead blankline+  <|> lookAhead headerStart+  <|> lookAhead listItemStart+  <|> lookAhead tableStart+  <|> lookAhead panelStart+  where+    headerStart   = void $ char 'h' *> oneOf "123456" <* char '.'+    listItemStart = void $ many1 (oneOf "#*-") *> char ' '+    tableStart    = void $ skipSpaces *> many1 (char '|') *> char ' '+    panelStart    = void $ char '{' *> choice (map string blockNames)++blockNames :: [String]+blockNames = ["code", "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)
+ src/Text/Jira/Parser/Inline.hs view
@@ -0,0 +1,186 @@+{-|+Module      : Text.Jira.Parser.Inline+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+Stability   : alpha+Portability : portable++Parse Jira wiki inline markup.+-}++module Text.Jira.Parser.Inline+  ( inline+    -- * Inline component parsers+  , anchor+  , deleted+  , emph+  , entity+  , inserted+  , image+  , linebreak+  , link+  , monospaced+  , str+  , strong+  , subscript+  , superscript+  , symbol+  , whitespace+  ) where++import Control.Monad (guard, void)+import Data.Char (isLetter)+import Data.Monoid ((<>), All (..))+import Data.Text (pack, singleton)+import Text.Jira.Markup+import Text.Jira.Parser.Core+import Text.Parsec++-- | Parses any inline element.+inline :: JiraParser Inline+inline = notFollowedBy' blockEnd *> choice+  [ whitespace+  , str+  , linebreak+  , link+  , image+  , emph+  , strong+  , subscript+  , superscript+  , deleted+  , inserted+  , monospaced+  , anchor+  , entity+  , symbol+  ] <?> "inline"+  where+    blockEnd = char '{' *> choice (map string blockNames) <* char '}'++-- | Characters with a special meaning, i.e., those used for markup.+specialChars :: String+specialChars = " \n" ++ symbolChars++-- | Special characters which can be part of a string.+symbolChars :: String+symbolChars = "_+-*^~|[]{}!&"++-- | Parses an in-paragraph newline as a @Linebreak@ element.+linebreak :: JiraParser Inline+linebreak = Linebreak <$ try (newline <* notFollowedBy' endOfPara)+  <?> "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 <$> (alphaNums <|> otherNonSpecialChars) <?> "string"+  where+    alphaNums = many1 alphaNum <* updateLastStrPos+    otherNonSpecialChars = many1 (noneOf specialChars)++-- | 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 a special character symbol as a @Str@.+symbol :: JiraParser Inline+symbol = Str . singleton <$> (escapedChar <|> symbolChar)+  <?> "symbol"+  where+    escapedChar = try (char '\\' *> oneOf symbolChars)++    symbolChar = do+      inTablePred <- do+        b <- stateInTable <$> getState+        return $ if b then All . (/= '|') else mempty+      inLinkPred  <- do+        b <- stateInLink  <$> getState+        return $ if b then All . (`notElem` ("]|\n" :: String)) else mempty+      oneOf $ filter (getAll . (inTablePred <> inLinkPred)) symbolChars+++--+-- 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 = fmap (Image . URL . pack) . try $+  char '!' *> noneOf "\r\t\n" `manyTill` char '!'++-- | 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 '|')+    url   <- URL . pack <$> many1 (noneOf "|] \n")+    _ <- char ']'+    return $ Link alias url++--+-- Markup+--+-- | Parses deleted text into @Deleted@.+deleted :: JiraParser Inline+deleted = Deleted <$> ('-' `delimitingMany` inline) <?> "deleted"++-- | Parses emphasized text into @Emph@.+emph :: JiraParser Inline+emph = Emph <$> ('_' `delimitingMany` inline) <?> "emphasis"++-- | Parses inserted text into @Inserted@.+inserted :: JiraParser Inline+inserted = Inserted <$> ('+' `delimitingMany` inline) <?> "inserted"++-- | Parses monospaced text into @Monospaced@.+monospaced :: JiraParser Inline+monospaced = Monospaced+  <$> enclosed (try $ string "{{") (try $ string "}}") inline+  <?> "monospaced"++-- | Parses strongly emphasized text into @Strong@.+strong :: JiraParser Inline+strong = Strong <$> ('*' `delimitingMany` inline) <?> "strong"++-- | Parses subscript text into @Subscript@.+subscript :: JiraParser Inline+subscript = Subscript <$> ('~' `delimitingMany` inline) <?> "subscript"++-- | Parses superscript text into @Superscript@.+superscript :: JiraParser Inline+superscript = Superscript <$> ('^' `delimitingMany` inline) <?> "superscript"++--+-- Helpers+--++-- | 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 . isLetter)) <|> eof
+ test/Text/Jira/Parser/BlockTests.hs view
@@ -0,0 +1,363 @@+{-|+Module      : Text.Jira.Parser.BlockTests+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+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"])+      ]++    , 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 "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"+                   , "** nested"+                   , "* second"+                   ]+        in parseJira list text @?=+           Right (List CircleBullets+                  [ [ Para [Str "first"]+                    , List CircleBullets [[Para [Str "nested"]]]]+                  , [ Para [Str "second"]]])++      , 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"]]]+                    ]+                  ])+      ]++    , 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 "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 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 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"])+    ]+  ]
+ test/Text/Jira/Parser/InlineTests.hs view
@@ -0,0 +1,217 @@+{-|+Module      : Text.Jira.Parser.InlineTests+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+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 "space fails" $+        isLeft (parseJira str " ") @?+        "str should only be parsed into Space"+      ]++    , testGroup "symbol"+      [ testCase "special symbol" $+        parseJira symbol "!" @?= Right (Str "!")++      , testCase "escaped symbol" $+        parseJira symbol "\\{" @?= Right (Str "{")+      ]++    , 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 "&copy;" @?= Right (Entity "copy")++      , testCase "numerical entity" $+        parseJira entity "&#65;" @?= 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"+      ]++    , testCase "deleted" $+      parseJira deleted "-far-fetched-" @?=+      Right (Deleted [Str "far", Str "-", Str "fetched"])++    , testGroup "emph"+      [ testCase "single word" $+        parseJira emph "_single_" @?= Right (Emph [Str "single"])++      , testCase "multi word" $+        parseJira emph "_multiple words_" @?=+        Right (Emph [Str "multiple", Space, Str "words"])++      , testCase "symbol before opening underscore" $+        parseJira (str *> emph) "#_bar_" @?=+        Right (Emph [Str "bar"])++      , testCase "neither symbol nor space before opening underscore" $+        isLeft (parseJira (str *> emph) "foo_bar_") @? "space after opening char"++      , testCase "disallow space after opening underscore" $+        isLeft (parseJira emph "_ nope_") @? "space after underscore"++      , testCase "require word boundary after closing underscore" $+        isLeft (parseJira emph "_nope_nope") @? "no boundary after closing"++      , testCase "zero with space as word boundary" $+        parseJira ((,) <$> emph <*> str) "_yup_\8203next" @?=+        Right (Emph [Str "yup"], Str "\8203next")++      , testCase "fails for strong" $+        isLeft (parseJira emph "*strong*") @? "strong as emph"+      ]++    , testCase "inserted" $+      parseJira inserted "+multiple words+" @?=+      Right (Inserted [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 "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"+      ]++    , testGroup "strong"+      [ testCase "single word" $+        parseJira strong "*single*" @?= Right (Strong [Str "single"])++      , testCase "multi word" $+        parseJira strong "*multiple words*" @?=+        Right (Strong [Str "multiple", Space, Str "words"])++      , testCase "fails for emph" $+        isLeft (parseJira strong "_emph_") @? "emph as strong"+      ]++    , testCase "subscript" $+      parseJira subscript "~multiple words~" @?=+      Right (Subscript [Str "multiple", Space, Str "words"])++    , testCase "superscript" $+      parseJira superscript "^multiple words^" @?=+      Right (Superscript [Str "multiple", Space, Str "words"])++    , testCase "anchor" $+      parseJira anchor "{anchor:testing}" @?=+      Right (Anchor "testing")++    , testGroup "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 [Emph [Str "important"], Space, Str "example"]+                (URL "https://example.org"))+      ]++    , 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"+      ]+    ]++  , testGroup "inline parser"+    [ testCase "simple sentence" $+      parseJira (normalizeInlines <$> many1 inline) "Hello, World!" @?=+      Right [Str "Hello,", Space, Str "World!"]++    , testCase "with entity" $+      parseJira (many1 inline) "shopping at P&amp;C" @?=+      Right [ Str "shopping", Space, Str "at", Space+            , Str "P", Entity "amp", Str "C"]+    ]+  ]
+ test/Text/Jira/ParserTests.hs view
@@ -0,0 +1,23 @@+{-|+Module      : Text.Jira.ParserTests+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+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 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+  ]
+ test/jira-wiki-markup-test.hs view
@@ -0,0 +1,25 @@+{-|+Module      : Main+Copyright   : © 2019 Albert Krewinkel+License     : MIT++Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>+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++-- | Run the tests for jira-wiki-markup.+main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "jira-wiki-markup"+  [ Text.Jira.ParserTests.tests+  ]