+-- Stability : experimental
+-- Portability : portable
+--
+-- MMark parser.
+
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Text.MMark.Parser
+ ( MMarkErr (..)
+ , parse )
+where
+
+import Control.Applicative
+import Control.DeepSeq
+import Control.Monad
+import Control.Monad.State.Strict
+import Data.Bifunctor (Bifunctor (..))
+import Data.Data (Data)
+import Data.Default.Class
+import Data.List.NonEmpty (NonEmpty (..), (<|))
+import Data.Maybe (isNothing, fromJust, fromMaybe)
+import Data.Semigroup ((<>))
+import Data.Text (Text)
+import Data.Typeable (Typeable)
+import Data.Void
+import GHC.Generics
+import Text.MMark.Internal
+import Text.Megaparsec hiding (parse)
+import Text.Megaparsec.Char hiding (eol)
+import Text.URI (URI)
+import qualified Control.Applicative.Combinators.NonEmpty as NE
+import qualified Data.Char as Char
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Set as E
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.Yaml as Yaml
+import qualified Text.Email.Validate as Email
+import qualified Text.Megaparsec.Char.Lexer as L
+import qualified Text.URI as URI
+
+----------------------------------------------------------------------------
+-- Data types
+
+-- | Parser type we use internally.
+
+type Parser = Parsec MMarkErr Text
+
+-- | MMark custom parse errors.
+
+data MMarkErr
+ = YamlParseError String
+ -- ^ YAML error that occurred during parsing of a YAML block
+ | NonFlankingDelimiterRun (NonEmpty Char)
+ -- ^ This delimiter run should be in left- or right- flanking position
+ deriving (Eq, Ord, Show, Read, Generic, Typeable, Data)
+
+instance ShowErrorComponent MMarkErr where
+ showErrorComponent = \case
+ YamlParseError str ->
+ "YAML parse error: " ++ str
+ NonFlankingDelimiterRun dels ->
+ showTokens dels ++ " should be in left- or right- flanking position"
+
+instance NFData MMarkErr
+
+-- | Parser type for inlines.
+
+type IParser = StateT CharType (Parsec MMarkErr Text)
+
+-- | 'Inline' source pending parsing.
+
+data Isp = Isp SourcePos Text
+ deriving (Eq, Ord, Show)
+
+-- | Type of last seen character.
+
+data CharType
+ = SpaceChar -- ^ White space
+ | LeftFlankingDel -- ^ Left flanking delimiter
+ | RightFlankingDel -- ^ Right flaking delimiter
+ | OtherChar -- ^ Other character
+ deriving (Eq, Ord, Show)
+
+-- | Frame that describes where we are in parsing inlines.
+
+data InlineFrame
+ = EmphasisFrame -- ^ Emphasis with asterisk @*@
+ | EmphasisFrame_ -- ^ Emphasis with underscore @_@
+ | StrongFrame -- ^ Strong emphasis with asterisk @**@
+ | StrongFrame_ -- ^ Strong emphasis with underscore @__@
+ | StrikeoutFrame -- ^ Strikeout
+ | SubscriptFrame -- ^ Subscript
+ | SuperscriptFrame -- ^ Superscript
+ deriving (Eq, Ord, Show)
+
+-- | State of inline parsing that specifies whether we expect to close one
+-- frame or there is a possibility to close one of two alternatives.
+
+data InlineState
+ = SingleFrame InlineFrame -- ^ One frame to be closed
+ | DoubleFrame InlineFrame InlineFrame -- ^ Two frames to be closed
+ deriving (Eq, Ord, Show)
+
+-- | Configuration in inline parser.
+
+data InlineConfig = InlineConfig
+ { iconfigAllowEmpty :: !Bool
+ -- ^ Whether to accept empty inline blocks
+ , iconfigAllowLinks :: !Bool
+ -- ^ Whether to parse links
+ , iconfigAllowImages :: !Bool
+ -- ^ Whether to parse images
+ }
+
+instance Default InlineConfig where
+ def = InlineConfig
+ { iconfigAllowEmpty = True
+ , iconfigAllowLinks = True
+ , iconfigAllowImages = True
+ }
+
+-- | A shortcut type synonym for sub-parsers that may fail and we can
+-- recover from the failure.
+
+type E = Either (ParseError Char MMarkErr)
+
+----------------------------------------------------------------------------
+-- Block parser
+
+-- | Parse a markdown document in the form of a strict 'Text' value and
+-- either report parse errors or return a 'MMark' document. Note that the
+-- parser has the ability to report multiple parse errors at once.
+
+parse
+ :: String
+ -- ^ File name (only to be used in error messages), may be empty
+ -> Text
+ -- ^ Input to parse
+ -> Either (NonEmpty (ParseError Char MMarkErr)) MMark
+ -- ^ Parse errors or parsed document
+parse file input =
+ case runParser ((,) <$> optional pYamlBlock <*> pBlocks) file input of
+ -- NOTE This parse error only happens when document structure on block
+ -- level cannot be parsed even with recovery, which should not normally
+ -- happen.
+ Left err -> Left (nes err)
+ Right (myaml, blocks) ->
+ let parsed = doInline <$> blocks
+ doInline = \case
+ Left err -> Naked (Left err)
+ Right x -> first (replaceEof "end of inline block")
+ . runIsp (pInlines def <* eof) <$> x
+ getErrs (Left e) es = e : es
+ getErrs _ es = es
+ fromRight (Right x) = x
+ fromRight _ =
+ error "Text.MMark.Parser.parse: the impossible happened"
+ in case NE.nonEmpty (foldMap (foldr getErrs []) parsed) of
+ Nothing -> Right MMark
+ { mmarkYaml = myaml
+ , mmarkBlocks = fmap fromRight <$> parsed
+ , mmarkExtension = mempty }
+ Just es -> Left es
+
+pYamlBlock :: Parser Yaml.Value
+pYamlBlock = do
+ dpos <- getPosition
+ string "---" *> sc' *> eol
+ let go = do
+ l <- takeWhileP Nothing notNewline
+ void (optional eol)
+ e <- atEnd
+ if e || T.stripEnd l == "---"
+ then return []
+ else (l :) <$> go
+ ls <- go
+ case (Yaml.decodeEither . TE.encodeUtf8 . T.intercalate "\n") ls of
+ Left err' -> do
+ let (apos, err) = splitYamlError (sourceName dpos) err'
+ setPosition (fromMaybe dpos apos)
+ (fancyFailure . E.singleton . ErrorCustom . YamlParseError) err
+ Right v ->
+ return v
+
+pBlocks :: Parser [E (Block Isp)]
+pBlocks = do
+ setTabWidth (mkPos 4)
+ sc *> manyTill pBlock eof
+
+pBlock :: Parser (E (Block Isp))
+pBlock = choice
+ [ try (pure <$> pThematicBreak)
+ , pAtxHeading
+ , pure <$> pFencedCodeBlock
+ , try (pure <$> pIndentedCodeBlock)
+ , pure <$> pParagraph ]
+
+pThematicBreak :: Parser (Block Isp)
+pThematicBreak = do
+ void casualLevel
+ l <- lookAhead nonEmptyLine
+ if isThematicBreak l
+ then ThematicBreak <$ nonEmptyLine <* sc
+ else empty
+
+pAtxHeading :: Parser (E (Block Isp))
+pAtxHeading = do
+ (void . lookAhead . try) start
+ withRecovery recover $ do
+ hlevel <- length <$> start
+ sc1'
+ ispPos <- getPosition
+ r <- someTill (satisfy notNewline "heading character") . try $
+ optional (sc1' *> some (char '#') *> sc') *> (eof <|> eol)
+ let toBlock = case hlevel of
+ 1 -> Heading1
+ 2 -> Heading2
+ 3 -> Heading3
+ 4 -> Heading4
+ 5 -> Heading5
+ _ -> Heading6
+ (Right . toBlock) (Isp ispPos (T.strip (T.pack r))) <$ sc
+ where
+ start = casualLevel *> count' 1 6 (char '#')
+ recover err =
+ Left err <$ takeWhileP Nothing notNewline <* optional eol
+
+pFencedCodeBlock :: Parser (Block Isp)
+pFencedCodeBlock = do
+ level <- casualLevel
+ let p ch = try $ do
+ void $ count 3 (char ch)
+ n <- (+ 3) . length <$> many (char ch)
+ ml <- optional (T.strip <$> someEscapedWith notNewline "info string")
+ guard (maybe True (not . T.any (== '`')) ml)
+ return
+ (ch, n,
+ case ml of
+ Nothing -> Nothing
+ Just l ->
+ if T.null l
+ then Nothing
+ else Just l)
+ (ch, n, infoString) <- (p '`' <|> p '~') <* eol
+ let content = label "code block content" (option "" nonEmptyLine <* eol)
+ closingFence = try . label "closing code fence" $ do
+ void casualLevel'
+ void $ count n (char ch)
+ (void . many . char) ch
+ sc'
+ eof <|> eol
+ ls <- manyTill content closingFence
+ CodeBlock infoString (assembleCodeBlock level ls) <$ sc
+
+pIndentedCodeBlock :: Parser (Block Isp)
+pIndentedCodeBlock = do
+ initialIndent <- codeBlockLevel
+ let go ls = do
+ immediate <- lookAhead (True <$ try codeBlockLevel' <|> pure False)
+ eventual <- lookAhead (True <$ try codeBlockLevel <|> pure False)
+ if not immediate && not eventual
+ then return ls
+ else do
+ l <- option "" nonEmptyLine
+ continue <- eol'
+ if continue
+ then go (l:ls)
+ else return (l:ls)
+ -- NOTE This is a bit unfortunate, but it's difficult to guarantee
+ -- that preceding space is not yet consumed when we get to
+ -- interpreting input as an indented code block, so we need to restore
+ -- the space this way.
+ f x = T.replicate (unPos initialIndent - 1) " " <> x
+ g [] = []
+ g (x:xs) = f x : xs
+ ls <- g . reverse . dropWhile isBlank <$> go []
+ CodeBlock Nothing (assembleCodeBlock (mkPos 5) ls) <$ sc
+
+pParagraph :: Parser (Block Isp)
+pParagraph = do
+ void casualLevel
+ startPos <- getPosition
+ let go = do
+ ml <- lookAhead (optional nonEmptyLine)
+ case ml of
+ Nothing -> return []
+ Just l ->
+ if isBlank l
+ then return []
+ else do
+ void nonEmptyLine
+ continue <- eol'
+ (l :) <$> if continue then go else return []
+ l <- nonEmptyLine
+ continue <- eol'
+ ls <- if continue then go else return []
+ Paragraph (Isp startPos (assembleParagraph (l:ls))) <$ sc
+
+----------------------------------------------------------------------------
+-- Inline parser
+
+-- | Run a given parser on 'Isp'.
+
+runIsp
+ :: IParser a -- ^ The parser to run
+ -> Isp -- ^ Input for the parser
+ -> Either (ParseError Char MMarkErr) a -- ^ Result of parsing
+runIsp p (Isp startPos input) =
+ snd (runParser' (evalStateT p SpaceChar) pst)
+ where
+ pst = State
+ { stateInput = input
+ , statePos = nes startPos
+ , stateTokensProcessed = 0
+ , stateTabWidth = mkPos 4 }
+
+pInlines :: InlineConfig -> IParser (NonEmpty Inline)
+pInlines InlineConfig {..} =
+ if iconfigAllowEmpty
+ then nes (Plain "") <$ eof <|> stuff
+ else stuff
+ where
+ stuff = NE.some . label "inline content" . choice $
+ [ pCodeSpan ] <>
+ [ pInlineLink | iconfigAllowLinks ] <>
+ [ pImage | iconfigAllowImages ] <>
+ [ try (angel pAutolink) | iconfigAllowLinks ] <>
+ [ pEnclosedInline
+ , try pHardLineBreak
+ , pPlain ]
+ angel = between (char '<') (char '>')
+
+pCodeSpan :: IParser Inline
+pCodeSpan = do
+ n <- try (length <$> some (char '`'))
+ let finalizer = try $ do
+ void $ count n (char '`')
+ notFollowedBy (char '`')
+ r <- CodeSpan . collapseWhiteSpace . T.concat <$>
+ manyTill (label "code span content" $
+ takeWhile1P Nothing (== '`') <|>
+ takeWhile1P Nothing (/= '`'))
+ finalizer
+ put OtherChar
+ return r
+
+pInlineLink :: IParser Inline
+pInlineLink = do
+ xs <- between (char '[') (char ']') $
+ pInlines def { iconfigAllowLinks = False }
+ void (char '(') <* sc
+ dest <- pUri
+ mtitle <- optional (sc1 *> pTitle)
+ sc <* char ')'
+ put OtherChar
+ return (Link xs dest mtitle)
+
+pImage :: IParser Inline
+pImage = do
+ let nonEmptyDesc = char '!' *> between (char '[') (char ']')
+ (pInlines def { iconfigAllowImages = False })
+ alt <- nes (Plain "") <$ string "![]" <|> nonEmptyDesc
+ void (char '(') <* sc
+ src <- pUri
+ mtitle <- optional (sc1 *> pTitle)
+ sc <* char ')'
+ put OtherChar
+ return (Image alt src mtitle)
+
+pUri :: IParser URI
+pUri = do
+ uri <- between (char '<') (char '>') URI.parser <|> naked
+ put OtherChar
+ return uri
+ where
+ naked = do
+ startPos <- getPosition
+ input <- takeWhileP Nothing $ \x ->
+ not (isSpaceN x || x == ')')
+ let pst = State
+ { stateInput = input
+ , statePos = nes startPos
+ , stateTokensProcessed = 0
+ , stateTabWidth = mkPos 4 }
+ case snd (runParser' (URI.parser <* eof) pst) of
+ Left err' ->
+ case replaceEof "end of URI literal" err' of
+ TrivialError pos us es -> do
+ setPosition (NE.head pos)
+ failure us es
+ FancyError pos xs -> do
+ setPosition (NE.head pos)
+ fancyFailure xs
+ Right x -> return x
+
+pTitle :: IParser Text
+pTitle = choice
+ [ p '\"' '\"'
+ , p '\'' '\''
+ , p '(' ')' ]
+ where
+ p start end = between (char start) (char end) $
+ manyEscapedWith (/= end) "unescaped character"
+
+pAutolink :: IParser Inline
+pAutolink = do
+ notFollowedBy (char '>') -- empty links don't make sense
+ uri <- URI.parser
+ put OtherChar
+ return $ case isEmailUri uri of
+ Nothing ->
+ let txt = (nes . Plain . URI.render) uri
+ in Link txt uri Nothing
+ Just email ->
+ let txt = nes (Plain email)
+ uri' = URI.makeAbsolute mailtoScheme uri
+ in Link txt uri' Nothing
+
+pEnclosedInline :: IParser Inline
+pEnclosedInline = do
+ let noEmpty = def { iconfigAllowEmpty = False }
+ st <- choice
+ [ pLfdr (DoubleFrame StrongFrame StrongFrame)
+ , pLfdr (DoubleFrame StrongFrame EmphasisFrame)
+ , pLfdr (SingleFrame StrongFrame)
+ , pLfdr (SingleFrame EmphasisFrame)
+ , pLfdr (DoubleFrame StrongFrame_ StrongFrame_)
+ , pLfdr (DoubleFrame StrongFrame_ EmphasisFrame_)
+ , pLfdr (SingleFrame StrongFrame_)
+ , pLfdr (SingleFrame EmphasisFrame_)
+ , pLfdr (DoubleFrame StrikeoutFrame StrikeoutFrame)
+ , pLfdr (DoubleFrame StrikeoutFrame SubscriptFrame)
+ , pLfdr (SingleFrame StrikeoutFrame)
+ , pLfdr (SingleFrame SubscriptFrame)
+ , pLfdr (SingleFrame SuperscriptFrame) ]
+ case st of
+ SingleFrame x ->
+ liftFrame x <$> pInlines noEmpty <* pRfdr x
+ DoubleFrame x y -> do
+ inlines0 <- pInlines noEmpty
+ thisFrame <- pRfdr x <|> pRfdr y
+ let thatFrame = if x == thisFrame then y else x
+ immediate <- True <$ pRfdr thatFrame <|> pure False
+ if immediate
+ then (return . liftFrame thatFrame . nes . liftFrame thisFrame) inlines0
+ else do
+ inlines1 <- pInlines noEmpty
+ void (pRfdr thatFrame)
+ return . liftFrame thatFrame $
+ liftFrame thisFrame inlines0 <| inlines1
+
+pLfdr :: InlineState -> IParser InlineState
+pLfdr st = try $ do
+ let dels = inlineStateDel st
+ mpos <- getNextTokenPosition
+ void (string dels)
+ leftChar <- get
+ mrightChar <- lookAhead (optional anyChar)
+ let failNow = do
+ forM_ mpos setPosition
+ (mmarkErr . NonFlankingDelimiterRun . toNesTokens) dels
+ case (leftChar, isTransparent <$> mrightChar) of
+ (_, Nothing) -> failNow
+ (_, Just True) -> failNow
+ (RightFlankingDel, _) -> failNow
+ (OtherChar, _) -> failNow
+ (SpaceChar, _) -> return ()
+ (LeftFlankingDel, _) -> return ()
+ put LeftFlankingDel
+ return st
+
+pRfdr :: InlineFrame -> IParser InlineFrame
+pRfdr frame = try $ do
+ let dels = inlineFrameDel frame
+ mpos <- getNextTokenPosition
+ void (string dels)
+ leftChar <- get
+ mrightChar <- lookAhead (optional anyChar)
+ let failNow = do
+ forM_ mpos setPosition
+ (mmarkErr . NonFlankingDelimiterRun . toNesTokens) dels
+ case (leftChar, mrightChar) of
+ (SpaceChar, _) -> failNow
+ (LeftFlankingDel, _) -> failNow
+ (_, Nothing) -> return ()
+ (_, Just rightChar) ->
+ if | isTransparent rightChar -> return ()
+ | isMarkupChar rightChar -> return ()
+ | otherwise -> failNow
+ put RightFlankingDel
+ return frame
+
+pHardLineBreak :: IParser Inline
+pHardLineBreak = do
+ void (char '\\')
+ eol
+ notFollowedBy eof
+ sc'
+ put SpaceChar
+ return LineBreak
+
+pPlain :: IParser Inline
+pPlain = Plain . T.pack <$> some
+ (pEscapedChar <|> pNewline <|> pNonEscapedChar)
+ where
+ pEscapedChar = escapedChar <* put OtherChar
+ pNewline = hidden . try $
+ '\n' <$ sc' <* eol <* sc' <* put SpaceChar
+ pNonEscapedChar = label "unescaped non-markup character" . choice $
+ [ try (char '\\' <* notFollowedBy eol) <* put OtherChar
+ , try (char '!' <* notFollowedBy (char '[')) <* put SpaceChar
+ , try (char '<' <* notFollowedBy (pAutolink <* char '>')) <* put OtherChar
+ , spaceChar <* put SpaceChar
+ , satisfy isTrans <* put SpaceChar
+ , satisfy isOther <* put OtherChar ]
+ isTrans x = isTransparentPunctuation x && x /= '!'
+ isOther x = not (isMarkupChar x) && x /= '\\' && x /= '!' && x /= '<'
+
+----------------------------------------------------------------------------
+-- Parsing helpers
+
+casualLevel :: Parser Pos
+casualLevel = L.indentGuard sc LT (mkPos 5)
+
+casualLevel' :: Parser Pos
+casualLevel' = L.indentGuard sc' LT (mkPos 5)
+
+codeBlockLevel :: Parser Pos
+codeBlockLevel = L.indentGuard sc GT (mkPos 4)
+
+codeBlockLevel' :: Parser Pos
+codeBlockLevel' = L.indentGuard sc' GT (mkPos 4)
+
+nonEmptyLine :: Parser Text
+nonEmptyLine = takeWhile1P Nothing notNewline
+
+manyEscapedWith :: MonadParsec e Text m => (Char -> Bool) -> String -> m Text
+manyEscapedWith f l = T.pack <$> many (escapedChar <|> (satisfy f l))
+
+someEscapedWith :: MonadParsec e Text m => (Char -> Bool) -> m Text
+someEscapedWith f = T.pack <$> some (escapedChar <|> satisfy f)
+
+escapedChar :: MonadParsec e Text m => m Char
+escapedChar = try (char '\\' *> satisfy isAsciiPunctuation)
+ "escaped character"
+
+sc :: MonadParsec e Text m => m ()
+sc = void $ takeWhileP (Just "white space") isSpaceN
+
+sc1 :: MonadParsec e Text m => m ()
+sc1 = void $ takeWhile1P (Just "white space") isSpaceN
+
+sc' :: MonadParsec e Text m => m ()
+sc' = void $ takeWhileP (Just "white space") isSpace
+
+sc1' :: MonadParsec e Text m => m ()
+sc1' = void $ takeWhile1P (Just "white space") isSpace
+
+eol :: MonadParsec e Text m => m ()
+eol = void . label "newline" $ choice
+ [ string "\n"
+ , string "\r\n"
+ , string "\r" ]
+
+eol' :: MonadParsec e Text m => m Bool
+eol' = option False (True <$ eol)
+
+----------------------------------------------------------------------------
+-- Block-level predicates
+
+isThematicBreak :: Text -> Bool
+isThematicBreak l' = T.length l >= 3 && indentLevel l' < 4 &&
+ (T.all (== '*') l ||
+ T.all (== '-') l ||
+ T.all (== '_') l)
+ where
+ l = T.filter (not . isSpace) l'
+
+----------------------------------------------------------------------------
+-- Other helpers
+
+isSpace :: Char -> Bool
+isSpace x = x == ' ' || x == '\t'
+
+isSpaceN :: Char -> Bool
+isSpaceN x = isSpace x || x == '\n' || x == '\r'
+
+notNewline :: Char -> Bool
+notNewline x = x /= '\n' && x /= '\r'
+
+isBlank :: Text -> Bool
+isBlank = T.all isSpace
+
+isMarkupChar :: Char -> Bool
+isMarkupChar = \case
+ '*' -> True
+ '~' -> True
+ '_' -> True
+ '`' -> True
+ '^' -> True
+ '[' -> True
+ ']' -> True
+ _ -> False
+
+isAsciiPunctuation :: Char -> Bool
+isAsciiPunctuation x =
+ (x >= '!' && x <= '/') ||
+ (x >= ':' && x <= '@') ||
+ (x >= '[' && x <= '`') ||
+ (x >= '{' && x <= '~')
+
+isTransparentPunctuation :: Char -> Bool
+isTransparentPunctuation = \case
+ '!' -> True
+ '"' -> True
+ '(' -> True
+ ')' -> True
+ ',' -> True
+ '-' -> True
+ '.' -> True
+ ':' -> True
+ ';' -> True
+ '?' -> True
+ '{' -> True
+ '}' -> True
+ '–' -> True
+ '—' -> True
+ _ -> False
+
+isTransparent :: Char -> Bool
+isTransparent x = Char.isSpace x || isTransparentPunctuation x
+
+nes :: a -> NonEmpty a
+nes a = a :| []
+
+assembleParagraph :: [Text] -> Text
+assembleParagraph = go
+ where
+ go [] = ""
+ go [x] = T.dropWhileEnd isSpace x
+ go (x:xs) = x <> "\n" <> go xs
+
+assembleCodeBlock :: Pos -> [Text] -> Text
+assembleCodeBlock indent ls = T.unlines (stripIndent indent <$> ls)
+
+indentLevel :: Text -> Int
+indentLevel = T.foldl' f 0 . T.takeWhile isSpace
+ where
+ f n ch
+ | ch == ' ' = n + 1
+ | ch == '\t' = n + 4
+ | otherwise = n
+
+stripIndent :: Pos -> Text -> Text
+stripIndent indent txt = T.drop m txt
+ where
+ m = snd $ T.foldl' f (0, 0) (T.takeWhile isSpace txt)
+ f (!j, !n) ch
+ | j >= i = (j, n)
+ | ch == ' ' = (j + 1, n + 1)
+ | ch == '\t' = (j + 4, n + 1)
+ | otherwise = (j, n)
+ i = unPos indent - 1
+
+collapseWhiteSpace :: Text -> Text
+collapseWhiteSpace =
+ T.stripEnd . T.filter (/= '\0') . snd . T.mapAccumL f True
+ where
+ f seenSpace ch =
+ case (seenSpace, g ch) of
+ (False, False) -> (False, ch)
+ (True, False) -> (False, ch)
+ (False, True) -> (True, ' ')
+ (True, True) -> (True, '\0')
+ g ' ' = True
+ g '\t' = True
+ g '\n' = True
+ g _ = False
+
+inlineFrameDel :: InlineFrame -> Text
+inlineFrameDel = \case
+ EmphasisFrame -> "*"
+ EmphasisFrame_ -> "_"
+ StrongFrame -> "**"
+ StrongFrame_ -> "__"
+ StrikeoutFrame -> "~~"
+ SubscriptFrame -> "~"
+ SuperscriptFrame -> "^"
+
+inlineStateDel :: InlineState -> Text
+inlineStateDel = \case
+ SingleFrame x -> inlineFrameDel x
+ DoubleFrame x y -> inlineFrameDel x <> inlineFrameDel y
+
+liftFrame :: InlineFrame -> NonEmpty Inline -> Inline
+liftFrame = \case
+ StrongFrame -> Strong
+ EmphasisFrame -> Emphasis
+ StrongFrame_ -> Strong
+ EmphasisFrame_ -> Emphasis
+ StrikeoutFrame -> Strikeout
+ SubscriptFrame -> Subscript
+ SuperscriptFrame -> Superscript
+
+replaceEof :: String -> ParseError Char e -> ParseError Char e
+replaceEof altLabel = \case
+ TrivialError pos us es -> TrivialError pos (f <$> us) (E.map f es)
+ FancyError pos xs -> FancyError pos xs
+ where
+ f EndOfInput = Label (NE.fromList altLabel)
+ f x = x
+
+mmarkErr :: MonadParsec MMarkErr s m => MMarkErr -> m a
+mmarkErr = fancyFailure . E.singleton . ErrorCustom
+
+toNesTokens :: Text -> NonEmpty Char
+toNesTokens = NE.fromList . T.unpack
+
+isEmailUri :: URI -> Maybe Text
+isEmailUri uri =
+ case URI.unRText <$> URI.uriPath uri of
+ [x] ->
+ if Email.isValid (TE.encodeUtf8 x) &&
+ (isNothing (URI.uriScheme uri) ||
+ URI.uriScheme uri == Just mailtoScheme)
+ then Just x
+ else Nothing
+ _ -> Nothing
+
+mailtoScheme :: URI.RText 'URI.Scheme
+mailtoScheme = fromJust (URI.mkScheme "mailto")
+
+splitYamlError :: FilePath -> String -> (Maybe SourcePos, String)
+splitYamlError file str = maybe (Nothing, str) (first pure) (parseMaybe p str)
+ where
+ p :: Parsec Void String (SourcePos, String)
+ p = do
+ void (string "YAML parse exception at line ")
+ l <- mkPos . (+ 2) <$> L.decimal
+ void (string ", column ")
+ c <- mkPos . (+ 1) <$> L.decimal
+ void (string ":\n")
+ r <- takeRest
+ return (SourcePos file l c, r)
diff --git a/bench/memory/Main.hs b/bench/memory/Main.hs
new file mode 100644
--- /dev/null
+++ b/bench/memory/Main.hs
@@ -0,0 +1,27 @@
+module Main (main) where
+
+import Weigh
+import qualified Data.Text.IO as T
+import qualified Text.MMark as MMark
+
+main :: IO ()
+main = mainWith $ do
+ setColumns [Case, Allocated, GCs, Max]
+ bparser "data/bench-yaml-block.md"
+ bparser "data/bench-thematic-break.md"
+ bparser "data/bench-heading.md"
+ bparser "data/bench-fenced-code-block.md"
+ bparser "data/bench-indented-code-block.md"
+ bparser "data/bench-paragraph.md"
+ bparser "data/comprehensive.md"
+
+----------------------------------------------------------------------------
+-- Helpers
+
+bparser
+ :: FilePath -- ^ File from which the input has been loaded
+ -> Weigh ()
+bparser path = action name (p <$> T.readFile path)
+ where
+ name = "with file: " ++ path
+ p = MMark.parse path
diff --git a/bench/speed/Main.hs b/bench/speed/Main.hs
new file mode 100644
--- /dev/null
+++ b/bench/speed/Main.hs
@@ -0,0 +1,27 @@
+module Main (main) where
+
+import Criterion.Main
+import qualified Data.Text.IO as T
+import qualified Text.MMark as MMark
+
+main :: IO ()
+main = defaultMain
+ [ bparser "data/bench-yaml-block.md"
+ , bparser "data/bench-thematic-break.md"
+ , bparser "data/bench-heading.md"
+ , bparser "data/bench-fenced-code-block.md"
+ , bparser "data/bench-indented-code-block.md"
+ , bparser "data/bench-paragraph.md"
+ , bparser "data/comprehensive.md"
+ ]
+
+----------------------------------------------------------------------------
+-- Helpers
+
+bparser
+ :: FilePath -- ^ File from which to load parser's input
+ -> Benchmark
+bparser path = env (T.readFile path) (bench name . nf p)
+ where
+ name = "with file: " ++ path
+ p = MMark.parse path
diff --git a/data/bench-fenced-code-block.md b/data/bench-fenced-code-block.md
new file mode 100644
--- /dev/null
+++ b/data/bench-fenced-code-block.md
@@ -0,0 +1,12 @@
+```
+Donec in feugiat quam, eget vulputate metus. Sed at velit aliquam, consequat
+massa vel, pharetra urna. Donec sed auctor odio. In pretium magna porta mi
+posuere malesuada. Morbi sagittis finibus ligula sit amet posuere. Praesent
+egestas massa id leo ultricies bibendum. Nullam fringilla commodo mattis. Ut
+ut odio eget elit suscipit imperdiet. Orci varius natoque penatibus et
+magnis dis parturient montes, nascetur ridiculus mus. Integer interdum
+malesuada sem, vitae faucibus risus hendrerit eget. Aliquam vitae imperdiet
+sapien, eget feugiat dui. Morbi faucibus nulla et dolor aliquam scelerisque.
+Praesent auctor aliquet egestas. Vivamus et blandit velit. Sed ut dui vitae
+massa luctus malesuada a vel diam.
+```
diff --git a/data/bench-heading.md b/data/bench-heading.md
new file mode 100644
--- /dev/null
+++ b/data/bench-heading.md
@@ -0,0 +1,6 @@
+# Heading 1 blah blah blah
+## Heading 2 blah blah blah
+### Heading 3 blah blah blah
+#### Heading 4 blah blah blah
+##### Heading 5 blah blah blah
+###### Heading 6 blah blah blah
diff --git a/data/bench-indented-code-block.md b/data/bench-indented-code-block.md
new file mode 100644
--- /dev/null
+++ b/data/bench-indented-code-block.md
@@ -0,0 +1,10 @@
+ Donec in feugiat quam, eget vulputate metus. Sed at velit aliquam, consequat
+ massa vel, pharetra urna. Donec sed auctor odio. In pretium magna porta mi
+ posuere malesuada. Morbi sagittis finibus ligula sit amet posuere. Praesent
+ egestas massa id leo ultricies bibendum. Nullam fringilla commodo mattis. Ut
+ ut odio eget elit suscipit imperdiet. Orci varius natoque penatibus et
+ magnis dis parturient montes, nascetur ridiculus mus. Integer interdum
+ malesuada sem, vitae faucibus risus hendrerit eget. Aliquam vitae imperdiet
+ sapien, eget feugiat dui. Morbi faucibus nulla et dolor aliquam scelerisque.
+ Praesent auctor aliquet egestas. Vivamus et blandit velit. Sed ut dui vitae
+ massa luctus malesuada a vel diam.
diff --git a/data/bench-paragraph.md b/data/bench-paragraph.md
new file mode 100644
--- /dev/null
+++ b/data/bench-paragraph.md
@@ -0,0 +1,10 @@
+Lorem ipsum dolor sit amet, consectetur adipiscing elit. Integer varius mi
+orci, rhoncus ornare nunc tincidunt nec. Aliquam cursus posuere ornare.
+Quisque posuere euismod nunc, sed pellentesque metus hendrerit eu. Donec
+scelerisque accumsan ante quis interdum. Nullam nec mauris dolor. Lorem
+ipsum dolor sit amet, consectetur adipiscing elit. Phasellus id porttitor
+nunc, sed laoreet eros. Maecenas ipsum ex, sagittis ut quam quis, vehicula
+fringilla tortor. Vestibulum quis consequat mauris, sed porta risus.
+Vestibulum nec ornare leo. Cras pharetra, ex sed dapibus pretium, diam
+lectus accumsan enim, at malesuada tellus lorem et orci. Sed condimentum
+varius ex in mollis.
diff --git a/data/bench-thematic-break.md b/data/bench-thematic-break.md
new file mode 100644
--- /dev/null
+++ b/data/bench-thematic-break.md
@@ -0,0 +1,6 @@
+***
+---
+__**
+ - - -
+ ** * ** * ** * **
+- - - -
diff --git a/data/bench-yaml-block.md b/data/bench-yaml-block.md
new file mode 100644
--- /dev/null
+++ b/data/bench-yaml-block.md
@@ -0,0 +1,7 @@
+---
+title: Free monad considered harmful
+desc: Before you start writing your code using free monads read this, you may change your mind.
+date:
+ published: September 27, 2017
+ updated: September 29, 2017
+---
diff --git a/data/comprehensive.html b/data/comprehensive.html
new file mode 100644
--- /dev/null
+++ b/data/comprehensive.html
@@ -0,0 +1,139 @@
+Lorem ipsum
+Lorem ipsum dolor sit amet, consectetur adipiscing elit. Integer varius mi
+orci, rhoncus ornare nunc tincidunt nec. Aliquam cursus posuere ornare.
+Quisque posuere euismod nunc, sed pellentesque metus hendrerit eu. Donec
+scelerisque accumsan ante quis interdum. Nullam nec mauris dolor. Lorem
+ipsum dolor sit amet, consectetur adipiscing elit. Phasellus id porttitor
+nunc, sed laoreet eros. Maecenas ipsum ex, sagittis ut quam quis, vehicula
+fringilla tortor. Vestibulum quis consequat mauris, sed porta risus.
+Vestibulum nec ornare leo. Cras pharetra, ex sed dapibus pretium, diam
+lectus accumsan enim, at malesuada tellus lorem et orci. Sed condimentum
+varius ex in mollis.
+https://example.org/
+Ut in imperdiet neque. Etiam iaculis rhoncus nisl vel porta. Praesent velit
+orci, laoreet suscipit bibendum eu, ornare et orci. Fusce feugiat, felis a
+vehicula pulvinar, nulla purus dictum arcu, et varius urna purus et nibh.
+Duis lobortis fringilla ligula, in aliquet sem maximus a. Suspendisse
+potenti. Nullam consequat tellus a lectus vestibulum faucibus. Ut hendrerit
+dolor ut libero efficitur accumsan. Mauris dapibus, leo non porttitor
+lobortis, lectus ipsum tempor metus, quis iaculis arcu quam malesuada nulla.
+Nullam luctus
+Nullam luctus placerat nisl in dapibus.
+Phasellus id erat eros. Ut gravida risus sit amet massa tempor volutpat.
+Vestibulum ante ipsum primis in faucibus orci luctus et ultrices posuere
+cubilia Curae; Quisque dictum sapien vel enim tempor, quis ornare justo
+consequat. Suspendisse porttitor mollis consectetur. Curabitur sodales,
+risus eu dapibus mattis, tellus dolor condimentum dolor, in ultricies nibh
+augue vel nibh. Vivamus imperdiet, orci id posuere sollicitudin, diam purus
+consequat eros, quis dictum mauris lacus ac lectus. Cras vitae pharetra
+risus. Maecenas vehicula, leo vitae semper tristique, libero urna
+consectetur massa, eget pharetra magna est nec massa. Vestibulum malesuada
+lobortis lacinia.
+
+Phasellus tincidunt metus quam, vel mollis turpis ultrices et. Phasellus
+consequat diam eu turpis sollicitudin tempus. Fusce suscipit bibendum nisl,
+quis rutrum eros volutpat in. Fusce tempor nisi eu ligula volutpat, eu
+ultricies arcu blandit. Pellentesque habitant morbi tristique senectus et
+netus et malesuada fames ac turpis egestas. Duis eleifend malesuada
+venenatis. Morbi tincidunt quis diam ac aliquam.
+Sed euismod
+Sed euismod nisi lorem, ac tempor nibh venenatis at. Integer porta nibh quis
+mauris vehicula porta. Sed vel tellus nec lacus porttitor sollicitudin. Sed
+facilisis nisl lorem, sed aliquet leo convallis sed. Curabitur vitae aliquet
+diam, ac commodo ligula. Nulla aliquet odio at tellus auctor pellentesque.
+In sagittis elementum tortor sed lobortis. Fusce nibh turpis, posuere eget
+tristique eget, commodo quis leo.
+
+Etiam faucibus, ipsum id lobortis molestie, dolor lectus cursus purus, nec
+volutpat massa odio vitae ligula. Nulla non consectetur ligula. In sem
+felis, vehicula a convallis ut, pellentesque nec diam. Integer ullamcorper
+rutrum nulla. Nam arcu dolor, placerat nec molestie et, eleifend sit amet
+ante. Suspendisse laoreet orci sit amet vestibulum varius. In at leo eu
+lorem tincidunt facilisis. Ut elementum elit ornare risus convallis, ut
+viverra orci pretium. Vivamus mi orci, lacinia ac ligula a, condimentum
+aliquet ligula.
+Curabitur ullamcorper
+Curabitur ullamcorper, lectus id porttitor vehicula, augue purus ornare
+orci, ut consequat tellus mauris ac sem. Cras tincidunt sagittis mi, sit
+amet viverra erat ultrices vulputate. Donec urna nulla, malesuada non cursus
+et, posuere eu sapien. Fusce cursus mauris odio, id tincidunt felis
+tincidunt sed. Duis vulputate lectus eu tellus pretium gravida. Nunc at eros
+fringilla mi egestas imperdiet. In bibendum justo sapien, sed commodo tellus
+auctor sit amet. Fusce at purus turpis. Aliquam a nibh at massa hendrerit
+mollis a nec ipsum. Sed porta erat vitae justo sodales gravida nec sed
+augue. Maecenas ultrices tristique hendrerit.
+Curabitur venenatis vestibulum quam, a facilisis odio dignissim in.
+Vestibulum ut turpis pharetra, aliquam metus a, dapibus massa. Mauris
+vehicula sapien quis dolor facilisis, in placerat ipsum accumsan. Morbi
+accumsan accumsan velit, vel auctor mauris suscipit non. Proin ex lacus,
+dapibus et leo eu, lacinia viverra metus. Suspendisse potenti. Maecenas
+finibus justo lectus, nec commodo velit cursus sit amet. In at lacus vel
+augue porta volutpat eleifend ut orci.
+Ut dictum quis
+Ut dictum quis felis quis auctor. Phasellus lacinia tellus quis massa
+commodo dignissim. Nam vitae felis non ex auctor tincidunt sit amet et
+lorem. Nulla bibendum odio suscipit, tincidunt felis eget, mollis tortor.
+Aliquam a feugiat augue, sed posuere massa. Donec pellentesque sodales
+varius. Suspendisse quis mollis massa. Morbi imperdiet at felis in feugiat.
+Praesent mauris urna, suscipit vitae condimentum venenatis, fermentum sit
+amet purus. Cras non placerat nulla, vel lobortis ex. Nunc ut pulvinar
+magna. Nulla vitae arcu turpis. Suspendisse elementum odio eros. Nullam
+blandit molestie nibh eget pulvinar. Quisque placerat ante nec pulvinar
+fringilla.
+Donec in feugiat quam, eget vulputate metus. Sed at velit aliquam, consequat
+massa vel, pharetra urna. Donec sed auctor odio. In pretium magna porta mi
+posuere malesuada. Morbi sagittis finibus ligula sit amet posuere. Praesent
+egestas massa id leo ultricies bibendum. Nullam fringilla commodo mattis. Ut
+ut odio eget elit suscipit imperdiet. Orci varius natoque penatibus et
+magnis dis parturient montes, nascetur ridiculus mus. Integer interdum
+malesuada sem, vitae faucibus risus hendrerit eget. Aliquam vitae imperdiet
+sapien, eget feugiat dui. Morbi faucibus nulla et dolor aliquam scelerisque.
+Praesent auctor aliquet egestas. Vivamus et blandit velit. Sed ut dui vitae
+massa luctus malesuada a vel diam.
+
+Proin sit amet erat consequat, pellentesque augue at, efficitur libero. Nunc
+pretium nulla eros, vitae euismod ex commodo sit amet. Pellentesque laoreet
+ac enim id commodo. Integer eleifend nibh quis lorem pellentesque venenatis.
+Nulla et eros sit amet diam pharetra porttitor. Sed ullamcorper rutrum
+volutpat. Quisque accumsan posuere arcu, scelerisque dignissim ipsum. Donec
+congue odio ultricies eros maximus, id maximus metus bibendum. Aenean ornare
+metus non nisi varius venenatis. Vestibulum ornare id urna quis tempus. Cras
+non arcu vitae magna feugiat sodales. Fusce eget posuere ligula. Donec
+porttitor, odio at scelerisque tempus, nunc enim cursus dui, finibus
+tincidunt justo lorem quis urna. Integer mauris quam, ultrices quis enim ut,
+consectetur consequat sapien. In dapibus arcu eget ultrices vehicula.
+Mauris efficitur
+Mauris efficitur mollis purus, nec porttitor ligula condimentum a. Proin
+ultricies semper neque ac pulvinar. Nullam vestibulum leo justo, eget
+vehicula elit lobortis vitae. Suspendisse commodo nunc et lorem molestie
+lobortis. Pellentesque habitant morbi tristique senectus et netus et
+malesuada fames ac turpis egestas. Fusce nec mi ultricies, sagittis neque
+sed, tincidunt leo. Proin in lorem a libero maximus posuere. Pellentesque
+habitant morbi tristique senectus et netus et malesuada fames ac turpis
+egestas. Sed interdum eget ipsum id ullamcorper.
+Aenean feugiat orci leo. Morbi fringilla, tortor id posuere mollis, lectus
+est ullamcorper tellus, nec sagittis augue nibh nec est. Sed pulvinar orci a
+justo eleifend dapibus. Phasellus aliquam enim in semper tincidunt. Donec
+tempor tristique purus eu pretium. In ornare est at varius elementum. Cras
+finibus nisl in nisi vestibulum, sed sollicitudin eros finibus.
+Nullam sed nisi blandit, ultrices neque a, finibus ligula. Etiam a ante
+sagittis nibh ornare commodo. Morbi id elit vehicula, gravida enim vitae,
+suscipit orci. Nunc mattis enim sit amet sem dictum molestie. Nam semper
+arcu a libero molestie, at accumsan turpis egestas. Quisque at pulvinar
+enim. Cras porttitor, dolor et commodo accumsan, nibh sem dapibus velit, sit
+amet maximus urna justo id eros. Praesent vitae aliquet lorem, in facilisis
+nulla. Proin sit amet odio nisl. Phasellus sed felis velit. Maecenas pretium
+posuere laoreet. Nullam dapibus ullamcorper sapien. Integer nec quam elit.
+Fusce at dictum lacus. Nam risus dui, efficitur eget urna at, ultricies
+sagittis ligula.
+Aenean auctor nec
+Aenean auctor nec libero ut laoreet. Etiam vulputate lorem quis ex
+dignissim, sit amet tincidunt ligula scelerisque. Nam venenatis blandit
+ipsum quis maximus. Curabitur vitae dolor a diam viverra efficitur. Nulla
+feugiat iaculis orci quis sodales. Aliquam consequat bibendum turpis, quis
+scelerisque lorem fermentum feugiat. Proin pellentesque interdum odio ac
+ullamcorper. Proin laoreet purus leo, non eleifend velit venenatis id.
+Aliquam consectetur finibus turpis quis sollicitudin. Duis congue est nec
+odio hendrerit scelerisque at at sapien. Nunc lacinia ac leo sit amet
+sodales. Donec posuere fermentum massa, at tristique nulla aliquet nec.
+Mauris dapibus quam non augue maximus suscipit.
diff --git a/data/comprehensive.md b/data/comprehensive.md
new file mode 100644
--- /dev/null
+++ b/data/comprehensive.md
@@ -0,0 +1,164 @@
+# Lorem ipsum
+
+Lorem ipsum dolor sit amet, consectetur adipiscing elit. Integer varius mi
+orci, rhoncus ornare nunc tincidunt nec. Aliquam cursus posuere ornare.
+Quisque posuere euismod nunc, sed pellentesque metus hendrerit eu. Donec
+scelerisque accumsan ante quis interdum. Nullam nec mauris dolor. Lorem
+ipsum dolor sit amet, consectetur adipiscing elit. Phasellus id porttitor
+nunc, sed laoreet eros. Maecenas ipsum ex, sagittis ut quam quis, vehicula
+fringilla tortor. Vestibulum quis consequat mauris, sed porta risus.
+Vestibulum nec ornare leo. Cras pharetra, ex sed dapibus pretium, diam
+lectus accumsan enim, at malesuada tellus lorem et orci. Sed condimentum
+varius ex in mollis.
+
+
+
+Ut in imperdiet neque. Etiam iaculis rhoncus nisl vel porta. Praesent velit
+orci, laoreet suscipit bibendum eu, ornare et orci. Fusce feugiat, felis a
+vehicula pulvinar, nulla purus dictum arcu, et varius urna purus et nibh.
+Duis lobortis fringilla ligula, in aliquet sem maximus a. Suspendisse
+potenti. Nullam consequat tellus a lectus vestibulum faucibus. Ut hendrerit
+dolor ut libero efficitur accumsan. Mauris dapibus, leo non porttitor
+lobortis, lectus ipsum tempor metus, quis iaculis arcu quam malesuada nulla.
+
+## Nullam luctus
+
+Nullam [luctus](http://example.org/luctus) placerat nisl in dapibus.
+Phasellus id erat eros. Ut gravida risus sit amet massa tempor volutpat.
+Vestibulum ante ipsum primis in faucibus orci luctus et ultrices posuere
+cubilia Curae; Quisque dictum sapien vel enim tempor, quis ornare justo
+consequat. Suspendisse porttitor mollis consectetur. Curabitur sodales,
+risus eu dapibus mattis, tellus dolor condimentum dolor, in ultricies nibh
+augue vel nibh. Vivamus imperdiet, orci id posuere sollicitudin, diam purus
+consequat eros, quis dictum mauris lacus ac lectus. Cras vitae pharetra
+risus. Maecenas vehicula, leo vitae semper tristique, libero urna
+consectetur massa, eget pharetra magna est nec massa. Vestibulum malesuada
+lobortis lacinia.
+
+
+
+Phasellus tincidunt metus quam, vel mollis turpis ultrices et. Phasellus
+consequat diam eu turpis sollicitudin tempus. Fusce suscipit bibendum nisl,
+quis rutrum eros volutpat in. Fusce tempor nisi eu ligula volutpat, eu
+ultricies arcu blandit. Pellentesque habitant morbi tristique senectus et
+netus et malesuada fames ac turpis egestas. Duis eleifend malesuada
+venenatis. Morbi tincidunt quis diam ac aliquam.
+
+## Sed euismod
+
+Sed euismod nisi lorem, ac tempor nibh venenatis at. Integer porta nibh quis
+mauris vehicula porta. Sed vel tellus nec lacus porttitor sollicitudin. Sed
+facilisis nisl lorem, sed aliquet leo convallis sed. Curabitur vitae aliquet
+diam, ac commodo ligula. Nulla aliquet odio at tellus auctor pellentesque.
+In sagittis elementum tortor sed lobortis. Fusce nibh turpis, posuere eget
+tristique eget, commodo quis leo.
+
+***
+
+Etiam faucibus, ipsum id lobortis molestie, dolor lectus cursus purus, nec
+volutpat massa odio vitae ligula. Nulla non consectetur ligula. In sem
+felis, vehicula a convallis ut, pellentesque nec diam. Integer ullamcorper
+rutrum nulla. Nam arcu dolor, placerat nec molestie et, eleifend sit amet
+ante. Suspendisse laoreet orci sit amet vestibulum varius. In at leo eu
+lorem tincidunt facilisis. Ut elementum elit ornare risus convallis, ut
+viverra orci pretium. Vivamus mi orci, lacinia ac ligula a, condimentum
+aliquet ligula.
+
+### Curabitur ullamcorper
+
+Curabitur ullamcorper, lectus id porttitor vehicula, augue purus ornare
+orci, ut consequat tellus mauris ac sem. Cras tincidunt sagittis mi, sit
+amet viverra erat ultrices vulputate. Donec urna nulla, malesuada non cursus
+et, posuere eu sapien. Fusce cursus mauris odio, id tincidunt felis
+tincidunt sed. Duis vulputate lectus eu tellus pretium gravida. Nunc at eros
+fringilla mi egestas imperdiet. In bibendum justo sapien, sed commodo tellus
+auctor sit amet. Fusce at purus turpis. Aliquam a nibh at massa hendrerit
+mollis a nec ipsum. Sed porta erat vitae justo sodales gravida nec sed
+augue. Maecenas ultrices tristique hendrerit.
+
+Curabitur venenatis vestibulum quam, a facilisis odio dignissim in.
+Vestibulum ut turpis pharetra, aliquam metus a, dapibus massa. Mauris
+vehicula sapien quis dolor facilisis, in placerat ipsum accumsan. Morbi
+accumsan accumsan velit, vel auctor mauris suscipit non. Proin ex lacus,
+dapibus et leo eu, lacinia viverra metus. Suspendisse potenti. Maecenas
+finibus justo lectus, nec commodo velit cursus sit amet. In at lacus vel
+augue porta volutpat eleifend ut orci.
+
+## Ut dictum quis
+
+Ut dictum quis felis quis auctor. Phasellus lacinia tellus quis massa
+commodo dignissim. Nam vitae felis non ex auctor tincidunt sit amet et
+lorem. Nulla bibendum odio suscipit, tincidunt felis eget, mollis tortor.
+Aliquam a feugiat augue, sed posuere massa. Donec pellentesque sodales
+varius. Suspendisse quis mollis massa. Morbi imperdiet at felis in feugiat.
+Praesent mauris urna, suscipit vitae condimentum venenatis, fermentum sit
+amet purus. Cras non placerat nulla, vel lobortis ex. Nunc ut pulvinar
+magna. Nulla vitae arcu turpis. Suspendisse elementum odio eros. Nullam
+blandit molestie nibh eget pulvinar. Quisque placerat ante nec pulvinar
+fringilla.
+
+```
+Donec in feugiat quam, eget vulputate metus. Sed at velit aliquam, consequat
+massa vel, pharetra urna. Donec sed auctor odio. In pretium magna porta mi
+posuere malesuada. Morbi sagittis finibus ligula sit amet posuere. Praesent
+egestas massa id leo ultricies bibendum. Nullam fringilla commodo mattis. Ut
+ut odio eget elit suscipit imperdiet. Orci varius natoque penatibus et
+magnis dis parturient montes, nascetur ridiculus mus. Integer interdum
+malesuada sem, vitae faucibus risus hendrerit eget. Aliquam vitae imperdiet
+sapien, eget feugiat dui. Morbi faucibus nulla et dolor aliquam scelerisque.
+Praesent auctor aliquet egestas. Vivamus et blandit velit. Sed ut dui vitae
+massa luctus malesuada a vel diam.
+```
+
+Proin sit amet erat consequat, pellentesque augue at, efficitur libero. Nunc
+pretium nulla eros, vitae euismod ex commodo sit amet. Pellentesque laoreet
+ac enim id commodo. Integer eleifend nibh quis lorem pellentesque venenatis.
+Nulla et eros sit amet diam pharetra porttitor. Sed ullamcorper rutrum
+volutpat. Quisque accumsan posuere arcu, scelerisque dignissim ipsum. Donec
+congue odio ultricies eros maximus, id maximus metus bibendum. Aenean ornare
+metus non nisi varius venenatis. Vestibulum ornare id urna quis tempus. Cras
+non arcu vitae magna feugiat sodales. Fusce eget posuere ligula. Donec
+porttitor, odio at scelerisque tempus, nunc enim cursus dui, finibus
+tincidunt justo lorem quis urna. Integer mauris quam, ultrices quis enim ut,
+consectetur consequat sapien. In dapibus arcu eget ultrices vehicula.
+
+### Mauris efficitur
+
+Mauris efficitur mollis purus, nec porttitor ligula condimentum a. Proin
+ultricies semper neque ac pulvinar. Nullam vestibulum leo justo, eget
+vehicula elit lobortis vitae. Suspendisse commodo nunc et lorem molestie
+lobortis. Pellentesque habitant morbi tristique senectus et netus et
+malesuada fames ac turpis egestas. Fusce nec mi ultricies, sagittis neque
+sed, tincidunt leo. Proin in lorem a libero maximus posuere. Pellentesque
+habitant morbi tristique senectus et netus et malesuada fames ac turpis
+egestas. Sed interdum eget ipsum id ullamcorper.
+
+Aenean feugiat orci leo. Morbi fringilla, tortor id posuere mollis, lectus
+est ullamcorper tellus, nec sagittis augue nibh nec est. Sed pulvinar orci a
+justo eleifend dapibus. Phasellus aliquam enim in semper tincidunt. Donec
+tempor tristique purus eu pretium. In ornare est at varius elementum. Cras
+finibus nisl in nisi vestibulum, sed sollicitudin eros finibus.
+
+Nullam sed nisi blandit, ultrices neque a, finibus ligula. Etiam a ante
+sagittis nibh ornare commodo. Morbi id elit vehicula, gravida enim vitae,
+suscipit orci. Nunc mattis enim sit amet sem dictum molestie. Nam semper
+arcu a libero molestie, at accumsan turpis egestas. Quisque at pulvinar
+enim. Cras porttitor, dolor et commodo accumsan, nibh sem dapibus velit, sit
+amet maximus urna justo id eros. Praesent vitae aliquet lorem, in facilisis
+nulla. Proin sit amet odio nisl. Phasellus sed felis velit. Maecenas pretium
+posuere laoreet. Nullam dapibus ullamcorper sapien. Integer nec quam elit.
+Fusce at dictum lacus. Nam risus dui, efficitur eget urna at, ultricies
+sagittis ligula.
+
+## Aenean auctor nec
+
+Aenean auctor nec libero ut laoreet. Etiam vulputate lorem quis ex
+dignissim, sit amet tincidunt ligula scelerisque. Nam venenatis blandit
+ipsum quis maximus. Curabitur vitae dolor a diam viverra efficitur. Nulla
+feugiat iaculis orci quis sodales. Aliquam consequat bibendum turpis, quis
+scelerisque lorem fermentum feugiat. Proin pellentesque interdum odio ac
+ullamcorper. Proin laoreet purus leo, non eleifend velit venenatis id.
+Aliquam consectetur finibus turpis quis sollicitudin. Duis congue est nec
+odio hendrerit scelerisque at at sapien. Nunc lacinia ac leo sit amet
+sodales. Donec posuere fermentum massa, at tristique nulla aliquet nec.
+Mauris dapibus quam non augue maximus suscipit.
diff --git a/mmark.cabal b/mmark.cabal
new file mode 100644
--- /dev/null
+++ b/mmark.cabal
@@ -0,0 +1,112 @@
+name: mmark
+version: 0.0.1.0
+cabal-version: >= 1.18
+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.1
+license: BSD3
+license-file: LICENSE.md
+author: Mark Karpov
+maintainer: Mark Karpov
+homepage: https://github.com/mrkkrp/mmark
+bug-reports: https://github.com/mrkkrp/mmark/issues
+category: Text
+synopsis: Strict markdown processor for writers
+build-type: Simple
+description: Strict markdown processor for writers.
+extra-doc-files: CHANGELOG.md
+ , README.md
+data-files: data/*.md
+ , data/*.html
+
+source-repository head
+ type: git
+ location: https://github.com/mrkkrp/mmark.git
+
+flag dev
+ description: Turn on development settings.
+ manual: True
+ default: False
+
+library
+ build-depends: aeson >= 0.11 && < 1.3
+ , base >= 4.8 && < 5.0
+ , containers >= 0.5 && < 0.6
+ , data-default-class
+ , deepseq >= 1.3 && < 1.5
+ , email-validate >= 2.2 && < 2.4
+ , foldl >= 1.2 && < 1.4
+ , lucid >= 2.6 && < 3.0
+ , megaparsec >= 6.1 && < 7.0
+ , modern-uri >= 0.1.1 && < 0.2
+ , mtl >= 2.0 && < 3.0
+ , parser-combinators >= 0.2 && < 1.0
+ , text >= 0.2 && < 1.3
+ , yaml >= 0.8.10 && < 0.9
+ if !impl(ghc >= 8.0)
+ build-depends: semigroups == 0.18.*
+ if !impl(ghc >= 7.10)
+ build-depends: void == 0.7.*
+ if !impl(ghc >= 8.0)
+ build-depends: semigroups == 0.18.*
+ exposed-modules: Text.MMark
+ , Text.MMark.Extension
+ other-modules: Text.MMark.Internal
+ , Text.MMark.Parser
+ if flag(dev)
+ ghc-options: -O0 -Wall -Werror
+ else
+ ghc-options: -O2 -Wall
+ default-language: Haskell2010
+
+test-suite tests
+ main-is: Spec.hs
+ hs-source-dirs: tests
+ type: exitcode-stdio-1.0
+ build-depends: QuickCheck >= 2.4 && < 3.0
+ , aeson >= 0.11 && < 1.3
+ , base >= 4.8 && < 5.0
+ , foldl >= 1.2 && < 1.4
+ , hspec >= 2.0 && < 3.0
+ , hspec-megaparsec >= 1.0 && < 2.0
+ , lucid >= 2.6 && < 3.0
+ , megaparsec >= 6.1 && < 7.0
+ , mmark
+ , modern-uri >= 0.1.1 && < 0.2
+ , text >= 0.2 && < 1.3
+ if !impl(ghc >= 8.0)
+ build-depends: semigroups == 0.18.*
+ other-modules: Text.MMarkSpec
+ , Text.MMark.ExtensionSpec
+ , Text.MMark.TestUtils
+ if flag(dev)
+ ghc-options: -O0 -Wall -Werror
+ else
+ ghc-options: -O2 -Wall
+ default-language: Haskell2010
+
+benchmark bench-speed
+ main-is: Main.hs
+ hs-source-dirs: bench/speed
+ type: exitcode-stdio-1.0
+ build-depends: base >= 4.8 && < 5.0
+ , criterion >= 0.6.2.1 && < 1.3
+ , mmark
+ , text >= 0.2 && < 1.3
+ if flag(dev)
+ ghc-options: -O2 -Wall -Werror
+ else
+ ghc-options: -O2 -Wall
+ default-language: Haskell2010
+
+benchmark bench-memory
+ main-is: Main.hs
+ hs-source-dirs: bench/memory
+ type: exitcode-stdio-1.0
+ build-depends: base >= 4.8 && < 5.0
+ , mmark
+ , text >= 0.2 && < 1.3
+ , weigh >= 0.0.4
+ if flag(dev)
+ ghc-options: -O2 -Wall -Werror
+ else
+ ghc-options: -O2 -Wall
+ default-language: Haskell2010
diff --git a/tests/Spec.hs b/tests/Spec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/tests/Text/MMark/ExtensionSpec.hs b/tests/Text/MMark/ExtensionSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMark/ExtensionSpec.hs
@@ -0,0 +1,137 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Text.MMark.ExtensionSpec (spec) where
+
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.Text (Text)
+import Test.Hspec
+import Test.QuickCheck
+import Text.MMark.Extension (Block (..), Inline (..))
+import Text.MMark.TestUtils
+import qualified Data.Text as T
+import qualified Lucid as L
+import qualified Text.MMark as MMark
+import qualified Text.MMark.Extension as Ext
+import qualified Text.URI as URI
+
+spec :: Spec
+spec = parallel $ do
+ describe "blockTrans" $
+ it "works" $ do
+ doc <- mkDoc "# My heading"
+ toText (MMark.useExtension h1_to_h2 doc)
+ `shouldBe` "My heading
\n"
+ describe "blockRender" $
+ it "works" $ do
+ doc <- mkDoc "# My heading"
+ toText (MMark.useExtension add_h1_content doc)
+ `shouldBe` "My heading
\n"
+ describe "inlineTrans" $
+ it "works" $ do
+ doc <- mkDoc "# My *heading*"
+ toText (MMark.useExtension em_to_strong doc)
+ `shouldBe` "My heading
\n"
+ describe "inlineRender" $
+ it "works" $ do
+ doc <- mkDoc "# My *heading*"
+ toText (MMark.useExtension (add_em_class "foo") doc)
+ `shouldBe` "My heading
\n"
+ describe "asPlainText" $ do
+ let f x = Ext.asPlainText (x:|[])
+ context "with Plain" $
+ it "works" $
+ property $ \txt ->
+ f (Plain txt) `shouldBe` txt
+ context "with LineBreak" $
+ it "works" $
+ f LineBreak `shouldBe` "\n"
+ context "with Emphasis" $
+ it "works" $
+ property $ \txt ->
+ f (Emphasis $ Plain txt :| []) `shouldBe` txt
+ context "with Strong" $
+ it "works" $
+ property $ \txt ->
+ f (Strong $ Plain txt :| []) `shouldBe` txt
+ context "with Strikeout" $
+ it "works" $
+ property $ \txt ->
+ f (Strikeout $ Plain txt :| []) `shouldBe` txt
+ context "with Subscript" $
+ it "works" $
+ property $ \txt ->
+ f (Subscript $ Plain txt :| []) `shouldBe` txt
+ context "with Superscript" $
+ it "works" $
+ property $ \txt ->
+ f (Superscript $ Plain txt :| []) `shouldBe` txt
+ context "with CodeSpan" $
+ it "works" $
+ property $ \txt ->
+ f (CodeSpan txt) `shouldBe` txt
+ context "with Link" $
+ it "works" $
+ property $ \txt uri ->
+ f (Link (Plain txt :| []) uri Nothing) `shouldBe` txt
+ context "with Image" $
+ it "works" $
+ property $ \txt uri ->
+ f (Image (Plain txt :| []) uri Nothing) `shouldBe` txt
+ describe "headerId" $
+ it "works" $
+ Ext.headerId (Plain "Something like that":| []) `shouldBe`
+ "something-like-that"
+ describe "headerFragment" $
+ it "generates URIs with just that fragment" $
+ property $ \fragment -> do
+ let uri = Ext.headerFragment fragment
+ frag <- URI.mkFragment fragment
+ URI.uriScheme uri `shouldBe` Nothing
+ URI.uriAuthority uri `shouldBe` Left False
+ URI.uriPath uri `shouldBe` []
+ URI.uriQuery uri `shouldBe` []
+ URI.uriFragment uri `shouldBe` Just frag
+
+----------------------------------------------------------------------------
+-- Arbitrary instances
+
+instance Arbitrary Text where
+ arbitrary = T.pack <$> arbitrary
+
+----------------------------------------------------------------------------
+-- Testing extensions
+
+-- | Convert H1 headings into H2 headings.
+
+h1_to_h2 :: MMark.Extension
+h1_to_h2 = Ext.blockTrans $ \case
+ Heading1 inner -> Heading2 inner
+ other -> other
+
+-- | Add a data attribute calculated based on plain text contents of the
+-- level 1 heading to test the 'Ext.getOis' thing and 'Ext.blockRender' in
+-- general.
+
+add_h1_content :: MMark.Extension
+add_h1_content = Ext.blockRender $ \old block ->
+ case block of
+ Heading1 inner -> L.with (old (Heading1 inner))
+ [ L.data_ "content" (Ext.asPlainText . Ext.getOis . fst $ inner) ]
+ other -> old other
+
+-- | Covert all 'Emphasis' to 'Strong'.
+
+em_to_strong :: MMark.Extension
+em_to_strong = Ext.inlineTrans $ \case
+ Emphasis inner -> Strong inner
+ other -> other
+
+-- | Add given class to all 'Emphasis' things.
+
+add_em_class :: Text -> MMark.Extension
+add_em_class given = Ext.inlineRender $ \old inline ->
+ case inline of
+ Emphasis inner -> L.with (old (Emphasis inner)) [L.class_ given]
+ other -> old other
diff --git a/tests/Text/MMark/TestUtils.hs b/tests/Text/MMark/TestUtils.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMark/TestUtils.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.MMark.TestUtils
+ ( -- * Document creation and rendering
+ mkDoc
+ , toText
+ -- * Parser expectations
+ , (~~->)
+ , (~->)
+ , (=->)
+ , (==->) )
+where
+
+import Control.Monad
+import Data.Text (Text)
+import Test.Hspec
+import Text.MMark (MMark, MMarkErr)
+import Text.Megaparsec
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Lucid as L
+import qualified Text.MMark as MMark
+
+----------------------------------------------------------------------------
+-- Document creation and rendering
+
+-- | Create an 'MMark' document from given input reporting an expectation
+-- failure if it cannot be parsed.
+
+mkDoc :: Text -> IO MMark
+mkDoc input =
+ case MMark.parse "" input of
+ Left errs -> do
+ expectationFailure $
+ "while parsing a document, parse error(s) occurred:\n" ++
+ MMark.parseErrorsPretty input errs
+ undefined
+ Right x -> return x
+
+-- | Render an 'MMark' document to 'Text'.
+
+toText :: MMark -> Text
+toText = TL.toStrict . L.renderText . MMark.render
+
+----------------------------------------------------------------------------
+-- Parser expectations
+
+-- | Create an expectation that parser should fail producing a certain
+-- collection of 'ParseError's.
+
+infix 2 ~~->
+
+(~~->)
+ :: Text
+ -- ^ Input for parser
+ -> [ParseError Char MMarkErr]
+ -- ^ Expected collection of parse errors, in order
+ -> Expectation
+input ~~-> errs'' =
+ case MMark.parse "" input of
+ Left errs' -> unless (errs == errs') . expectationFailure $
+ "the parser is expected to fail with:\n" ++
+ MMark.parseErrorsPretty input errs ++
+ "but it failed with:\n" ++
+ MMark.parseErrorsPretty input errs'
+ Right x -> expectationFailure $
+ "the parser is expected to fail, but it parsed: " ++ T.unpack (toText x)
+ where
+ errs = NE.fromList errs''
+
+-- | The same as @('~~->')@, but expects only one parse error.
+
+infix 2 ~->
+
+(~->)
+ :: Text
+ -- ^ Input for parser
+ -> ParseError Char MMarkErr
+ -- ^ Expected parse error to compare with
+ -> Expectation
+input ~-> err = input ~~-> [err]
+
+-- | Test parser and render by specifying input for parser and expected
+-- output of render.
+
+infix 2 =->
+
+(=->)
+ :: Text -- ^ Input for MMark parser
+ -> Text -- ^ Output of render to match against
+ -> Expectation
+input =-> expected =
+ case MMark.parse "" input of
+ Left errs -> expectationFailure $
+ "the parser is expected to succeed, but it failed with:\n" ++
+ MMark.parseErrorsPretty input errs
+ Right factual -> toText factual `shouldBe` expected
+
+-- | Just like @('=->')@, but also appends newline to given input and tries
+-- with that as well.
+
+infix ==->
+
+(==->)
+ :: Text -- ^ Input for MMark parser
+ -> Text -- ^ Output of render to match against
+ -> Expectation
+input ==-> expected = do
+ input =-> expected
+ mappend input "\n" =-> expected
diff --git a/tests/Text/MMarkSpec.hs b/tests/Text/MMarkSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMarkSpec.hs
@@ -0,0 +1,1197 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.MMarkSpec (spec) where
+
+import Data.Aeson
+import Data.Char
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.Monoid
+import Data.Text (Text)
+import Test.Hspec
+import Test.Hspec.Megaparsec
+import Text.MMark (MMarkErr (..))
+import Text.MMark.Extension (Inline (..))
+import Text.MMark.TestUtils
+import Text.Megaparsec (ErrorFancy (..))
+import qualified Control.Foldl as L
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import qualified Text.MMark as MMark
+import qualified Text.MMark.Extension as Ext
+
+spec :: Spec
+spec = parallel $ do
+ describe "parse and render" $ do
+ context "2.2 Tabs" $ do
+ it "CM1" $
+ "\tfoo\tbaz\t\tbim" ==->
+ "foo\tbaz\t\tbim\n
\n"
+ it "CM2" $
+ " \tfoo\tbaz\t\tbim" ==->
+ "foo\tbaz\t\tbim\n
\n"
+ it "CM3" $
+ " a\ta\n ὐ\ta" ==->
+ "a\ta\nὐ\ta\n
\n"
+ xit "CM4" $ -- FIXME pending lists
+ " - foo\n\n\tbar" ==->
+ "\n"
+ xit "CM5" $ -- FIXME pending lists
+ "- foo\n\n\t\tbar" ==->
+ "\n"
+ xit "CM6" $ -- FIXME pending blockquotes
+ ">\t\tfoo" ==->
+ "\n foo\n
\n
\n"
+ xit "CM7" $ -- FIXME pending lists
+ "-\t\tfoo" ==->
+ "\n"
+ it "CM8" $
+ " foo\n\tbar" ==->
+ "foo\nbar\n
\n"
+ xit "CM9" $ -- FIXME pending lists
+ " - foo\n - bar\n\t - baz" ==->
+ "\n"
+ it "CM10" $
+ "#\tFoo" ==-> "Foo
\n"
+ it "CM11" $
+ "*\t*\t*\t" ==-> "
\n"
+ context "3.1 Precedence" $
+ xit "CM12" $ -- FIXME pending lists
+ "- `one\n- two`" ==->
+ "\n"
+ context "4.1 Thematic breaks" $ do
+ it "CM13" $
+ "***\n---\n___" ==-> "
\n
\n
\n"
+ it "CM14" $
+ "+++" ==-> "+++
\n"
+ it "CM15" $
+ "===" ==-> "===
\n"
+ it "CM16" $
+ let s = "--\n**\n__\n"
+ in s ~-> errFancy (posN 4 s) (nonFlanking "*")
+ it "CM17" $
+ " ***\n ***\n ***" ==-> "
\n
\n
\n"
+ it "CM18" $
+ " ***" ==-> "***\n
\n"
+ it "CM19" $
+ let s = "Foo\n ***\n"
+ in s ~-> errFancy (posN 10 s) (nonFlanking "*")
+ it "CM20" $
+ "_____________________________________" ==->
+ "
\n"
+ it "CM21" $
+ " - - -" ==-> "
\n"
+ it "CM22" $
+ " ** * ** * ** * **" ==-> "
\n"
+ it "CM23" $
+ "- - - -" ==-> "
\n"
+ it "CM24" $
+ "- - - - " ==-> "
\n"
+ it "CM25" $
+ let s = "_ _ _ _ a\n\na------\n\n---a---\n"
+ in s ~-> errFancy posI (nonFlanking "_")
+ it "CM26" $
+ " *\\-*" ==-> "-
\n"
+ xit "CM27" $ -- FIXME pending lists
+ "- foo\n***\n- bar" ==->
+ "\n
\n\n"
+ it "CM28" $
+ let s = "Foo\n***\nbar"
+ in s ~-> errFancy (posN 6 s) (nonFlanking "*")
+ xit "CM29" $ -- FIXME pending setext headings
+ "Foo\n---\nbar" ==->
+ "Foo
\nbar
\n"
+ xit "CM30" $ -- FIXME pending lists
+ "* Foo\n* * *\n* Bar" ==->
+ "\n
\n\n"
+ xit "CM31" $ -- FIXME pending lists
+ "- Foo\n- * * *" ==->
+ "\n"
+ context "4.2 ATX headings" $ do
+ it "CM32" $
+ "# foo\n## foo\n### foo\n#### foo\n##### foo\n###### foo" ==->
+ "foo
\nfoo
\nfoo
\nfoo
\nfoo
\nfoo
\n"
+ it "CM33" $
+ let s = "####### foo"
+ in s ~-> err (posN 6 s) (utok '#' <> elabel "white space")
+ it "CM34" $
+ let s = "#5 bolt\n\n#hashtag"
+ in s ~~->
+ [ err (posN 1 s) (utok '5' <> etok '#' <> elabel "white space")
+ , err (posN 10 s) (utok 'h' <> etok '#' <> elabel "white space") ]
+ it "CM35" $
+ "\\## foo" ==-> "## foo
\n"
+ it "CM36" $
+ "# foo *bar* \\*baz\\*" ==-> "foo bar *baz*
\n"
+ it "CM37" $
+ "# foo " ==->
+ "foo
\n"
+ it "CM38" $
+ " ### foo\n ## foo\n # foo" ==->
+ "foo
\nfoo
\nfoo
\n"
+ it "CM39" $
+ " # foo" ==-> "# foo\n
\n"
+ it "CM40" $
+ "foo\n # bar" ==-> "foo\n# bar
\n"
+ it "CM41" $
+ "## foo ##\n ### bar ###" ==->
+ "foo
\nbar
\n"
+ it "CM42" $
+ "# foo ##################################\n##### foo ##" ==->
+ "foo
\nfoo
\n"
+ it "CM43" $
+ "### foo ### " ==-> "foo
\n"
+ it "CM44" $
+ "### foo ### b" ==-> "foo ### b
\n"
+ it "CM45" $
+ "# foo#" ==-> "foo#
\n"
+ it "CM46" $
+ "### foo \\###\n## foo #\\##\n# foo \\#" ==->
+ "foo ###
\nfoo ###
\nfoo #
\n"
+ it "CM47" $
+ "****\n## foo\n****" ==->
+ "
\nfoo
\n
\n"
+ it "CM48" $
+ "Foo bar\n# baz\nBar foo" ==->
+ "Foo bar\n# baz\nBar foo
\n"
+ it "CM49" $
+ let s = "## \n#\n### ###"
+ in s ~~->
+ [ err (posN 3 s) (utok '\n' <> elabel "heading character" <> elabel "white space")
+ , err (posN 5 s) (utok '\n' <> etok '#' <> elabel "white space") ]
+ context "4.4 Indented code blocks" $ do
+ it "CM76" $
+ " a simple\n indented code block" ==->
+ "a simple\n indented code block\n
\n"
+ xit "CM77" $ -- FIXME pending lists
+ " - foo\n\n bar" ==->
+ "\n"
+ xit "CM78" $ -- FIXME pending lists
+ "1. foo\n\n - bar" ==->
+ "\n- \n
foo
\n\n \n
\n"
+ it "CM79" $
+ " \n *hi*\n\n - one" ==->
+ "<a/>\n*hi*\n\n- one\n
\n"
+ it "CM80" $
+ " chunk1\n\n chunk2\n \n \n \n chunk3" ==->
+ "chunk1\n\nchunk2\n\n\n\nchunk3\n
\n"
+ it "CM81" $
+ " chunk1\n \n chunk2" ==->
+ "chunk1\n \n chunk2\n
\n"
+ it "CM82" $
+ "Foo\n bar\n" ==->
+ "Foo\nbar
\n"
+ it "CM83" $
+ " foo\nbar" ==->
+ "foo\n
\nbar
\n"
+ xit "CM84" $ -- FIXME pending setext headings
+ "# Heading\n foo\nHeading\n------\n foo\n----\n" ==->
+ "Heading
\nfoo\n
\nHeading
\nfoo\n
\n
\n"
+ it "CM85" $
+ " foo\n bar" ==->
+ " foo\nbar\n
\n"
+ it "CM86" $
+ "\n \n foo\n \n" ==->
+ "foo\n
\n"
+ it "CM87" $
+ " foo " ==->
+ "foo \n
\n"
+ context "4.5 Fenced code blocks" $ do
+ it "CM88" $
+ "```\n<\n >\n```" ==->
+ "<\n >\n
\n"
+ it "CM89" $
+ "~~~\n<\n >\n~~~" ==->
+ "<\n >\n
\n"
+ it "CM90" $
+ "```\naaa\n~~~\n```" ==->
+ "aaa\n~~~\n
\n"
+ it "CM91" $
+ "~~~\naaa\n```\n~~~" ==->
+ "aaa\n```\n
\n"
+ it "CM92" $
+ "````\naaa\n```\n``````" ==->
+ "aaa\n```\n
\n"
+ it "CM93" $
+ "~~~~\naaa\n~~~\n~~~~" ==->
+ "aaa\n~~~\n
\n"
+ it "CM94" $
+ let s = "```"
+ in s ~-> err (posN 3 s)
+ (ueof <> etok '`' <> elabel "info string" <> elabel "newline")
+ it "CM95" $
+ let s = "`````\n\n```\naaa\n"
+ in s ~-> err (posN 15 s)
+ (ueof <> elabel "closing code fence" <> elabel "code block content")
+ xit "CM96" $ -- FIXME pending blockquotes
+ "> ```\n> aaa\n\nbbb" ==->
+ "\naaa\n
\n
\nbbb
\n"
+ it "CM97" $
+ "```\n\n \n```" ==->
+ "\n \n
\n"
+ it "CM98" $
+ "```\n```" ==->
+ "
\n"
+ it "CM99" $
+ " ```\n aaa\naaa\n```" ==->
+ "aaa\naaa\n
\n"
+ it "CM100" $
+ " ```\naaa\n aaa\naaa\n ```" ==->
+ "aaa\naaa\naaa\n
\n"
+ it "CM101" $
+ " ```\n aaa\n aaa\n aaa\n ```" ==->
+ "aaa\n aaa\naaa\n
\n"
+ it "CM102" $
+ " ```\n aaa\n ```" ==->
+ "```\naaa\n```\n
\n"
+ it "CM103" $
+ "```\naaa\n ```" ==->
+ "aaa\n
\n"
+ it "CM104" $
+ " ```\naaa\n ```" ==->
+ "aaa\n
\n"
+ it "CM105" $
+ let s = "```\naaa\n ```\n"
+ in s ~-> err (posN 16 s)
+ (ueof <> elabel "closing code fence" <> elabel "code block content")
+ it "CM106" $
+ "``` ```\naaa" ==->
+ "
\n"
+ it "CM107" $
+ let s = "~~~~~~\naaa\n~~~ ~~\n"
+ in s ~-> err (posN 18 s)
+ (ueof <> elabel "closing code fence" <> elabel "code block content")
+ it "CM108" $
+ "foo\n```\nbar\n```\nbaz" ==->
+ "foo\nbar\nbaz
\n"
+ xit "CM109" $ -- FIXME pending setext headings
+ "foo\n---\n~~~\nbar\n~~~\n# baz" ==->
+ "foo
\nbar\n
\nbaz
\n"
+ it "CM110" $
+ "```ruby\ndef foo(x)\n return 3\nend\n```" ==->
+ "def foo(x)\n return 3\nend\n
\n"
+ it "CM111" $
+ "~~~~ ruby startline=3 $%@#$\ndef foo(x)\n return 3\nend\n~~~~~~~" ==->
+ "def foo(x)\n return 3\nend\n
\n"
+ it "CM112" $
+ "````;\n````" ==->
+ "
\n"
+ it "CM113" $
+ "``` aa ```\nfoo" ==->
+ "aa\nfoo
\n"
+ it "CM114" $
+ "```\n``` aaa\n```" ==->
+ "``` aaa\n
\n"
+ context "4.8 Paragraphs" $ do
+ it "CM180" $
+ "aaa\n\nbbb" ==->
+ "aaa
\nbbb
\n"
+ it "CM181" $
+ "aaa\nbbb\n\nccc\nddd" ==->
+ "aaa\nbbb
\nccc\nddd
\n"
+ it "CM182" $
+ "aaa\n\n\nbbb" ==->
+ "aaa
\nbbb
\n"
+ it "CM183" $
+ " aaa\n bbb" ==->
+ "aaa\nbbb
\n"
+ it "CM184" $
+ "aaa\n bbb\n ccc" ==->
+ "aaa\nbbb\nccc
\n"
+ it "CM185" $
+ " aaa\nbbb" ==-> "aaa\nbbb
\n"
+ it "CM186" $
+ " aaa\nbbb" ==->
+ "aaa\n
\nbbb
\n"
+ it "CM187" $
+ "aaa \nbbb " ==->
+ "aaa\nbbb
\n"
+ context "4.9 Blank lines" $
+ it "CM188" $
+ " \n\naaa\n \n\n# aaa\n\n " ==->
+ "aaa
\naaa
\n"
+ context "6 Inlines" $
+ it "CM286" $
+ let s = "`hi`lo`\n"
+ in s ~-> err (posN 7 s) (ueib <> etok '`' <> elabel "code span content")
+ context "6.1 Blackslash escapes" $ do
+ it "CM287" $
+ "\\!\\\"\\#\\$\\%\\&\\'\\(\\)\\*\\+\\,\\-\\.\\/\\:\\;\\<\\=\\>\\?\\@\\[\\\\\\]\\^\\_\\`\\{\\|\\}\\~\n"
+ ==-> "!"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~
\n"
+ it "CM288" $
+ "\\\t\\A\\a\\ \\3\\φ\\«" ==->
+ "\\\t\\A\\a\\ \\3\\φ\\«
\n"
+ it "CM289" $
+ "\\*not emphasized\\*\n\\
not a tag\n\\[not a link\\](/foo)\n\\`not code\\`\n1\\. not a list\n\\* not a list\n\\# not a heading\n\\[foo\\]: /url \"not a reference\"\n" ==->
+ "*not emphasized*\n<br/> not a tag\n[not a link](/foo)\n`not code`\n1. not a list\n* not a list\n# not a heading\n[foo]: /url "not a reference"
\n"
+ it "CM290" $
+ let s = "\\\\*emphasis*"
+ in s ~-> err (posN 2 s) (utok '*' <> eeib <> eric)
+ xit "CM291" $
+ "foo\\\nbar" ==->
+ "foo
\nbar
\n"
+ it "CM292" $
+ "`` \\[\\` ``" ==->
+ "\\[\\`
\n"
+ it "CM293" $
+ " \\[\\]" ==->
+ "\\[\\]\n
\n"
+ it "CM294" $
+ "~~~\n\\[\\]\n~~~" ==->
+ "\\[\\]\n
\n"
+ it "CM295" $
+ "" ==->
+ "http://example.com/?find=*
\n"
+ xit "CM296" $ -- FIXME pending HTML inlines
+ "" ==->
+ "<a href="/bar/)">
\n"
+ it "CM297" $
+ let s = "[foo](/bar\\* \"ti\\*tle\")"
+ in s ~-> err (posN 10 s)
+ (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi)
+ xit "CM298" $ -- FIXME pending reference links
+ "[foo]\n\n[foo]: /bar\\* \"ti\\*tle\"" ==->
+ "foo
\n"
+ it "CM299" $
+ "``` foo\\+bar\nfoo\n```" ==->
+ "foo\n
\n"
+ context "6.2 Entity and numeric character references" $
+ xit "CM300" $ -- FIXME pending entity references
+ " & © Æ Ď\n¾ ℋ ⅆ\n∲ ≧̸"
+ ==-> " & © Æ Ď\n¾ ℋ ⅆ\n∲ ≧̸
\n"
+ context "6.3 Code spans" $ do
+ it "CM312" $
+ "`foo`" ==-> "foo
\n"
+ it "CM313" $
+ "`` foo ` bar ``" ==->
+ "foo ` bar
\n"
+ it "CM314" $
+ "` `` `" ==-> "``
\n"
+ it "CM315" $
+ "``\nfoo\n``" ==-> "foo
\n"
+ it "CM316" $
+ "`foo bar\n baz`" ==-> "foo bar baz
\n"
+ it "CM317" $
+ "`a b`" ==-> "a b
\n"
+ it "CM318" $
+ "`foo `` bar`" ==-> "foo `` bar
\n"
+ it "CM319" $
+ let s = "`foo\\`bar`\n"
+ in s ~-> err (posN 10 s) (ueib <> etok '`' <> elabel "code span content")
+ it "CM320" $
+ let s = "*foo`*`\n"
+ in s ~-> err (posN 7 s) (ueib <> etok '*' <> eic)
+ it "CM321" $
+ let s = "[not a `link](/foo`)\n"
+ in s ~-> err (posN 20 s) (ueib <> etok ']' <> eic <> eric)
+ it "CM322" $
+ let s = "``\n"
+ in s ~-> err (posN 14 s) (ueib <> etok '`' <> elabel "code span content")
+ xit "CM323" $ -- FIXME pending HTML inlines
+ "`" ==-> "`
\n"
+ it "CM324" $
+ let s = "``\n"
+ in s ~-> err (posN 23 s) (ueib <> etok '`' <> elabel "code span content")
+ it "CM325" $
+ "`" ==->
+ "<http://foo.bar.baz>
\n"
+ it "CM326" $
+ let s = "```foo``\n"
+ in s ~-> err (posN 8 s) (ueib <> etok '`' <> elabel "code span content")
+ it "CM327" $
+ let s = "`foo\n"
+ in s ~-> err (posN 4 s) (ueib <> etok '`' <> elabel "code span content")
+ it "CM328" $
+ let s = "`foo``bar``\n"
+ in s ~-> err (posN 11 s) (ueib <> etok '`' <> elabel "code span content")
+ context "6.4 Emphasis and strong emphasis" $ do
+ it "CM329" $
+ "*foo bar*" ==-> "foo bar
\n"
+ it "CM330" $
+ let s = "a * foo bar*\n"
+ in s ~-> err (posN 2 s) (utok '*' <> eeib <> eric)
+ it "CM331" $
+ let s = "a*\"foo\"*\n"
+ in s ~-> err (posN 1 s) (utok '*' <> eeib <> eric)
+ it "CM332" $
+ let s = "* a *\n"
+ in s ~-> errFancy posI (nonFlanking "*")
+ it "CM333" $
+ let s = "foo*bar*\n"
+ in s ~-> err (posN 3 s) (utok '*' <> eeib <> eric)
+ it "CM334" $
+ let s = "5*6*78\n"
+ in s ~-> err (posN 1 s) (utok '*' <> eeib <> eric)
+ it "CM335" $
+ "_foo bar_" ==-> "foo bar
\n"
+ it "CM336" $
+ let s = "_ foo bar_\n"
+ in s ~-> errFancy posI (nonFlanking "_")
+ it "CM337" $
+ let s = "a_\"foo\"_\n"
+ in s ~-> err (posN 1 s) (utok '_' <> eeib <> eric)
+ it "CM338" $
+ let s = "foo_bar_\n"
+ in s ~-> err (posN 3 s) (utok '_' <> eeib <> eric)
+ it "CM339" $
+ let s = "5_6_78\n"
+ in s ~-> err (posN 1 s) (utok '_' <> eeib <> eric)
+ it "CM340" $
+ let s = "пристаням_стремятся_\n"
+ in s ~-> err (posN 9 s) (utok '_' <> eeib <> eric)
+ it "CM341" $
+ let s = "aa_\"bb\"_cc\n"
+ in s ~-> err (posN 2 s) (utok '_' <> eeib <> eric)
+ it "CM342" $
+ let s = "foo-_(bar)_\n"
+ in s ~-> err (posN 4 s) (utok '_' <> eeib <> eric)
+ it "CM343" $
+ let s = "_foo*\n"
+ in s ~-> err (posN 4 s) (utok '*' <> etok '_' <> eric)
+ it "CM344" $
+ let s = "*foo bar *\n"
+ in s ~-> errFancy (posN 9 s) (nonFlanking "*")
+ it "CM345" $
+ let s = "*foo bar\n*\n"
+ in s ~-> errFancy (posN 9 s) (nonFlanking "*")
+ it "CM346" $
+ let s = "*(*foo)\n"
+ in s ~-> errFancy posI (nonFlanking "*")
+ it "CM347" $
+ let s = "*(*foo*)*\n"
+ in s ~-> errFancy posI (nonFlanking "*")
+ it "CM348" $
+ let s = "*foo*bar\n"
+ in s ~-> errFancy (posN 4 s) (nonFlanking "*")
+ it "CM349" $
+ let s = "_foo bar _\n"
+ in s ~-> errFancy (posN 9 s) (nonFlanking "_")
+ it "CM350" $
+ let s = "_(_foo)\n"
+ in s ~-> errFancy posI (nonFlanking "_")
+ it "CM351" $
+ let s = "_(_foo_)_\n"
+ in s ~-> errFancy posI (nonFlanking "_")
+ it "CM352" $
+ let s = "_foo_bar\n"
+ in s ~-> errFancy (posN 4 s) (nonFlanking "_")
+ it "CM353" $
+ let s = "_пристаням_стремятся\n"
+ in s ~-> errFancy (posN 10 s) (nonFlanking "_")
+ it "CM354" $
+ let s = "_foo_bar_baz_\n"
+ in s ~-> errFancy (posN 4 s) (nonFlanking "_")
+ it "CM355" $
+ "_\\(bar\\)_.\n" ==-> "(bar).
\n"
+ it "CM356" $
+ "**foo bar**\n" ==-> "foo bar
\n"
+ it "CM357" $
+ let s = "** foo bar**\n"
+ in s ~-> errFancy (posN 1 s) (nonFlanking "*")
+ it "CM358" $
+ let s = "a**\"foo\"**\n"
+ in s ~-> err (posN 1 s) (utok '*' <> eeib <> eric)
+ it "CM359" $
+ let s = "foo**bar**\n"
+ in s ~-> err (posN 3 s) (utok '*' <> eeib <> eric)
+ it "CM360" $
+ "__foo bar__" ==-> "foo bar
\n"
+ it "CM361" $
+ let s = "__ foo bar__\n"
+ in s ~-> errFancy (posN 1 s) (nonFlanking "_")
+ it "CM362" $
+ let s = "__\nfoo bar__\n"
+ in s ~-> errFancy (posN 1 s) (nonFlanking "_")
+ it "CM363" $
+ let s = "a__\"foo\"__\n"
+ in s ~-> err (posN 1 s) (utok '_' <> eeib <> eric)
+ it "CM364" $
+ let s = "foo__bar__\n"
+ in s ~-> err (posN 3 s) (utok '_' <> eeib <> eric)
+ it "CM365" $
+ let s = "5__6__78\n"
+ in s ~-> err (posN 1 s) (utok '_' <> eeib <> eric)
+ it "CM366" $
+ let s = "пристаням__стремятся__\n"
+ in s ~-> err (posN 9 s) (utok '_' <> eeib <> eric)
+ it "CM367" $
+ "__foo, __bar__, baz__" ==->
+ "foo, bar, baz
\n"
+ it "CM368" $
+ "foo-__\\(bar\\)__" ==-> "foo-(bar)
\n"
+ it "CM369" $
+ let s = "**foo bar **\n"
+ in s ~-> errFancy (posN 11 s) (nonFlanking "*")
+ it "CM370" $
+ let s = "**(**foo)\n"
+ in s ~-> errFancy (posN 1 s) (nonFlanking "*")
+ it "CM371" $
+ let s = "*(**foo**)*\n"
+ in s ~-> errFancy posI (nonFlanking "*")
+ xit "CM372" $ -- FIXME doesn't pass with current approach
+ "**Gomphocarpus (*Gomphocarpus physocarpus*, syn.\n*Asclepias physocarpa*)**" ==->
+ "Gomphocarpus (Gomphocarpus physocarpus, syn.\nAsclepias physocarpa)
\n"
+ it "CM373" $
+ "**foo \"*bar*\" foo**" ==->
+ "foo "bar" foo
\n"
+ it "CM374" $
+ let s = "**foo**bar\n"
+ in s ~-> errFancy (posN 5 s) (nonFlanking "**")
+ it "CM375" $
+ let s = "__foo bar __\n"
+ in s ~-> errFancy (posN 11 s) (nonFlanking "_")
+ it "CM376" $
+ let s = "__(__foo)\n"
+ in s ~-> errFancy (posN 1 s) (nonFlanking "_")
+ it "CM377" $
+ let s = "_(__foo__)_\n"
+ in s ~-> errFancy posI (nonFlanking "_")
+ it "CM378" $
+ let s = "__foo__bar\n"
+ in s ~-> errFancy (posN 5 s) (nonFlanking "__")
+ it "CM379" $
+ let s = "__пристаням__стремятся\n"
+ in s ~-> errFancy (posN 11 s) (nonFlanking "__")
+ it "CM380" $
+ "__foo\\_\\_bar\\_\\_baz__" ==->
+ "foo__bar__baz
\n"
+ it "CM381" $
+ "__\\(bar\\)__." ==->
+ "(bar).
\n"
+ it "CM382" $
+ "*foo [bar](/url)*" ==->
+ "foo bar
\n"
+ it "CM383" $
+ "*foo\nbar*" ==->
+ "foo\nbar
\n"
+ it "CM384" $
+ "_foo __bar__ baz_" ==->
+ "foo bar baz
\n"
+ it "CM385" $
+ "_foo _bar_ baz_" ==->
+ "foo bar baz
\n"
+ it "CM386" $
+ let s = "__foo_ bar_"
+ in s ~-> err (posN 5 s) (utoks "_ " <> etoks "__" <> eric)
+ it "CM387" $
+ "*foo *bar**" ==->
+ "foo bar
\n"
+ it "CM388" $
+ "*foo **bar** baz*" ==->
+ "foo bar baz
\n"
+ it "CM389" $
+ let s = "*foo**bar**baz*\n"
+ in s ~-> err (posN 5 s) (utok '*' <> eeib)
+ it "CM390" $
+ "***foo** bar*\n" ==-> "foo bar
\n"
+ it "CM391" $
+ "*foo **bar***\n" ==-> "foo bar
\n"
+ it "CM392" $
+ let s = "*foo**bar***\n"
+ in s ~-> err (posN 5 s) (utok '*' <> elabel "end of inline block")
+ it "CM393" $
+ "*foo **bar *baz* bim** bop*\n" ==->
+ "foo bar baz bim bop
\n"
+ it "CM394" $
+ "*foo [*bar*](/url)*\n" ==->
+ "foo bar
\n"
+ it "CM395" $
+ let s = "** is not an empty emphasis\n"
+ in s ~-> errFancy (posN 1 s) (nonFlanking "*")
+ it "CM396" $
+ let s = "**** is not an empty strong emphasis\n"
+ in s ~-> errFancy (posN 3 s) (nonFlanking "*")
+ it "CM397" $
+ "**foo [bar](/url)**" ==->
+ "foo bar
\n"
+ it "CM398" $
+ "**foo\nbar**" ==->
+ "foo\nbar
\n"
+ it "CM399" $
+ "__foo _bar_ baz__" ==->
+ "foo bar baz
\n"
+ it "CM400" $
+ "__foo __bar__ baz__" ==->
+ "foo bar baz
\n"
+ it "CM401" $
+ "____foo__ bar__" ==->
+ "foo bar
\n"
+ it "CM402" $
+ "**foo **bar****" ==->
+ "foo bar
\n"
+ it "CM403" $
+ "**foo *bar* baz**" ==->
+ "foo bar baz
\n"
+ it "CM404" $
+ let s = "**foo*bar*baz**\n"
+ in s ~-> err (posN 5 s) (utoks "*b" <> etoks "**" <> eric)
+ it "CM405" $
+ "***foo* bar**" ==->
+ "foo bar
\n"
+ it "CM406" $
+ "**foo *bar***" ==->
+ "foo bar
\n"
+ it "CM407" $
+ "**foo *bar **baz**\nbim* bop**" ==->
+ "foo bar baz\nbim bop
\n"
+ it "CM408" $
+ "**foo [*bar*](/url)**" ==->
+ "foo bar
\n"
+ it "CM409" $
+ let s = "__ is not an empty emphasis\n"
+ in s ~-> errFancy (posN 1 s) (nonFlanking "_")
+ it "CM410" $
+ let s = "____ is not an empty strong emphasis\n"
+ in s ~-> errFancy (posN 3 s) (nonFlanking "_")
+ it "CM411" $
+ let s = "foo ***\n"
+ in s ~-> errFancy (posN 6 s) (nonFlanking "*")
+ it "CM412" $
+ "foo *\\**" ==-> "foo *
\n"
+ it "CM413" $
+ "foo *\\_*\n" ==-> "foo _
\n"
+ it "CM414" $
+ let s = "foo *****\n"
+ in s ~-> errFancy (posN 8 s) (nonFlanking "*")
+ it "CM415" $
+ "foo **\\***" ==-> "foo *
\n"
+ it "CM416" $
+ "foo **\\_**\n" ==-> "foo _
\n"
+ it "CM417" $
+ let s = "**foo*\n"
+ in s ~-> err (posN 5 s) (utok '*' <> etoks "**" <> eric)
+ it "CM418" $
+ let s = "*foo**\n"
+ in s ~-> err (posN 5 s) (utok '*' <> eeib)
+ it "CM419" $
+ let s = "***foo**\n"
+ in s ~-> err (posN 8 s) (ueib <> etok '*' <> eic)
+ it "CM420" $
+ let s = "****foo*\n"
+ in s ~-> err (posN 7 s) (utok '*' <> etoks "**" <> eric)
+ it "CM421" $
+ let s = "**foo***\n"
+ in s ~-> err (posN 7 s) (utok '*' <> eeib)
+ it "CM422" $
+ let s = "*foo****\n"
+ in s ~-> err (posN 5 s) (utok '*' <> eeib)
+ it "CM423" $
+ let s = "foo ___\n"
+ in s ~-> errFancy (posN 6 s) (nonFlanking "_")
+ it "CM424" $
+ "foo _\\__" ==-> "foo _
\n"
+ it "CM425" $
+ "foo _\\*_" ==-> "foo *
\n"
+ it "CM426" $
+ let s = "foo _____\n"
+ in s ~-> errFancy (posN 8 s) (nonFlanking "_")
+ it "CM427" $
+ "foo __\\___" ==-> "foo _
\n"
+ it "CM428" $
+ "foo __\\*__" ==-> "foo *
\n"
+ it "CM429" $
+ let s = "__foo_\n"
+ in s ~-> err (posN 5 s) (utok '_' <> etoks "__" <> eric)
+ it "CM430" $
+ let s = "_foo__\n"
+ in s ~-> err (posN 5 s) (utok '_' <> eeib)
+ it "CM431" $
+ let s = "___foo__\n"
+ in s ~-> err (posN 8 s) (ueib <> etok '_' <> eic)
+ it "CM432" $
+ let s = "____foo_\n"
+ in s ~-> err (posN 7 s) (utok '_' <> etoks "__" <> eric)
+ it "CM433" $
+ let s = "__foo___\n"
+ in s ~-> err (posN 7 s) (utok '_' <> eeib)
+ it "CM434" $
+ let s = "_foo____\n"
+ in s ~-> err (posN 5 s) (utok '_' <> eeib)
+ it "CM435" $
+ "**foo**" ==-> "foo
\n"
+ it "CM436" $
+ "*_foo_*" ==-> "foo
\n"
+ it "CM437" $
+ "__foo__" ==-> "foo
\n"
+ it "CM438" $
+ "_*foo*_" ==-> "foo
\n"
+ it "CM439" $
+ "****foo****" ==-> "foo
\n"
+ it "CM440" $
+ "____foo____" ==-> "foo
\n"
+ it "CM441" $
+ "******foo******" ==->
+ "foo
\n"
+ it "CM442" $
+ "***foo***" ==-> "foo
\n"
+ it "CM443" $
+ "_____foo_____" ==->
+ "foo
\n"
+ it "CM444" $
+ let s = "*foo _bar* baz_\n"
+ in s ~-> err (posN 9 s) (utok '*' <> etok '_' <> eric)
+ it "CM445" $
+ let s = "*foo __bar *baz bim__ bam*\n"
+ in s ~-> err (posN 19 s) (utok '_' <> etok '*' <> eric)
+ it "CM446" $
+ let s = "**foo **bar baz**\n"
+ in s ~-> err (posN 17 s) (ueib <> etoks "**" <> eic)
+ it "CM447" $
+ let s = "*foo *bar baz*\n"
+ in s ~-> err (posN 14 s) (ueib <> etok '*' <> eic)
+ it "CM448" $
+ let s = "*[bar*](/url)\n"
+ in s ~-> err (posN 5 s) (utok '*' <> etok ']' <> eric)
+ it "CM449" $
+ let s = "_foo [bar_](/url)\n"
+ in s ~-> err (posN 9 s) (utok '_' <> etok ']' <> eric)
+ xit "CM450" $ -- FIXME pending HTML inlines
+ "*![](\"foo\" "\\"*\\"/")
" ==->
+ "*
\n"
+ xit "CM451" $ -- FIXME pending HTML inlines
+ "**" ==-> "**
\n"
+ xit "CM452" $
+ "__\n" ==-> "__
\n"
+ it "CM453" $
+ "*a `*`*" ==-> "a *
\n"
+ it "CM454" $
+ "_a `_`_" ==-> "a _
\n"
+ it "CM455" $
+ let s = "**a"
+ in s ~-> err (posN 25 s) (ueib <> etoks "**" <> eic)
+ it "CM456" $
+ let s = "__a"
+ in s ~-> err (posN 26 s) (ueib <> etoks "__" <> eic)
+ context "6.5 Links" $ do
+ it "CM457" $
+ "[link](/uri \"title\")" ==->
+ "link
\n"
+ it "CM458" $
+ "[link](/uri)" ==->
+ "link
\n"
+ it "CM459" $
+ "[link]()" ==->
+ "link
\n"
+ it "CM460" $
+ "[link](<>)" ==->
+ "link
\n"
+ it "CM461" $
+ let s = "[link](/my uri)\n"
+ in s ~-> err (posN 11 s)
+ (utok 'u' <> etok '"' <> etok '\'' <> etok '(' <> elabel "white space")
+ it "CM462" $
+ let s = "[link]()\n"
+ in s ~-> err (posN 11 s)
+ (utok ' ' <> etok '#' <> etok '/' <> etok '>' <> etok '?' <> eppi)
+ it "CM463" $
+ let s = "[link](foo\nbar)\n"
+ in s ~-> err (posN 11 s)
+ (utok 'b' <> etok '"' <> etok '\'' <> etok '(' <> elabel "white space")
+ it "CM464" $
+ let s = "[link]()\n"
+ in s ~-> err (posN 11 s)
+ (utok '\n' <> etok '#' <> etok '/' <> etok '>' <> etok '?' <> eppi)
+ it "CM465" $
+ let s = "[link](\\(foo\\))"
+ in s ~-> err (posN 7 s) (utok '\\' <> etoks "//" <> etok '#' <>
+ etok '/' <> etok '<' <> etok '?' <> elabel "ASCII alpha character" <>
+ euri <> elabel "path piece")
+ it "CM466" $
+ "[link](foo(and(bar)))\n" ==->
+ "link))
\n"
+ it "CM467" $
+ let s = "[link](foo\\(and\\(bar\\))"
+ in s ~-> err (posN 10 s) (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi)
+ it "CM468" $
+ "[link]()" ==->
+ "link
\n"
+ it "CM469" $
+ let s = "[link](foo\\)\\:)"
+ in s ~-> err (posN 10 s) (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi)
+ it "CM470" $
+ "[link](#fragment)\n\n[link](http://example.com#fragment)\n\n[link](http://example.com?foo=3#frag)\n"
+ ==-> "link
\nlink
\nlink
\n"
+ it "CM471" $
+ let s = "[link](foo\\bar)"
+ in s ~-> err (posN 10 s) (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi)
+ xit "CM472" $ -- FIXME pending entity references
+ "[link](foo%20bä)"
+ ==-> "link
\n"
+ it "CM473" $
+ let s = "[link](\"title\")"
+ in s ~-> err (posN 7 s)
+ (utok '"' <> etoks "//" <> etok '#' <> etok '/' <> etok '<' <>
+ etok '?' <> elabel "ASCII alpha character" <> euri <> elabel "path piece")
+ it "CM474" $
+ "[link](/url \"title\")\n[link](/url 'title')\n[link](/url (title))" ==->
+ "link\nlink\nlink
\n"
+ xit "CM475" $ -- FIXME pending entity references
+ "[link](/url \"title \\\""\")\n" ==->
+ "link
\n"
+ it "CM476" $
+ let s = "[link](/url \"title\")"
+ in s ~-> err (posN 11 s)
+ (utok ' ' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi)
+ it "CM477" $
+ let s = "[link](/url \"title \"and\" title\")\n"
+ in s ~-> err (posN 20 s) (utok 'a' <> etok ')' <> elabel "white space")
+ it "CM478" $
+ "[link](/url 'title \"and\" title')" ==->
+ "link
\n"
+ it "CM479" $
+ "[link]( /uri\n \"title\" )" ==->
+ "link
\n"
+ it "CM480" $
+ let s = "[link] (/uri)\n"
+ in s ~-> err (posN 6 s) (utok ' ' <> etok '(')
+ it "CM481" $
+ let s = "[link [foo [bar]]](/uri)\n"
+ in s ~-> err (posN 6 s) (utok '[' <> etok ']' <> eic <> eric)
+ it "CM482" $
+ let s = "[link] bar](/uri)\n"
+ in s ~-> err (posN 6 s) (utok ' ' <> etok '(')
+ it "CM483" $
+ let s = "[link [bar](/uri)\n"
+ in s ~-> err (posN 6 s) (utok '[' <> etok ']' <> eic <> eric)
+ it "CM484" $
+ "[link \\[bar](/uri)\n" ==->
+ "link [bar
\n"
+ it "CM485" $
+ "[link *foo **bar** `#`*](/uri)" ==->
+ "link foo bar #
\n"
+ it "CM486" $
+ "[](/uri)" ==->
+ "![\"moon\"](\"moon.jpg\")
\n"
+ it "CM487" $
+ let s = "[foo [bar](/uri)](/uri)\n"
+ in s ~-> err (posN 5 s) (utok '[' <> etok ']' <> eic <> eric)
+ it "CM488" $
+ let s = "[foo *[bar [baz](/uri)](/uri)*](/uri)\n"
+ in s ~-> err (posN 11 s) (utok '[' <> etok ']' <> eic <> eric)
+ it "CM489" $
+ let s = "](uri2)](uri3)"
+ in s ~-> err (posN 3 s) (utoks "[foo" <> eeib <> eic)
+ it "CM490" $
+ let s = "*[foo*](/uri)\n"
+ in s ~-> err (posN 5 s) (utok '*' <> etok ']' <> eric)
+ it "CM491" $
+ let s = "[foo *bar](baz*)\n"
+ in s ~-> err (posN 9 s) (utok ']' <> etok '*' <> eic <> eric)
+ it "CM492" $
+ let s = "*foo [bar* baz]\n"
+ in s ~-> err (posN 9 s) (utok '*' <> etok ']' <> eric)
+ xit "CM493" $ -- FIXME pending inline HTML
+ let s = "[foo "
+ in s ~-> err (posN 5 s) (utok '<' <> etok ']')
+ it "CM494" $
+ let s = "[foo`](/uri)`\n"
+ in s ~-> err (posN 13 s) (ueib <> etok ']' <> eic)
+ it "CM495" $
+ "[foo" ==->
+ "foo<http://example.com/?search=>
\n"
+ context "6.6 Images" $ do
+ it "CM541" $
+ "![foo](/url \"title\")" ==->
+ "![\"foo\"](\"/url\" "\\"title\\"")
\n"
+ it "CM542" $
+ "![foo *bar*](train.jpg \"train & tracks\")" ==->
+ "![\"foo](\"train.jpg\" "\\"train")
\n"
+ it "CM543" $
+ let s = "](/url2)\n"
+ in s ~-> err (posN 6 s) (utok '!' <> etok ']')
+ it "CM544" $
+ "](/url2)" ==->
+ "![\"foo](\"/url2\")
\n"
+ it "CM545" pending
+ it "CM546" pending
+ it "CM547" $
+ "" ==->
+ "
\n"
+ it "CM548" $
+ "My ![foo bar](/path/to/train.jpg \"title\" )" ==->
+ "My ![\"foo](\"/path/to/train.jpg\" "\\"title\\"")
\n"
+ it "CM549" $
+ "![foo]()" ==->
+ "![\"foo\"](\"url\")
\n"
+ it "CM550" $
+ "" ==-> "
\n"
+ it "CM551-CM562" pending -- pending reference-style stuff
+ context "6.7 Autolinks" $ do
+ it "CM563" $
+ "" ==->
+ "http://foo.bar.baz/
\n"
+ it "CM564" $
+ "" ==->
+ "http://foo.bar.baz/test?q=hello&id=22&boolean
\n"
+ it "CM565" $
+ "" ==->
+ "irc://foo.bar:2233/baz
\n"
+ it "CM566" $
+ "" ==->
+ "FOO@BAR.BAZ
\n"
+ it "CM567" $
+ "" ==->
+ "a+b+c:d
\n"
+ it "CM568" $
+ "" ==->
+ "made-up-scheme://foo/,bar
\n"
+ it "CM569" $
+ "" ==->
+ "<http://../>
\n"
+ it "CM570" $
+ "" ==->
+ "localhost:5001/foo
\n"
+ it "CM571" $
+ "\n" ==->
+ "<http://foo.bar/baz bim>
\n"
+ it "CM572" $
+ "" ==->
+ "<http://example.com/[>
\n"
+ it "CM573" $
+ "" ==->
+ "foo@bar.example.com
\n"
+ it "CM574" $
+ "" ==->
+ "foo+special@Bar.baz-bar0.com
\n"
+ it "CM575" $
+ "" ==->
+ "<foo+@bar.example.com>
\n"
+ it "CM576" $
+ "<>" ==->
+ "<>
\n"
+ it "CM577" $
+ "< http://foo.bar >" ==->
+ "< http://foo.bar >
\n"
+ it "CM578" $
+ "" ==->
+ "m:abc
\n"
+ it "CM579" $
+ "" ==->
+ "foo.bar.baz
\n"
+ it "CM580" $
+ "http://example.com" ==->
+ "http://example.com
\n"
+ it "CM581" $
+ "foo@bar.example.com" ==->
+ "foo@bar.example.com
\n"
+ context "6.9 Hard line breaks" $ do
+ -- NOTE We currently do not support hard line breaks represented in
+ -- markup as space before newline.
+ xit "CM603" $
+ "foo \nbaz" ==-> "foo
\nbaz
\n"
+ it "CM604" $
+ "foo\\\nbaz\n" ==-> "foo
\nbaz
\n"
+ xit "CM605" $
+ "foo \nbaz" ==-> "foo
\nbaz
\n"
+ xit "CM606" $
+ "foo \n bar" ==-> "foo
\nbar
\n"
+ it "CM607" $
+ "foo\\\n bar" ==-> "foo
\nbar
\n"
+ xit "CM608" $
+ "*foo \nbar*" ==-> "foo
\nbar
\n"
+ it "CM609" $
+ "*foo\\\nbar*" ==-> "foo
\nbar
\n"
+ it "CM610" $
+ "`code \nspan`" ==-> "code span
\n"
+ it "CM611" $
+ "`code\\\nspan`" ==-> "code\\ span
\n"
+ xit "CM612" $
+ "" ==-> "
\n"
+ xit "CM613" $ -- FIXME pending HTML inlines
+ "" ==-> "
\n"
+ it "CM614" $
+ "foo\\" ==-> "foo\\
\n"
+ xit "CM615" $
+ "foo " ==-> "foo
\n"
+ it "CM616" $
+ "### foo\\" ==-> "foo\\
\n"
+ it "CM617" $
+ "### foo " ==-> "foo
\n"
+ context "6.10 Soft line breaks" $ do
+ it "CM618" $
+ "foo\nbaz" ==-> "foo\nbaz
\n"
+ it "CM619" $
+ "foo \n baz" ==-> "foo\nbaz
\n"
+ context "6.11 Textual content" $ do
+ it "CM620" $
+ "hello $.;'there" ==-> "hello $.;'there
\n"
+ it "CM621" $
+ "Foo χρῆν" ==-> "Foo χρῆν
\n"
+ it "CM622" $
+ "Multiple spaces" ==-> "Multiple spaces
\n"
+ -- NOTE I don't test these so extensively because they share
+ -- implementation with emphasis and strong emphasis which are thoroughly
+ -- tested already.
+ context "strikeout" $ do
+ it "works in simplest form" $
+ "It's ~~bad~~ news." ==->
+ "It's bad news.
\n"
+ it "combines with emphasis" $
+ "**It's ~~bad~~** news." ==->
+ "It's bad news.
\n"
+ it "interacts with subscript reasonably (1)" $
+ "It's ~~~bad~~ news~." ==->
+ "It's bad news.
\n"
+ it "interacts with subscript reasonably (2)" $
+ "It's ~~~bad~ news~~." ==->
+ "It's bad news.
\n"
+ context "subscript" $ do
+ it "works in simplest form" $
+ "It's ~bad~ news." ==->
+ "It's bad news.
\n"
+ it "combines with emphasis" $
+ "**It's ~bad~** news." ==->
+ "It's bad news.
\n"
+ context "superscript" $ do
+ it "works in simplest form" $
+ "It's ^bad^ news." ==->
+ "It's bad news.
\n"
+ it "combines with emphasis" $
+ "**It's ^bad^** news." ==->
+ "It's bad news.
\n"
+ it "a composite, complex example" $
+ "***Something ~~~is not~~ going~ ^so well^** today*." ==->
+ "Something is not going so well today.
\n"
+ context "multiple parse errors" $
+ it "they are reported in correct order" $ do
+ let s = "Foo `\n\nBar `.\n"
+ pe = ueib <> etok '`' <> elabel "code span content"
+ s ~~->
+ [ err (posN 5 s) pe
+ , err (posN 13 s) pe ]
+ context "given a complete, comprehensive document" $
+ it "outputs expected the HTML fragment" $
+ withFiles "data/comprehensive.md" "data/comprehensive.html"
+ describe "parseErrorsPretty" $
+ it "renders parse errors correctly" $ do
+ let s = "Foo\nBar\nBaz\n"
+ e0 = err posI (utok 'F' <> etok 'Z')
+ e1 = err (posN 4 s) (utok 'B' <> etok 'Z')
+ e2 = err (posN 8 s) (utok 'B' <> etok 'Z')
+ MMark.parseErrorsPretty s (e0:|[e1,e2]) `shouldBe`
+ "1:1:\n |\n1 | Foo\n | ^\nunexpected 'F'\nexpecting 'Z'\n2:1:\n |\n2 | Bar\n | ^\nunexpected 'B'\nexpecting 'Z'\n3:1:\n |\n3 | Baz\n | ^\nunexpected 'B'\nexpecting 'Z'\n"
+ describe "useExtension" $
+ it "applies given extension" $ do
+ doc <- mkDoc "Here we go."
+ toText (MMark.useExtension (append_ext "..") doc) `shouldBe`
+ "Here we go...
\n"
+ describe "useExtensions" $
+ it "applies extensions in the right order" $ do
+ doc <- mkDoc "Here we go."
+ let exts =
+ [ append_ext "3"
+ , append_ext "2"
+ , append_ext "1" ]
+ toText (MMark.useExtensions exts doc) `shouldBe`
+ "Here we go.123
\n"
+ describe "runScanner and scanner" $
+ it "extracts information from markdown document" $ do
+ doc <- mkDoc "Here we go, pals."
+ let n = MMark.runScanner doc (length_scan (const True))
+ n `shouldBe` 17
+ describe "combining of scanners" $
+ it "combines scanners" $ do
+ doc <- mkDoc "Here we go, pals."
+ let scan = (,,)
+ <$> length_scan (const True)
+ <*> length_scan isSpace
+ <*> length_scan isPunctuation
+ r = MMark.runScanner doc scan
+ r `shouldBe` (17, 3, 2)
+ describe "projectYaml" $ do
+ context "when document does not contain a YAML section" $
+ it "returns Nothing" $ do
+ doc <- mkDoc "Here we go."
+ MMark.projectYaml doc `shouldBe` Nothing
+ context "when document contains a YAML section" $ do
+ context "when it is valid" $
+ it "returns the YAML section" $ do
+ doc <- mkDoc "---\nx: 100\ny: 200\n---Here we go."
+ let r = object
+ [ "x" .= Number 100
+ , "y" .= Number 200 ]
+ MMark.projectYaml doc `shouldBe` Just r
+ context "when it is invalid" $
+ it "signal correct parse error" $
+ let s = "---\nx: 100\ny: x:\n---Here we go."
+ in s ~-> errFancy (posN 15 s)
+ (fancy . ErrorCustom . YamlParseError $
+ "mapping values are not allowed in this context")
+
+----------------------------------------------------------------------------
+-- Testing extensions
+
+-- | Append given text to all 'Plain' blocks.
+
+append_ext :: Text -> MMark.Extension
+append_ext y = Ext.inlineTrans $ \case
+ Plain x -> Plain (x <> y)
+ other -> other
+
+----------------------------------------------------------------------------
+-- Testing scanners
+
+-- | Scan total number of characters satisfying a predicate in all 'Plain'
+-- inlines.
+
+length_scan :: (Char -> Bool) -> L.Fold (Ext.Block (NonEmpty Inline)) Int
+length_scan p = Ext.scanner 0 $ \n block ->
+ getSum $ Sum n <> foldMap (foldMap f) block
+ where
+ f (Plain txt) = (Sum . T.length) (T.filter p txt)
+ f _ = mempty
+
+----------------------------------------------------------------------------
+-- For testing with documents loaded externally
+
+-- | Load a complete markdown document from an external file and compare the
+-- final HTML rendering with contents of another file.
+
+withFiles
+ :: FilePath -- ^ Markdown document
+ -> FilePath -- ^ HTML document containing the correct result
+ -> Expectation
+withFiles input output = do
+ i <- TIO.readFile input
+ o <- TIO.readFile output
+ i ==-> o
+
+----------------------------------------------------------------------------
+-- Helpers
+
+-- | Unexpected end of inline block.
+
+ueib :: Ord t => ET t
+ueib = ulabel "end of inline block"
+
+-- | Expecting end of inline block.
+
+eeib :: Ord t => ET t
+eeib = elabel "end of inline block"
+
+-- | Expecting end of URI literal.
+
+euri :: Ord t => ET t
+euri = elabel "end of URI literal"
+
+-- | Expecting the rest of path piece.
+
+eppi :: Ord t => ET t
+eppi = elabel "the rest of path piece"
+
+-- | Expecting inline content.
+
+eic :: Ord t => ET t
+eic = elabel "inline content"
+
+-- | Expecting rest of inline content. Eric!
+
+eric :: Ord t => ET t
+eric = elabel "the rest of inline content"
+
+-- | Create a error component complaining that the given 'Text' is not in
+-- left- or right- flanking position.
+
+nonFlanking :: Text -> EF MMarkErr
+nonFlanking = fancy . ErrorCustom . NonFlankingDelimiterRun . NE.fromList . T.unpack