mmark 0.0.1.1 → 0.0.2.0
raw patch · 8 files changed
+948/−207 lines, 8 files
Files
- CHANGELOG.md +12/−0
- README.md +13/−6
- Text/MMark.hs +46/−6
- Text/MMark/Extension.hs +14/−0
- Text/MMark/Internal.hs +33/−11
- Text/MMark/Parser.hs +436/−142
- mmark.cabal +2/−2
- tests/Text/MMarkSpec.hs +392/−40
CHANGELOG.md view
@@ -1,3 +1,15 @@+## MMark 0.0.2.0++* Now punctuation is stripped from header ids in+ `Text.MMark.Extension.headerId`.++* Added `scannerM` in `Text.MMark.Extension` and `runScannerM` in+ `Text.MMark`.++* Added support for block quotes.++* Added support for unordered and ordered lists.+ ## MMark 0.0.1.1 * Fixed a bug in skipping of headers (only one newline after the header line
README.md view
@@ -174,14 +174,24 @@ Block-level parsing: -* Headings, thematic breaks, code blocks should be separated from paragraphs- by at least one empty line. This makes the parser a lot simpler and forces- markdown sources to be in a more readable form too.+* Code blocks should be separated from paragraphs and lists by at least one+ empty line. * If a line starts with hash signs it is expected to be a valid *non-empty* header (level 1–6 inclusive). If you want to start a paragraph with hashes, just escape the first hash with backslash and that will be enough.+* Setext headings are not supported for the sake of simplicity. * Fenced code blocks must be explicitly closed by a closing fence. They are not closed by the end of document or by start of another block.+* Lists and block quotes are defined by column at which their content+ starts. Content belonging to a particular list or block quote should start+ at the same column (or greater column, up to the column where indented+ code blocks start). As a consequence of this, block quotes do not feature+ “laziness”+* Block quotes are started by a single `>` character, it's not necessary to+ put a `>` character at beginning of every line belonging to a quote (in+ fact, this would make every line a separate block quote).+* Paragraphs can be interrupted by unordered list and ordered lists with any+ valid starting index. Inline-level parsing: @@ -201,9 +211,6 @@ Not-yet-implemented things: * Separate declaration of image's source and title is not (yet?) supported.-* Blockquotes are not implemented yet.-* Lists (unordered and ordered) are not implemented yet.-* Setext headings are not implemented yet. * Reference links are not implemented yet. * HTML blocks are not implemented yet. * HTML inlines are not implemented yet.
Text/MMark.hs view
@@ -63,14 +63,53 @@ -- The structure of the documentation below corresponds to these stages and -- should clarify the details. --+-- === “Getting started” example+--+-- Here is a complete example of a program that reads a markdown file named+-- @\"input.md\"@ and outputs an HTML file named @\"output.md\"@:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > module Main (main) where+-- >+-- > import qualified Data.Text.IO as T+-- > import qualified Data.Text.Lazy.IO as TL+-- > import qualified Lucid as L+-- > import qualified Text.MMark as MMark+-- >+-- > main :: IO ()+-- > main = do+-- > let input = "input.md"+-- > txt <- T.readFile input -- (1)+-- > case MMark.parse input txt of -- (2)+-- > Left errs -> putStrLn (MMark.parseErrorsPretty txt errs) -- (3)+-- > Right r -> TL.writeFile "output.html" -- (6)+-- > . L.renderText -- (5)+-- > . MMark.render -- (4)+-- > $ r+--+-- Let's break it down:+--+-- 1. We read a source markdown file as strict 'Text'.+-- 2. The source is fed into the 'parse' function which does the+-- parsing. It can either fail with a collection of parse errors+-- or succeed returning a value of the opaque 'MMark' type.+-- 3. If parsing fails, we pretty-print the parse errors with+-- 'parseErrorsPretty'.+-- 4. Then we just render the document with `render` first to Lucid's+-- @'Lucid.Html' ()@.+-- 5. …and then to lazy 'Data.Text.Lazy.Text' with 'Lucid.renderText'.+-- 6. Finally we write the result as @\"output.html\"@.+-- -- === Other modules of interest ----- This module contains all the “core” functionality you may need. However,--- one of the main selling points of MMark is that it's possible to write--- your own extensions which stay highly composable (if done right), so--- proliferation of third-party extensions is to be expected and encouraged.--- To write an extension of your own import the "Text.MMark.Extension"--- module, which has some documentation focusing on extension writing.+-- The "Text.MMark" module contains all the “core” functionality you may+-- need. However, one of the main selling points of MMark is that it's+-- possible to write your own extensions which stay highly composable (if+-- done right), so proliferation of third-party extensions is to be expected+-- and encouraged. To write an extension of your own import the+-- "Text.MMark.Extension" module, which has some documentation focusing on+-- extension writing. module Text.MMark ( -- * Parsing@@ -84,6 +123,7 @@ , useExtensions -- * Scanning , runScanner+ , runScannerM , projectYaml -- * Rendering , render )
Text/MMark/Extension.hs view
@@ -53,6 +53,7 @@ , inlineRender -- * Scanner construction , scanner+ , scannerM -- * Utils , asPlainText , headerId@@ -111,3 +112,16 @@ -> L.Fold Bni a -- ^ Resulting 'L.Fold' scanner a f = L.Fold f a id {-# INLINE scanner #-}++-- | Create a 'L.FoldM' from an initial state and a folding function+-- operating in monadic context.+--+-- @since 0.0.2.0++scannerM+ :: Monad m+ => m a -- ^ Initial state+ -> (a -> Bni -> m a) -- ^ Folding function+ -> L.FoldM m Bni a -- ^ Resulting 'L.FoldM'+scannerM a f = L.FoldM f a return+{-# INLINE scannerM #-}
Text/MMark/Internal.hs view
@@ -27,6 +27,7 @@ , Inline (..) -- * Extensions , runScanner+ , runScannerM , useExtension , useExtensions -- * Renders@@ -46,7 +47,7 @@ import Control.DeepSeq import Control.Monad import Data.Aeson-import Data.Char (isSpace)+import Data.Char (isSpace, isAlphaNum) import Data.Data (Data) import Data.Function (on) import Data.List.NonEmpty (NonEmpty (..))@@ -163,8 +164,8 @@ -- ^ Paragraph, leaf block | Blockquote [Block a] -- ^ Blockquote container block- | OrderedList (NonEmpty [Block a])- -- ^ Ordered list, container block+ | OrderedList Word (NonEmpty [Block a])+ -- ^ Ordered list ('Word' is the start index), container block | UnorderedList (NonEmpty [Block a]) -- ^ Unordered list, container block | Naked a@@ -238,6 +239,21 @@ runScanner MMark {..} f = L.fold f mmarkBlocks {-# INLINE runScanner #-} +-- | Like 'runScanner', but allows to run scanners with monadic context.+--+-- To bring 'L.Fold' and 'L.FoldM' types to the “least common denominator”+-- use 'L.generalize' and 'L.simplify'.+--+-- @since 0.0.2.0++runScannerM+ :: Monad m+ => MMark -- ^ Document to scan+ -> L.FoldM m Bni a -- ^ 'L.FoldM' to use+ -> m a -- ^ Result of scanning+runScannerM MMark {..} f = L.foldM f mmarkBlocks+{-# INLINE runScannerM #-}+ ---------------------------------------------------------------------------- -- Renders @@ -320,24 +336,26 @@ newline Paragraph (_,html) -> p_ html >> newline- Blockquote blocks ->- blockquote_ (mapM_ defaultBlockRender blocks)- OrderedList items -> do- ol_ $ do+ Blockquote blocks -> do+ blockquote_ (newline <* mapM_ defaultBlockRender blocks)+ newline+ OrderedList i items -> do+ let startIndex = [start_ (T.pack $ show i) | i /= 1]+ ol_ startIndex $ do newline forM_ items $ \x -> do- li_ (mapM_ defaultBlockRender x)+ li_ (newline <* mapM_ defaultBlockRender x) newline newline UnorderedList items -> do ul_ $ do newline forM_ items $ \x -> do- li_ (mapM_ defaultBlockRender x)+ li_ (newline <* mapM_ defaultBlockRender x) newline newline Naked (_,html) ->- html+ html >> newline where mkId (Ois x) = [id_ (headerId x)] @@ -405,7 +423,11 @@ -- See also: 'headerFragment'. headerId :: NonEmpty Inline -> Text-headerId = T.intercalate "-" . T.words . T.toLower . asPlainText+headerId = T.intercalate "-"+ . T.words+ . T.filter (\x -> isAlphaNum x || isSpace x)+ . T.toLower+ . asPlainText -- | Generate a 'URI' with just fragment from its textual representation. -- Useful for getting URL from id of a header.
Text/MMark/Parser.hs view
@@ -7,7 +7,7 @@ -- Stability : experimental -- Portability : portable ----- MMark parser.+-- MMark markdown parser. {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}@@ -30,13 +30,15 @@ import Control.Applicative import Control.DeepSeq import Control.Monad+import Control.Monad.Reader 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.Monoid (Any (..))+import Data.Semigroup (Semigroup (..)) import Data.Text (Text) import Data.Typeable (Typeable) import Data.Void@@ -59,15 +61,38 @@ ---------------------------------------------------------------------------- -- Data types --- | Parser type we use internally.+-- | Block-level parser type. -type Parser = Parsec MMarkErr Text+type BParser = ParsecT MMarkErr Text (Reader BlockEnv) +-- | Block-level parser environment.++data BlockEnv = BlockEnv+ { benvAllowNaked :: !Bool+ -- ^ Should we consider a paragraph that does not end with a blank line+ -- 'Naked'? It does not make sense to do so for top-level document, but+ -- in lists, 'Naked' text is pretty common.+ , benvRefLevel :: !Pos+ -- ^ Current reference level: 1 column for top-level of document, column+ -- where content starts for block quotes and lists.+ }++instance Default BlockEnv where+ def = BlockEnv+ { benvAllowNaked = False+ , benvRefLevel = pos1+ }+ -- | MMark custom parse errors. data MMarkErr = YamlParseError String -- ^ YAML error that occurred during parsing of a YAML block+ | ListStartIndexTooBig Word+ -- ^ Ordered list start numbers must be nine digits or less+ | ListIndexOutOfOrder Word Word+ -- ^ The index in an ordered list is out of order, first number is the+ -- actual index we ran into, the second number is the expected index | NonFlankingDelimiterRun (NonEmpty Char) -- ^ This delimiter run should be in left- or right- flanking position deriving (Eq, Ord, Show, Read, Generic, Typeable, Data)@@ -76,24 +101,35 @@ showErrorComponent = \case YamlParseError str -> "YAML parse error: " ++ str+ ListStartIndexTooBig n ->+ "Ordered list start numbers must be nine digits or less, " ++ show n+ ++ " is too big"+ ListIndexOutOfOrder actual expected ->+ "List index out of order: " ++ show actual ++ ", expected "+ ++ show expected NonFlankingDelimiterRun dels -> showTokens dels ++ " should be in left- or right- flanking position" instance NFData MMarkErr --- | Parser type for inlines.+-- | Inline-level parser type. We store type of the last consumed character+-- in the state. type IParser = StateT CharType (Parsec MMarkErr Text) -- | 'Inline' source pending parsing. -data Isp = Isp SourcePos Text- deriving (Eq, Ord, Show)+data Isp+ = IspSpan SourcePos Text+ -- ^ We have an inline source pending parsing+ | IspError (ParseError Char MMarkErr)+ -- ^ We should just return this parse error+ deriving (Eq, Show) -- | Type of last seen character. data CharType- = SpaceChar -- ^ White space+ = SpaceChar -- ^ White space or a transparent character | LeftFlankingDel -- ^ Left flanking delimiter | RightFlankingDel -- ^ Right flaking delimiter | OtherChar -- ^ Other character@@ -119,7 +155,7 @@ | DoubleFrame InlineFrame InlineFrame -- ^ Two frames to be closed deriving (Eq, Ord, Show) --- | Configuration in inline parser.+-- | Configuration of inline parser. data InlineConfig = InlineConfig { iconfigAllowEmpty :: !Bool@@ -137,16 +173,27 @@ , iconfigAllowImages = True } --- | A shortcut type synonym for sub-parsers that may fail and we can--- recover from the failure.+-- | An auxiliary type for collapsing levels of 'Either's. -type E = Either (ParseError Char MMarkErr)+data Pair s a+ = PairL s+ | PairR ([a] -> [a]) +instance Semigroup s => Semigroup (Pair s a) where+ (PairL l) <> (PairL r) = PairL (l <> r)+ (PairL l) <> (PairR _) = PairL l+ (PairR _) <> (PairL r) = PairL r+ (PairR l) <> (PairR r) = PairR (l . r)++instance Semigroup s => Monoid (Pair s a) where+ mempty = PairR id+ mappend = (<>)+ ------------------------------------------------------------------------------- Block parser+-- Top-level API -- | 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+-- either report parse errors or return an 'MMark' document. Note that the -- parser has the ability to report multiple parse errors at once. parse@@ -157,30 +204,51 @@ -> Either (NonEmpty (ParseError Char MMarkErr)) MMark -- ^ Parse errors or parsed document parse file input =- case runParser ((,) <$> optional pYamlBlock <*> pBlocks) file input of+ case runReader (runParserT pMMark file input) def of -- NOTE This parse error only happens when document structure on block -- level cannot be parsed even with recovery, which should not normally- -- happen.+ -- happen except for the cases when we deal with YAML parsing errors. 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+ Right (myaml, rawBlocks) ->+ let parsed = doInline <$> rawBlocks+ doInline = fmap+ $ first (nes . replaceEof "end of inline block")+ . runIsp (pInlines def <* eof)+ f block =+ case foldMap e2p block of+ PairL errs -> PairL errs+ PairR _ -> PairR (fmap fromRight block :)+ in case foldMap f parsed of+ PairL errs -> Left errs+ PairR blocks -> Right MMark { mmarkYaml = myaml- , mmarkBlocks = fmap fromRight <$> parsed+ , mmarkBlocks = blocks [] , mmarkExtension = mempty }- Just es -> Left es -pYamlBlock :: Parser Yaml.Value+----------------------------------------------------------------------------+-- Block parser++-- | Parse an MMark document on block level.++pMMark :: BParser (Maybe Yaml.Value, [Block Isp])+pMMark = do+ meyaml <- optional pYamlBlock+ setTabWidth (mkPos 4)+ blocks <- pBlocks+ eof+ return $ case meyaml of+ Nothing ->+ (Nothing, blocks)+ Just (Left (pos, err)) ->+ (Nothing, prependErr pos (YamlParseError err) blocks)+ Just (Right yaml) ->+ (Just yaml, blocks)++-- | Parse a YAML block. On success return the actual parsed 'Yaml.Value' in+-- 'Right', otherwise return 'SourcePos' of parse error and 'String'+-- describing the error as generated by the @yaml@ package in 'Left'.++pYamlBlock :: BParser (Either (SourcePos, String) Yaml.Value) pYamlBlock = do dpos <- getPosition string "---" *> sc' *> eol@@ -195,37 +263,56 @@ 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+ return $ Left (fromMaybe dpos apos, err) Right v ->- return v+ return (Right v) -pBlocks :: Parser [E (Block Isp)]-pBlocks = do- setTabWidth (mkPos 4)- sc *> manyTill pBlock eof+-- | Parse several (possibly zero) blocks in a row. -pBlock :: Parser (E (Block Isp))-pBlock = choice- [ try (pure <$> pThematicBreak)- , pAtxHeading- , pure <$> pFencedCodeBlock- , try (pure <$> pIndentedCodeBlock)- , pure <$> pParagraph ]+pBlocks :: BParser [Block Isp]+pBlocks = many pBlock -pThematicBreak :: Parser (Block Isp)+-- | Parse a single block of markdown document.++pBlock :: BParser (Block Isp)+pBlock = do+ sc+ rlevel <- asks benvRefLevel+ alevel <- L.indentLevel+ done <- atEnd+ if done || alevel < rlevel then empty else+ case compare alevel (ilevel rlevel) of+ LT -> choice+ [ pThematicBreak+ , pAtxHeading+ , pFencedCodeBlock+ , pUnorderedList+ , pOrderedList+ , pBlockquote+ , pParagraph ]+ _ ->+ pIndentedCodeBlock++-- | Parse a thematic break.++pThematicBreak :: BParser (Block Isp) pThematicBreak = do- void casualLevel- l <- lookAhead nonEmptyLine- if isThematicBreak l+ l' <- lookAhead nonEmptyLine+ let l = T.filter (not . isSpace) l'+ if T.length l >= 3 &&+ (T.all (== '*') l ||+ T.all (== '-') l ||+ T.all (== '_') l) then ThematicBreak <$ nonEmptyLine <* sc else empty -pAtxHeading :: Parser (E (Block Isp))+-- | Parse an ATX heading.++pAtxHeading :: BParser (Block Isp) pAtxHeading = do- (void . lookAhead . try) start+ (void . lookAhead . try) hashIntro withRecovery recover $ do- hlevel <- length <$> start+ hlevel <- length <$> hashIntro sc1' ispPos <- getPosition r <- someTill (satisfy notNewline <?> "heading character") . try $@@ -237,19 +324,21 @@ 4 -> Heading4 5 -> Heading5 _ -> Heading6- (Right . toBlock) (Isp ispPos (T.strip (T.pack r))) <$ sc+ toBlock (IspSpan ispPos (T.strip (T.pack r))) <$ sc where- start = casualLevel *> count' 1 6 (char '#')+ hashIntro = count' 1 6 (char '#') recover err =- Left err <$ takeWhileP Nothing notNewline <* sc+ Heading1 (IspError err) <$ takeWhileP Nothing notNewline <* sc -pFencedCodeBlock :: Parser (Block Isp)+-- | Parse a fenced code block.++pFencedCodeBlock :: BParser (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")+ ml <- optional+ (T.strip <$> someEscapedWith notNewline <?> "info string") guard (maybe True (not . T.any (== '`')) ml) return (ch, n,@@ -259,60 +348,211 @@ if T.null l then Nothing else Just l)+ alevel <- L.indentLevel (ch, n, infoString) <- (p '`' <|> p '~') <* eol let content = label "code block content" (option "" nonEmptyLine <* eol) closingFence = try . label "closing code fence" $ do- void casualLevel'+ clevel <- ilevel <$> asks benvRefLevel+ void $ L.indentGuard sc' LT clevel void $ count n (char ch) (void . many . char) ch sc' eof <|> eol ls <- manyTill content closingFence- CodeBlock infoString (assembleCodeBlock level ls) <$ sc+ CodeBlock infoString (assembleCodeBlock alevel ls) <$ sc -pIndentedCodeBlock :: Parser (Block Isp)+-- | Parse an indented code block.++pIndentedCodeBlock :: BParser (Block Isp) pIndentedCodeBlock = do- initialIndent <- codeBlockLevel+ alevel <- L.indentLevel+ clevel <- ilevel <$> asks benvRefLevel 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+ immediate <- lookAhead $+ (>= clevel) <$> (sc' *> L.indentLevel)+ eventual <- lookAhead $+ (>= clevel) <$> (sc *> L.indentLevel)+ if immediate || eventual+ then do l <- option "" nonEmptyLine continue <- eol' if continue then go (l:ls) else return (l:ls)+ else return 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+ f x = T.replicate (unPos alevel - 1) " " <> x g [] = [] g (x:xs) = f x : xs ls <- g . reverse . dropWhile isBlank <$> go []- CodeBlock Nothing (assembleCodeBlock (mkPos 5) ls) <$ sc+ CodeBlock Nothing (assembleCodeBlock clevel ls) <$ sc -pParagraph :: Parser (Block Isp)+-- | Parse an unorederd list.++pUnorderedList :: BParser (Block Isp)+pUnorderedList = do+ (bullet, bulletPos, minLevel, indLevel) <-+ pListBullet Nothing+ x <- innerBlocks bulletPos minLevel indLevel+ xs <- many $ do+ (_, bulletPos', minLevel', indLevel') <-+ pListBullet (Just (bullet, bulletPos))+ innerBlocks bulletPos' minLevel' indLevel'+ return (UnorderedList (normalizeListItems (x:|xs)))+ where+ innerBlocks bulletPos minLevel indLevel = do+ p <- getPosition+ let tooFar = sourceLine p > sourceLine bulletPos <> pos1+ rlevel = slevel minLevel indLevel+ if tooFar || sourceColumn p < minLevel+ then return [if tooFar then emptyParagraph else emptyNaked]+ else subEnv True rlevel pBlocks++-- | Parse a list bullet. Return a tuple with the following components (in+-- order):+--+-- * 'Char' used to represent the bullet+-- * 'SourcePos' at which the bullet was located+-- * the closest column position where content could start+-- * the indentation level after the bullet++pListBullet+ :: Maybe (Char, SourcePos)+ -- ^ Bullet 'Char' and start position of the first bullet in a list+ -> BParser (Char, SourcePos, Pos, Pos)+pListBullet mbullet = try $ do+ pos <- getPosition+ l <- (<> mkPos 2) <$> L.indentLevel+ bullet <-+ case mbullet of+ Nothing -> char '-' <|> char '+' <|> char '*'+ Just (bullet, bulletPos) -> do+ guard (sourceColumn pos >= sourceColumn bulletPos)+ char bullet+ eof <|> sc1+ l' <- L.indentLevel+ return (bullet, pos, l, l')++-- | Parse an ordered list.++pOrderedList :: BParser (Block Isp)+pOrderedList = do+ (startIx, del, startPos, minLevel, indLevel) <-+ pListIndex Nothing+ x <- innerBlocks startPos minLevel indLevel+ xs <- manyIndexed (startIx + 1) $ \expectedIx -> do+ (actualIx, _, startPos', minLevel', indLevel') <-+ pListIndex (Just (del, startPos))+ let f blocks =+ if actualIx == expectedIx+ then blocks+ else prependErr+ startPos'+ (ListIndexOutOfOrder actualIx expectedIx)+ blocks+ f <$> innerBlocks startPos' minLevel' indLevel'+ return . OrderedList startIx . normalizeListItems $+ (if startIx <= 999999999+ then x+ else prependErr startPos (ListStartIndexTooBig startIx) x)+ :| xs+ where+ innerBlocks indexPos minLevel indLevel = do+ p <- getPosition+ let tooFar = sourceLine p > sourceLine indexPos <> pos1+ rlevel = slevel minLevel indLevel+ if tooFar || sourceColumn p < minLevel+ then return [if tooFar then emptyParagraph else emptyNaked]+ else subEnv True rlevel pBlocks++-- | Parse a list index. Return a tuple with the following components (in+-- order):+--+-- * 'Word' parsed numeric index+-- * 'Char' used as delimiter after the numeric index+-- * 'SourcePos' at which the index was located+-- * the closest column position where content could start+-- * the indentation level after the index++pListIndex+ :: Maybe (Char, SourcePos)+ -- ^ Delimiter 'Char' and start position of the first index in a list+ -> BParser (Word, Char, SourcePos, Pos, Pos)+pListIndex mstart = try $ do+ pos <- getPosition+ i <- L.decimal+ del <- case mstart of+ Nothing -> char '.' <|> char ')'+ Just (del, startPos) -> do+ guard (sourceColumn pos >= sourceColumn startPos)+ char del+ l <- (<> pos1) <$> L.indentLevel+ eof <|> sc1+ l' <- L.indentLevel+ return (i, del, pos, l, l')++-- | Parse a block quote.++pBlockquote :: BParser (Block Isp)+pBlockquote = do+ minLevel <- try $ do+ minLevel <- (<> pos1) <$> L.indentLevel+ void (char '>')+ eof <|> sc+ l <- L.indentLevel+ return $+ if l > minLevel+ then minLevel <> pos1+ else minLevel+ indLevel <- L.indentLevel+ if indLevel >= minLevel+ then do+ let rlevel = slevel minLevel indLevel+ xs <- subEnv False rlevel pBlocks+ return (Blockquote xs)+ else return (Blockquote [])++-- | Parse a paragraph or naked text (is some cases).++pParagraph :: BParser (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 []+ startPos <- getPosition+ allowNaked <- asks benvAllowNaked+ rlevel <- asks benvRefLevel+ let go ls = do+ l <- lookAhead (option "" nonEmptyLine)+ broken <- succeeds . lookAhead . try $ do+ sc+ alevel <- L.indentLevel+ guard (alevel < ilevel rlevel)+ unless (alevel < rlevel) . choice $+ [ void (char '>')+ , void pThematicBreak+ , void pAtxHeading+ , void (pListBullet Nothing)+ , void (pListIndex Nothing) ]+ if isBlank l+ then return (ls, Paragraph)+ else if broken+ then return (ls, Naked)+ else do+ void nonEmptyLine+ continue <- eol'+ let ls' = ls . (l:)+ if continue+ then go ls'+ else return (ls', Naked) l <- nonEmptyLine continue <- eol'- ls <- if continue then go else return []- Paragraph (Isp startPos (assembleParagraph (l:ls))) <$ sc+ (ls, toBlock) <-+ if continue+ then go id+ else return (id, Naked)+ (if allowNaked then toBlock else Paragraph)+ (IspSpan startPos (assembleParagraph (l:ls []))) <$ sc ---------------------------------------------------------------------------- -- Inline parser@@ -323,7 +563,8 @@ :: IParser a -- ^ The parser to run -> Isp -- ^ Input for the parser -> Either (ParseError Char MMarkErr) a -- ^ Result of parsing-runIsp p (Isp startPos input) =+runIsp _ (IspError err) = Left err+runIsp p (IspSpan startPos input) = snd (runParser' (evalStateT p SpaceChar) pst) where pst = State@@ -332,6 +573,8 @@ , stateTokensProcessed = 0 , stateTabWidth = mkPos 4 } +-- | Parse inlines using settings from given 'InlineConfig'.+ pInlines :: InlineConfig -> IParser (NonEmpty Inline) pInlines InlineConfig {..} = if iconfigAllowEmpty@@ -348,6 +591,8 @@ , pPlain ] angel = between (char '<') (char '>') +-- | Parse a code span.+ pCodeSpan :: IParser Inline pCodeSpan = do n <- try (length <$> some (char '`'))@@ -362,6 +607,8 @@ put OtherChar return r +-- | Parse a link.+ pInlineLink :: IParser Inline pInlineLink = do xs <- between (char '[') (char ']') $@@ -373,6 +620,8 @@ put OtherChar return (Link xs dest mtitle) +-- | Parse an image.+ pImage :: IParser Inline pImage = do let nonEmptyDesc = char '!' *> between (char '[') (char ']')@@ -385,6 +634,8 @@ put OtherChar return (Image alt src mtitle) +-- | Parse a URI.+ pUri :: IParser URI pUri = do uri <- between (char '<') (char '>') URI.parser <|> naked@@ -411,6 +662,8 @@ fancyFailure xs Right x -> return x +-- | Parse a title of a link or an image.+ pTitle :: IParser Text pTitle = choice [ p '\"' '\"'@@ -420,6 +673,8 @@ p start end = between (char start) (char end) $ manyEscapedWith (/= end) "unescaped character" +-- | Parse an autolink.+ pAutolink :: IParser Inline pAutolink = do notFollowedBy (char '>') -- empty links don't make sense@@ -434,6 +689,9 @@ uri' = URI.makeAbsolute mailtoScheme uri in Link txt uri' Nothing +-- | Parse inline content inside some sort of emphasis, strikeout,+-- superscript, and\/or subscript markup.+ pEnclosedInline :: IParser Inline pEnclosedInline = do let noEmpty = def { iconfigAllowEmpty = False }@@ -467,15 +725,17 @@ return . liftFrame thatFrame $ liftFrame thisFrame inlines0 <| inlines1 +-- | Parse an opening markup sequence corresponding to given 'InlineState'+ pLfdr :: InlineState -> IParser InlineState pLfdr st = try $ do let dels = inlineStateDel st- mpos <- getNextTokenPosition+ pos <- getPosition void (string dels) leftChar <- get mrightChar <- lookAhead (optional anyChar) let failNow = do- forM_ mpos setPosition+ setPosition pos (mmarkErr . NonFlankingDelimiterRun . toNesTokens) dels case (leftChar, isTransparent <$> mrightChar) of (_, Nothing) -> failNow@@ -487,15 +747,17 @@ put LeftFlankingDel return st +-- | Parse a closing markdup sequence corresponding to given 'InlineFrame'.+ pRfdr :: InlineFrame -> IParser InlineFrame pRfdr frame = try $ do let dels = inlineFrameDel frame- mpos <- getNextTokenPosition+ pos <- getPosition void (string dels) leftChar <- get mrightChar <- lookAhead (optional anyChar) let failNow = do- forM_ mpos setPosition+ setPosition pos (mmarkErr . NonFlankingDelimiterRun . toNesTokens) dels case (leftChar, mrightChar) of (SpaceChar, _) -> failNow@@ -508,6 +770,8 @@ put RightFlankingDel return frame +-- | Parse a hard line break.+ pHardLineBreak :: IParser Inline pHardLineBreak = do void (char '\\')@@ -517,6 +781,8 @@ put SpaceChar return LineBreak +-- | Parse plain text.+ pPlain :: IParser Inline pPlain = Plain . T.pack <$> some (pEscapedChar <|> pNewline <|> pNonEscapedChar)@@ -537,19 +803,7 @@ ---------------------------------------------------------------------------- -- 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 :: BParser Text nonEmptyLine = takeWhile1P Nothing notNewline manyEscapedWith :: MonadParsec e Text m => (Char -> Bool) -> String -> m Text@@ -583,20 +837,18 @@ 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'+subEnv :: Bool -> Pos -> BParser a -> BParser a+subEnv benvAllowNaked benvRefLevel = local (const BlockEnv {..}) ---------------------------------------------------------------------------- -- Other helpers +slevel :: Pos -> Pos -> Pos+slevel a l = if l >= ilevel a then a else l++ilevel :: Pos -> Pos+ilevel = (<> mkPos 4)+ isSpace :: Char -> Bool isSpace x = x == ' ' || x == '\t' @@ -648,31 +900,14 @@ 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)+ m = snd $ T.foldl' f (0, 0) (T.takeWhile p txt)+ p x = isSpace x || x == '>' f (!j, !n) ch | j >= i = (j, n) | ch == ' ' = (j + 1, n + 1)@@ -680,6 +915,13 @@ | otherwise = (j, n) i = unPos indent - 1 +assembleParagraph :: [Text] -> Text+assembleParagraph = go+ where+ go [] = ""+ go [x] = T.dropWhileEnd isSpace x+ go (x:xs) = x <> "\n" <> go xs+ collapseWhiteSpace :: Text -> Text collapseWhiteSpace = T.stripEnd . T.filter (/= '\0') . snd . T.mapAccumL f True@@ -728,12 +970,6 @@ 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@@ -745,9 +981,6 @@ 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@@ -760,3 +993,64 @@ void (string ":\n") r <- takeRest return (SourcePos file l c, r)++emptyParagraph :: Block Isp+emptyParagraph = Paragraph (IspSpan (initialPos "") "")++emptyNaked :: Block Isp+emptyNaked = Naked (IspSpan (initialPos "") "")++manyIndexed :: (Alternative m, Num n) => n -> (n -> m a) -> m [a]+manyIndexed n' m = go n'+ where+ go !n = liftA2 (:) (m n) (go (n + 1)) <|> pure []++normalizeListItems :: NonEmpty [Block Isp] -> NonEmpty [Block Isp]+normalizeListItems xs' =+ if getAny $ foldMap (foldMap (Any . isParagraph)) (drop 1 x :| xs)+ then fmap toParagraph <$> xs'+ else case x of+ [] -> xs'+ (y:ys) -> r $ (toNaked y : ys) :| xs+ where+ (x:|xs) = r xs'+ r = NE.reverse . fmap reverse+ isParagraph = \case+ OrderedList _ _ -> False+ UnorderedList _ -> False+ Naked _ -> False+ _ -> True+ toParagraph (Naked inner) = Paragraph inner+ toParagraph other = other+ toNaked (Paragraph inner) = Naked inner+ toNaked other = other++e2p :: Either a b -> Pair a b+e2p = \case+ Left a -> PairL a+ Right b -> PairR (b:)++succeeds :: Alternative m => m () -> m Bool+succeeds m = True <$ m <|> pure False++prependErr :: SourcePos -> MMarkErr -> [Block Isp] -> [Block Isp]+prependErr pos custom blocks = Naked (IspError err) : blocks+ where+ err = FancyError (nes pos) (E.singleton $ ErrorCustom custom)++mmarkErr :: MonadParsec MMarkErr s m => MMarkErr -> m a+mmarkErr = fancyFailure . E.singleton . ErrorCustom++mailtoScheme :: URI.RText 'URI.Scheme+mailtoScheme = fromJust (URI.mkScheme "mailto")++toNesTokens :: Text -> NonEmpty Char+toNesTokens = NE.fromList . T.unpack++nes :: a -> NonEmpty a+nes a = a :| []++fromRight :: Either a b -> b+fromRight (Right x) = x+fromRight _ =+ error "Text.MMark.Parser.fromRight: the impossible happened"
mmark.cabal view
@@ -1,7 +1,7 @@ name: mmark-version: 0.0.1.1+version: 0.0.2.0 cabal-version: >= 1.18-tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.1+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 license: BSD3 license-file: LICENSE.md author: Mark Karpov <markkarpov92@gmail.com>
tests/Text/MMarkSpec.hs view
@@ -34,32 +34,34 @@ it "CM3" $ " a\ta\n ὐ\ta" ==-> "<pre><code>a\ta\nὐ\ta\n</code></pre>\n"- xit "CM4" $ -- FIXME pending lists+ it "CM4" $ " - foo\n\n\tbar" ==-> "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"- xit "CM5" $ -- FIXME pending lists+ it "CM5" $ "- foo\n\n\t\tbar" ==-> "<ul>\n<li>\n<p>foo</p>\n<pre><code> bar\n</code></pre>\n</li>\n</ul>\n"- xit "CM6" $ -- FIXME pending blockquotes+ it "CM6" $ ">\t\tfoo" ==-> "<blockquote>\n<pre><code> foo\n</code></pre>\n</blockquote>\n"- xit "CM7" $ -- FIXME pending lists+ it "CM7" $ "-\t\tfoo" ==-> "<ul>\n<li>\n<pre><code> foo\n</code></pre>\n</li>\n</ul>\n" it "CM8" $ " foo\n\tbar" ==-> "<pre><code>foo\nbar\n</code></pre>\n"- xit "CM9" $ -- FIXME pending lists+ it "CM9" $ " - foo\n - bar\n\t - baz" ==->- "<ul>\n<li>foo\n<ul>\n<li>bar\n<ul>\n<li>baz</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n"+ "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n<ul>\n<li>\nbaz\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n" it "CM10" $ "#\tFoo" ==-> "<h1 id=\"foo\">Foo</h1>\n" it "CM11" $ "*\t*\t*\t" ==-> "<hr>\n" context "3.1 Precedence" $- xit "CM12" $ -- FIXME pending lists- "- `one\n- two`" ==->- "<ul>\n<li>`one</li>\n<li>two`</li>\n</ul>\n"+ it "CM12" $+ let s = "- `one\n- two`"+ in s ~~->+ [ err (posN 6 s) (ueib <> etok '`' <> elabel "code span content")+ , err (posN 13 s) (ueib <> etok '`' <> elabel "code span content") ] context "4.1 Thematic breaks" $ do it "CM13" $ "***\n---\n___" ==-> "<hr>\n<hr>\n<hr>\n"@@ -76,7 +78,7 @@ " ***" ==-> "<pre><code>***\n</code></pre>\n" it "CM19" $ let s = "Foo\n ***\n"- in s ~-> errFancy (posN 10 s) (nonFlanking "*")+ in s ~-> errFancy (posN 10 s) (nonFlanking "*") it "CM20" $ "_____________________________________" ==-> "<hr>\n"@@ -93,21 +95,21 @@ in s ~-> errFancy posI (nonFlanking "_") it "CM26" $ " *\\-*" ==-> "<p><em>-</em></p>\n"- xit "CM27" $ -- FIXME pending lists+ it "CM27" $ "- foo\n***\n- bar" ==->- "<ul>\n<li>foo</li>\n</ul>\n<hr />\n<ul>\n<li>bar</li>\n</ul>\n"+ "<ul>\n<li>\nfoo\n</li>\n</ul>\n<hr>\n<ul>\n<li>\nbar\n</li>\n</ul>\n" it "CM28" $- let s = "Foo\n***\nbar"- in s ~-> errFancy (posN 6 s) (nonFlanking "*")+ "Foo\n***\nbar" ==->+ "<p>Foo</p>\n<hr>\n<p>bar</p>\n" xit "CM29" $ -- FIXME pending setext headings "Foo\n---\nbar" ==-> "<h2>Foo</h2>\n<p>bar</p>\n"- xit "CM30" $ -- FIXME pending lists+ it "CM30" $ "* Foo\n* * *\n* Bar" ==->- "<ul>\n<li>Foo</li>\n</ul>\n<hr />\n<ul>\n<li>Bar</li>\n</ul>\n"- xit "CM31" $ -- FIXME pending lists+ "<ul>\n<li>\nFoo\n</li>\n<li>\n<ul>\n<li>\n<ul>\n<li>\n\n</li>\n</ul>\n</li>\n</ul>\n</li>\n<li>\nBar\n</li>\n</ul>\n"+ it "CM31" $ "- Foo\n- * * *" ==->- "<ul>\n<li>Foo</li>\n<li>\n<hr />\n</li>\n</ul>\n"+ "<ul>\n<li>\nFoo\n</li>\n<li>\n<hr>\n</li>\n</ul>\n" context "4.2 ATX headings" $ do it "CM32" $ "# foo\n## foo\n### foo\n#### foo\n##### foo\n###### foo" ==->@@ -123,7 +125,7 @@ it "CM35" $ "\\## foo" ==-> "<p>## foo</p>\n" it "CM36" $- "# foo *bar* \\*baz\\*" ==-> "<h1 id=\"foo-bar-*baz*\">foo <em>bar</em> *baz*</h1>\n"+ "# foo *bar* \\*baz\\*" ==-> "<h1 id=\"foo-bar-baz\">foo <em>bar</em> *baz*</h1>\n" it "CM37" $ "# foo " ==-> "<h1 id=\"foo\">foo</h1>\n"@@ -143,18 +145,18 @@ it "CM43" $ "### foo ### " ==-> "<h3 id=\"foo\">foo</h3>\n" it "CM44" $- "### foo ### b" ==-> "<h3 id=\"foo-###-b\">foo ### b</h3>\n"+ "### foo ### b" ==-> "<h3 id=\"foo-b\">foo ### b</h3>\n" it "CM45" $- "# foo#" ==-> "<h1 id=\"foo#\">foo#</h1>\n"+ "# foo#" ==-> "<h1 id=\"foo\">foo#</h1>\n" it "CM46" $ "### foo \\###\n## foo #\\##\n# foo \\#" ==->- "<h3 id=\"foo-###\">foo ###</h3>\n<h2 id=\"foo-###\">foo ###</h2>\n<h1 id=\"foo-#\">foo #</h1>\n"+ "<h3 id=\"foo\">foo ###</h3>\n<h2 id=\"foo\">foo ###</h2>\n<h1 id=\"foo\">foo #</h1>\n" it "CM47" $ "****\n## foo\n****" ==-> "<hr>\n<h2 id=\"foo\">foo</h2>\n<hr>\n" it "CM48" $ "Foo bar\n# baz\nBar foo" ==->- "<p>Foo bar\n# baz\nBar foo</p>\n"+ "<p>Foo bar</p>\n<h1 id=\"baz\">baz</h1>\n<p>Bar foo</p>\n" it "CM49" $ let s = "## \n#\n### ###" in s ~~->@@ -164,12 +166,12 @@ it "CM76" $ " a simple\n indented code block" ==-> "<pre><code>a simple\n indented code block\n</code></pre>\n"- xit "CM77" $ -- FIXME pending lists+ it "CM77" $ " - foo\n\n bar" ==-> "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"- xit "CM78" $ -- FIXME pending lists+ it "CM78" $ "1. foo\n\n - bar" ==->- "<ol>\n<li>\n<p>foo</p>\n<ul>\n<li>bar</li>\n</ul>\n</li>\n</ol>\n"+ "<ol>\n<li>\n<p>foo</p>\n<ul>\n<li>\nbar\n</li>\n</ul>\n</li>\n</ol>\n" it "CM79" $ " <a/>\n *hi*\n\n - one" ==-> "<pre><code><a/>\n*hi*\n\n- one\n</code></pre>\n"@@ -224,9 +226,9 @@ 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" ==->- "<blockquote>\n<pre><code>aaa\n</code></pre>\n</blockquote>\n<p>bbb</p>\n"+ it "CM96" $+ let s = "> ```\n> aaa\n\nbbb\n"+ in s ~-> err (posN 17 s) (ueof <> elabel "closing code fence" <> elabel "code block content") it "CM97" $ "```\n\n \n```" ==-> "<pre><code>\n \n</code></pre>\n"@@ -311,6 +313,303 @@ it "CM188" $ " \n\naaa\n \n\n# aaa\n\n " ==-> "<p>aaa</p>\n<h1 id=\"aaa\">aaa</h1>\n"+ context "5.1 Block quotes" $ do+ it "CM189" $+ "> # Foo\n bar\n baz" ==->+ "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n<p>bar\nbaz</p>\n</blockquote>\n"+ it "CM190" $+ "># Foo\n bar\n baz" ==->+ "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n<p>bar\nbaz</p>\n</blockquote>\n"+ it "CM191" $+ " > # Foo\n bar\n baz" ==->+ "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n<p>bar\nbaz</p>\n</blockquote>\n"+ it "CM192" $+ " > # Foo\n > bar\n > baz" ==->+ "<pre><code>> # Foo\n> bar\n> baz\n</code></pre>\n"+ it "CM193" $+ "> # Foo\n> bar\nbaz" ==->+ "<blockquote>\n<h1 id=\"foo\">Foo</h1>\n</blockquote>\n<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n"+ it "CM194" $+ "> bar\nbaz\n> foo" ==->+ "<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n<blockquote>\n<p>foo</p>\n</blockquote>\n"+ it "CM195" $+ "> foo\n---" ==->+ "<blockquote>\n<p>foo</p>\n</blockquote>\n<hr>\n"+ it "CM196" $+ "> - foo\n- bar" ==->+ "<blockquote>\n<ul>\n<li>\nfoo\n</li>\n</ul>\n</blockquote>\n<ul>\n<li>\nbar\n</li>\n</ul>\n"+ it "CM197" $+ "> foo\n bar" ==->+ "<blockquote>\n<pre><code>foo\n</code></pre>\n<p>bar</p>\n</blockquote>\n"+ it "CM198" $+ "> ```\nfoo\n```" ==->+ "<blockquote>\n<pre><code>foo\n</code></pre>\n</blockquote>\n"+ it "CM199" $+ "> foo\n - bar" ==->+ "<blockquote>\n<p>foo</p>\n<ul>\n<li>\nbar\n</li>\n</ul>\n</blockquote>\n"+ it "CM200" $+ ">" ==->+ "<blockquote>\n</blockquote>\n"+ it "CM201" $+ ">\n> \n> " ==->+ "<blockquote>\n</blockquote>\n<blockquote>\n</blockquote>\n<blockquote>\n</blockquote>\n"+ it "CM202" $+ ">\n foo\n " ==->+ "<blockquote>\n<p>foo</p>\n</blockquote>\n"+ it "CM203" $+ "> foo\n\n> bar" ==->+ "<blockquote>\n<p>foo</p>\n</blockquote>\n<blockquote>\n<p>bar</p>\n</blockquote>\n"+ it "CM204" $+ "> foo\n bar" ==->+ "<blockquote>\n<p>foo\nbar</p>\n</blockquote>\n"+ it "CM205" $+ "> foo\n\n bar" ==->+ "<blockquote>\n<p>foo</p>\n<p>bar</p>\n</blockquote>\n"+ it "CM206" $+ "foo\n> bar" ==->+ "<p>foo</p>\n<blockquote>\n<p>bar</p>\n</blockquote>\n"+ it "CM207" $+ "> aaa\n***\n> bbb" ==->+ "<blockquote>\n<p>aaa</p>\n</blockquote>\n<hr>\n<blockquote>\n<p>bbb</p>\n</blockquote>\n"+ it "CM208" $+ "> bar\n baz" ==->+ "<blockquote>\n<p>bar\nbaz</p>\n</blockquote>\n"+ it "CM209" $+ "> bar\n\nbaz" ==->+ "<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n"+ it "CM210" $+ "> bar\n\nbaz" ==->+ "<blockquote>\n<p>bar</p>\n</blockquote>\n<p>baz</p>\n"+ it "CM211" $+ "> > > foo\nbar" ==->+ "<blockquote>\n<blockquote>\n<blockquote>\n<p>foo</p>\n</blockquote>\n</blockquote>\n</blockquote>\n<p>bar</p>\n"+ it "CM212" $+ ">>> foo\n bar\n baz" ==->+ "<blockquote>\n<blockquote>\n<blockquote>\n<p>foo\nbar\nbaz</p>\n</blockquote>\n</blockquote>\n</blockquote>\n"+ it "CM213" $+ "> code\n\n> not code" ==->+ "<blockquote>\n<pre><code>code\n</code></pre>\n</blockquote>\n<blockquote>\n<p>not code</p>\n</blockquote>\n"+ context "5.2 List items" $ do+ it "CM214" $+ "A paragraph\nwith two lines.\n\n indented code\n\n> A block quote." ==->+ "<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n"+ it "CM215" $+ "1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." ==->+ "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"+ it "CM216" $+ "- one\n\n two" ==->+ "<ul>\n<li>\none\n</li>\n</ul>\n<p>two</p>\n"+ it "CM217" $+ "- one\n\n two" ==->+ "<ul>\n<li>\n<p>one</p>\n<p>two</p>\n</li>\n</ul>\n"+ it "CM218" $+ " - one\n\n two" ==->+ "<ul>\n<li>\none\n</li>\n</ul>\n<pre><code> two\n</code></pre>\n"+ it "CM219" $+ " - one\n\n two" ==->+ "<ul>\n<li>\n<p>one</p>\n<p>two</p>\n</li>\n</ul>\n"+ it "CM220" $+ " > > 1. one\n\n two" ==->+ "<blockquote>\n<blockquote>\n<ol>\n<li>\none\n</li>\n</ol>\n<p>two</p>\n</blockquote>\n</blockquote>\n"+ it "CM221" $+ ">>- one\n\n two" ==->+ "<blockquote>\n<blockquote>\n<ul>\n<li>\n<p>one</p>\n<p>two</p>\n</li>\n</ul>\n</blockquote>\n</blockquote>\n"+ it "CM222" $+ "-one\n\n2.two" ==->+ "<p>-one</p>\n<p>2.two</p>\n"+ it "CM223" $+ "- foo\n\n\n bar" ==->+ "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"+ it "CM224" $+ "1. foo\n\n ```\n bar\n ```\n\n baz\n\n > bam" ==->+ "<ol>\n<li>\n<p>foo</p>\n<pre><code>bar\n</code></pre>\n<p>baz</p>\n<blockquote>\n<p>bam</p>\n</blockquote>\n</li>\n</ol>\n"+ it "CM225" $+ "- Foo\n\n bar\n\n\n baz" ==->+ "<ul>\n<li>\n<p>Foo</p>\n<pre><code>bar\n\n\nbaz\n</code></pre>\n</li>\n</ul>\n"+ it "CM226" $+ "123456789. ok" ==->+ "<ol start=\"123456789\">\n<li>\nok\n</li>\n</ol>\n"+ it "CM227" $+ let s = "1234567890. not ok\n"+ in s ~-> errFancy posI (indexTooBig 1234567890)+ it "CM228" $+ "0. ok" ==->+ "<ol start=\"0\">\n<li>\nok\n</li>\n</ol>\n"+ it "CM229" $+ "003. ok" ==->+ "<ol start=\"3\">\n<li>\nok\n</li>\n</ol>\n"+ it "CM230" $+ "-1. not ok" ==->+ "<p>-1. not ok</p>\n"+ it "CM231" $+ "- foo\n\n bar" ==->+ "<ul>\n<li>\n<p>foo</p>\n<pre><code>bar\n</code></pre>\n</li>\n</ul>\n"+ it "CM232" $+ " 10. foo\n\n bar" ==->+ "<ol start=\"10\">\n<li>\n<p>foo</p>\n<pre><code>bar\n</code></pre>\n</li>\n</ol>\n"+ it "CM233" $+ " indented code\n\nparagraph\n\n more code" ==->+ "<pre><code>indented code\n</code></pre>\n<p>paragraph</p>\n<pre><code>more code\n</code></pre>\n"+ it "CM234" $+ "1. indented code\n\n paragraph\n\n more code" ==->+ "<ol>\n<li>\n<pre><code>indented code\n</code></pre>\n<p>paragraph</p>\n<pre><code>more code\n</code></pre>\n</li>\n</ol>\n"+ it "CM235" $+ "1. indented code\n\n paragraph\n\n more code" ==->+ "<ol>\n<li>\n<pre><code> indented code\n</code></pre>\n<p>paragraph</p>\n<pre><code>more code\n</code></pre>\n</li>\n</ol>\n"+ it "CM236" $+ " foo\n\nbar" ==->+ "<p>foo</p>\n<p>bar</p>\n"+ it "CM237" $+ "- foo\n\n bar" ==->+ "<ul>\n<li>\nfoo\n</li>\n</ul>\n<p>bar</p>\n"+ it "CM238" $+ "- foo\n\n bar" ==->+ "<ul>\n<li>\n<p>foo</p>\n<p>bar</p>\n</li>\n</ul>\n"+ it "CM239" $+ "-\n foo\n-\n ```\n bar\n ```\n-\n baz" ==->+ "<ul>\n<li>\n<p>foo</p>\n</li>\n<li>\n<pre><code>bar\n</code></pre>\n</li>\n<li>\n<pre><code>baz\n</code></pre>\n</li>\n</ul>\n"+ it "CM240" $+ "- \n foo" ==->+ "<ul>\n<li>\nfoo\n</li>\n</ul>\n"+ it "CM241" $+ "-\n\n foo" ==->+ "<ul>\n<li>\n\n</li>\n</ul>\n<p>foo</p>\n"+ it "CM241b" $+ "1.\n\n foo" ==->+ "<ol>\n<li>\n\n</li>\n</ol>\n<p>foo</p>\n"+ it "CM242" $+ "- foo\n-\n- bar" ==->+ "<ul>\n<li>\nfoo\n</li>\n<li>\n\n</li>\n<li>\nbar\n</li>\n</ul>\n"+ it "CM243" $+ "- foo\n- \n- bar" ==->+ "<ul>\n<li>\nfoo\n</li>\n<li>\n\n</li>\n<li>\nbar\n</li>\n</ul>\n"+ it "CM244" $+ "1. foo\n2.\n3. bar" ==->+ "<ol>\n<li>\nfoo\n</li>\n<li>\n\n</li>\n<li>\nbar\n</li>\n</ol>\n"+ it "CM245" $+ "*" ==->+ "<ul>\n<li>\n\n</li>\n</ul>\n"+ it "CM246" $+ "foo\n*\n\nfoo\n1." ==->+ "<p>foo</p>\n<ul>\n<li>\n\n</li>\n</ul>\n<p>foo</p>\n<ol>\n<li>\n\n</li>\n</ol>\n"+ it "CM247" $+ " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." ==->+ "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"+ it "CM248" $+ " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." ==->+ "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"+ it "CM249" $+ " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." ==->+ "<ol>\n<li>\n<p>A paragraph\nwith two lines.</p>\n<pre><code>indented code\n</code></pre>\n<blockquote>\n<p>A block quote.</p>\n</blockquote>\n</li>\n</ol>\n"+ it "CM250" $+ " 1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote." ==->+ "<pre><code>1. A paragraph\n with two lines.\n\n indented code\n\n > A block quote.\n</code></pre>\n"+ it "CM251" $+ " 1. A paragraph\nwith two lines.\n\n indented code\n\n > A block quote." ==->+ "<ol>\n<li>\nA paragraph\n</li>\n</ol>\n<p>with two lines.</p>\n<pre><code> indented code\n\n > A block quote.\n</code></pre>\n"+ it "CM252" $+ " 1. A paragraph\n with two lines." ==->+ "<ol>\n<li>\nA paragraph\n</li>\n</ol>\n<pre><code>with two lines.\n</code></pre>\n"+ it "CM253" $+ "> 1. > Blockquote\ncontinued here." ==->+ "<blockquote>\n<ol>\n<li>\n<blockquote>\n<p>Blockquote</p>\n</blockquote>\n</li>\n</ol>\n</blockquote>\n<p>continued here.</p>\n"+ it "CM254" $+ "> 1. > Blockquote\n continued here." ==->+ "<blockquote>\n<ol>\n<li>\n<blockquote>\n<p>Blockquote</p>\n</blockquote>\n</li>\n</ol>\n<p>continued here.</p>\n</blockquote>\n"+ it "CM255" $+ "- foo\n - bar\n - baz\n - boo" ==->+ "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n<ul>\n<li>\nbaz\n<ul>\n<li>\nboo\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n"+ it "CM256" $+ "- foo\n - bar\n - baz\n - boo" ==->+ "<ul>\n<li>\nfoo\n</li>\n<li>\nbar\n</li>\n<li>\nbaz\n</li>\n<li>\nboo\n</li>\n</ul>\n"+ it "CM257" $+ "10) foo\n - bar" ==->+ "<ol start=\"10\">\n<li>\nfoo\n<ul>\n<li>\nbar\n</li>\n</ul>\n</li>\n</ol>\n"+ it "CM258" $+ "10) foo\n - bar" ==->+ "<ol start=\"10\">\n<li>\nfoo\n</li>\n</ol>\n<ul>\n<li>\nbar\n</li>\n</ul>\n"+ it "CM259" $+ "- - foo" ==->+ "<ul>\n<li>\n<ul>\n<li>\nfoo\n</li>\n</ul>\n</li>\n</ul>\n"+ it "CM260" $+ "1. - 2. foo" ==->+ "<ol>\n<li>\n<ul>\n<li>\n<ol start=\"2\">\n<li>\nfoo\n</li>\n</ol>\n</li>\n</ul>\n</li>\n</ol>\n"+ it "CM261" $+ "- # Foo\n- Bar\n ---\n baz" ==->+ "<ul>\n<li>\n<h1 id=\"foo\">Foo</h1>\n</li>\n<li>\n<p>Bar</p>\n<hr>\n<p>baz</p>\n</li>\n</ul>\n"+ context "5.3 Lists" $ do+ it "CM262" $+ "- foo\n- bar\n+ baz" ==->+ "<ul>\n<li>\nfoo\n</li>\n<li>\nbar\n</li>\n</ul>\n<ul>\n<li>\nbaz\n</li>\n</ul>\n"+ it "CM263" $+ "1. foo\n2. bar\n3) baz" ==->+ "<ol>\n<li>\nfoo\n</li>\n<li>\nbar\n</li>\n</ol>\n<ol start=\"3\">\n<li>\nbaz\n</li>\n</ol>\n"+ it "CM264" $+ "Foo\n- bar\n- baz" ==->+ "<p>Foo</p>\n<ul>\n<li>\nbar\n</li>\n<li>\nbaz\n</li>\n</ul>\n"+ it "CM265" $+ "The number of windows in my house is\n14. The number of doors is 6." ==->+ "<p>The number of windows in my house is</p>\n<ol start=\"14\">\n<li>\nThe number of doors is 6.\n</li>\n</ol>\n"+ it "CM266" $+ "The number of windows in my house is\n1. The number of doors is 6." ==->+ "<p>The number of windows in my house is</p>\n<ol>\n<li>\nThe number of doors is 6.\n</li>\n</ol>\n"+ it "CM267" $+ "- foo\n\n- bar\n\n\n- baz" ==->+ "<ul>\n<li>\n<p>foo</p>\n</li>\n<li>\n<p>bar</p>\n</li>\n<li>\n<p>baz</p>\n</li>\n</ul>\n"+ it "CM268" $+ "- foo\n - bar\n - baz\n\n\n bim" ==->+ "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n<ul>\n<li>\n<p>baz</p>\n<p>bim</p>\n</li>\n</ul>\n</li>\n</ul>\n</li>\n</ul>\n"+ xit "CM269" $ -- FIXME pending HTML blocks+ "- foo\n- bar\n\n<!-- -->\n\n- baz\n- bim" ==->+ "<ul>\n<li>foo</li>\n<li>bar</li>\n</ul>\n<!-- -->\n<ul>\n<li>baz</li>\n<li>bim</li>\n</ul>\n"+ xit "CM270" $ -- FIXME pending HTML blocks+ "- foo\n\n notcode\n\n- foo\n\n<!-- -->\n\n code" ==->+ "<ul>\n<li>\n<p>foo</p>\n<p>notcode</p>\n</li>\n<li>\n<p>foo</p>\n</li>\n</ul>\n<!-- -->\n<pre><code>code\n</code></pre>\n"+ it "CM271" $+ "- a\n - b\n - c\n - d\n - e\n - f\n - g\n - h\n- i" ==->+ "<ul>\n<li>\na\n</li>\n<li>\nb\n</li>\n<li>\nc\n</li>\n<li>\nd\n</li>\n<li>\ne\n</li>\n<li>\nf\n</li>\n<li>\ng\n</li>\n<li>\nh\n</li>\n<li>\ni\n</li>\n</ul>\n"+ it "CM272" $+ "1. a\n\n 2. b\n\n 3. c" ==->+ "<ol>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n</li>\n<li>\n<p>c</p>\n</li>\n</ol>\n"+ it "CM273" $+ "- a\n- b\n\n- c" ==->+ "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"+ it "CM274" $+ "* a\n*\n\n* c" ==->+ "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p></p>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"+ it "CM275" $+ "- a\n- b\n\n c\n- d" ==->+ "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n<p>c</p>\n</li>\n<li>\n<p>d</p>\n</li>\n</ul>\n"+ xit "CM276" $ -- FIXME pending reference links+ "- a\n- b\n\n [ref]: /url\n- d" ==->+ "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<p>b</p>\n</li>\n<li>\n<p>d</p>\n</li>\n</ul>\n"+ it "CM277" $+ "- a\n- ```\n b\n\n\n ```\n- c" ==->+ "<ul>\n<li>\n<p>a</p>\n</li>\n<li>\n<pre><code>b\n\n\n</code></pre>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"+ it "CM278" $+ "- a\n - b\n\n c\n- d" ==->+ "<ul>\n<li>\na\n<ul>\n<li>\n<p>b</p>\n<p>c</p>\n</li>\n</ul>\n</li>\n<li>\nd\n</li>\n</ul>\n"+ it "CM279" $+ "* a\n > b\n >\n* c" ==->+ "<ul>\n<li>\n<p>a</p>\n<blockquote>\n<p>b</p>\n</blockquote>\n<blockquote>\n</blockquote>\n</li>\n<li>\n<p>c</p>\n</li>\n</ul>\n"+ it "CM280" $+ "- a\n > b\n ```\n c\n ```\n- d" ==->+ "<ul>\n<li>\n<p>a</p>\n<blockquote>\n<p>b</p>\n</blockquote>\n<pre><code>c\n</code></pre>\n</li>\n<li>\n<p>d</p>\n</li>\n</ul>\n"+ it "CM281" $+ "- a" ==->+ "<ul>\n<li>\na\n</li>\n</ul>\n"+ it "CM282" $+ "- a\n - b" ==->+ "<ul>\n<li>\na\n<ul>\n<li>\nb\n</li>\n</ul>\n</li>\n</ul>\n"+ it "CM283" $+ "1. ```\n foo\n ```\n\n bar" ==->+ "<ol>\n<li>\n<pre><code>foo\n</code></pre>\n<p>bar</p>\n</li>\n</ol>\n"+ it "CM284" $+ "* foo\n * bar\n\n baz" ==->+ "<ul>\n<li>\nfoo\n<ul>\n<li>\nbar\n</li>\n</ul>\nbaz\n</li>\n</ul>\n"+ it "CM285" $+ "- a\n - b\n - c\n\n- d\n - e\n - f" ==->+ "<ul>\n<li>\na\n<ul>\n<li>\nb\n</li>\n<li>\nc\n</li>\n</ul>\n</li>\n<li>\nd\n<ul>\n<li>\ne\n</li>\n<li>\nf\n</li>\n</ul>\n</li>\n</ul>\n" context "6 Inlines" $ it "CM286" $ let s = "`hi`lo`\n"@@ -454,7 +753,7 @@ in s ~-> errFancy (posN 9 s) (nonFlanking "*") it "CM345" $ let s = "*foo bar\n*\n"- in s ~-> errFancy (posN 9 s) (nonFlanking "*")+ in s ~-> err (posN 8 s) (ueib <> etok '*' <> eic <> eric) it "CM346" $ let s = "*(*foo)\n" in s ~-> errFancy posI (nonFlanking "*")@@ -903,8 +1202,8 @@ it "CM544" $ "](/url2)" ==-> "<p><img src=\"/url2\" alt=\"foo bar\"></p>\n"- it "CM545" pending- it "CM546" pending+ it "CM545" pending -- FIXME pending reference images+ it "CM546" pending -- FIXME pending reference images it "CM547" $ "" ==-> "<p><img src=\"train.jpg\" alt=\"foo\"></p>\n"@@ -916,7 +1215,7 @@ "<p><img src=\"url\" alt=\"foo\"></p>\n" it "CM550" $ "" ==-> "<p><img src=\"/url\" alt></p>\n"- it "CM551-CM562" pending -- pending reference-style stuff+ it "CM551-CM562" pending -- FIXME pending reference-style stuff context "6.7 Autolinks" $ do it "CM563" $ "<http://foo.bar.baz>" ==->@@ -1005,7 +1304,7 @@ xit "CM615" $ "foo " ==-> "<p>foo</p>\n" it "CM616" $- "### foo\\" ==-> "<h3 id=\"foo\\\">foo\\</h3>\n"+ "### foo\\" ==-> "<h3 id=\"foo\">foo\\</h3>\n" it "CM617" $ "### foo " ==-> "<h3 id=\"foo\">foo</h3>\n" context "6.10 Soft line breaks" $ do@@ -1065,6 +1364,40 @@ s ~~-> [ err (posN 1 s) (utok 'M' <> etok '#' <> elabel "white space") , errFancy (posN 35 s) (nonFlanking "_") ]+ describe "every block in a list gets its parse error propagated" $ do+ context "with unordered list" $+ it "works" $ do+ let s = "- *foo\n\n *bar\n- *baz\n\n *quux\n"+ e = ueib <> etok '*' <> eic <> eric+ s ~~->+ [ err (posN 6 s) e+ , err (posN 14 s) e+ , err (posN 21 s) e+ , err (posN 30 s) e ]+ context "with ordered list" $+ it "works" $ do+ let s = "1. *foo\n\n *bar\n2. *baz\n\n *quux\n"+ e = ueib <> etok '*' <> eic <> eric+ s ~~->+ [ err (posN 7 s) e+ , err (posN 16 s) e+ , err (posN 24 s) e+ , err (posN 34 s) e ]+ it "too big start index of ordered list does not prevent validation of inner inlines" $ do+ let s = "1234567890. *something\n1234567891. [\n"+ s ~~->+ [ errFancy posI (indexTooBig 1234567890)+ , err (posN 22 s) (ueib <> etok '*' <> eic <> eric)+ , err (posN 36 s) (ueib <> etok ']') ]+ it "non-consecutive indices in ordered list do not prevent further validation" $ do+ let s = "1. *foo\n3. *bar\n4. *baz\n"+ e = ueib <> etok '*' <> eic <> eric+ s ~~->+ [ err (posN 7 s) e+ , errFancy (posN 8 s) (indexNonCons 3 2)+ , err (posN 15 s) e+ , errFancy (posN 16 s) (indexNonCons 4 3)+ , err (posN 23 s) e ] context "given a complete, comprehensive document" $ it "outputs expected the HTML fragment" $ withFiles "data/comprehensive.md" "data/comprehensive.html"@@ -1112,17 +1445,23 @@ 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."+ doc <- mkDoc "---\nx: 100\ny: 200\n---\nHere we go." let r = object [ "x" .= Number 100 , "y" .= Number 200 ] MMark.projectYaml doc `shouldBe` Just r- context "when it is invalid" $+ context "when it is invalid" $ do+ let mappingErr = fancy . ErrorCustom . YamlParseError $+ "mapping values are not allowed in this context" 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")+ let s = "---\nx: 100\ny: x:\n---\nHere we go."+ in s ~-> errFancy (posN 15 s) mappingErr+ it "does not choke and can report more parse errors" $+ let s = "---\nx: 100\ny: x:\n---\nHere we *go."+ in s ~~->+ [ errFancy (posN 15 s) mappingErr+ , err (posN 33 s) (ueib <> etok '*' <> eic <> eric)+ ] ---------------------------------------------------------------------------- -- Testing extensions@@ -1200,3 +1539,16 @@ nonFlanking :: Text -> EF MMarkErr nonFlanking = fancy . ErrorCustom . NonFlankingDelimiterRun . NE.fromList . T.unpack++-- | Create a error component complaining that the given starting index of+-- an ordered list is too big.++indexTooBig :: Word -> EF MMarkErr+indexTooBig = fancy . ErrorCustom . ListStartIndexTooBig++-- | Create a error component complaining about non-consecutive indices in+-- an ordered list.++indexNonCons :: Word -> Word -> EF MMarkErr+indexNonCons actual expected = fancy . ErrorCustom $+ ListIndexOutOfOrder actual expected