mmark 0.0.5.6 → 0.0.6.0
raw patch · 13 files changed
+448/−402 lines, 13 filesdep ~hspec-megaparsecdep ~megaparsecdep ~modern-uriPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: hspec-megaparsec, megaparsec, modern-uri
API changes (from Hackage documentation)
- Text.MMark: parseErrorsPretty :: Text -> NonEmpty (ParseError Char MMarkErr) -> String
- Text.MMark: parse :: FilePath -> Text -> Either (NonEmpty (ParseError Char MMarkErr)) MMark
+ Text.MMark: parse :: FilePath -> Text -> Either (ParseErrorBundle Text MMarkErr) MMark
Files
- CHANGELOG.md +12/−0
- README.md +1/−2
- Text/MMark.hs +1/−20
- Text/MMark/Parser.hs +104/−80
- Text/MMark/Parser/Internal.hs +31/−14
- Text/MMark/Parser/Internal/Type.hs +5/−3
- Text/MMark/Render.hs +5/−1
- Text/MMark/Type.hs +5/−1
- Text/MMark/Util.hs +0/−5
- mmark.cabal +22/−15
- tests/Text/MMark/ExtensionSpec.hs +0/−5
- tests/Text/MMark/TestUtils.hs +21/−12
- tests/Text/MMarkSpec.hs +241/−244
CHANGELOG.md view
@@ -1,3 +1,15 @@+## MMark 0.0.6.0++* Uses Megaparsec 7. The `parse` function now returns `ParseErrorBundle` on+ failure.++* Dropped `parseErrorsPretty`, use `errorBundlePretty` from `megaparsec`+ instead.++## MMark 0.0.5.7++* Improved parse errors related to the optional YAML block.+ ## MMark 0.0.5.6 * Now `blockTrans` and `inlineTrans` are applied to deeply nested elements
README.md view
@@ -5,7 +5,6 @@ [](http://stackage.org/nightly/package/mmark) [](http://stackage.org/lts/package/mmark) [](https://travis-ci.org/mmark-md/mmark)-[](https://coveralls.io/github/mmark-md/mmark?branch=master) * [Quick start: MMark vs GitHub-flavored markdown](#quick-start-mmark-vs-github-flavored-markdown) * [MMark and Common Mark](#mmark-and-common-mark)@@ -91,7 +90,7 @@ * automatic assignment of ids to headers * pipe tables (as on GitHub) -One do not need to enable or tweak anything for these to work, they are+One does not need to enable or tweak anything for these to work, they are built-in features. ### Differences in inline parsing
Text/MMark.hs view
@@ -38,7 +38,7 @@ -- * automatic assignment of ids to headers -- * pipe tables (as on GitHub) ----- One do not need to enable or tweak anything for these to work, they are+-- One does not need to enable or tweak anything for these to work, they are -- built-in features. -- -- The readme contains a more detailed description of differences between@@ -117,7 +117,6 @@ MMark , MMarkErr (..) , parse- , parseErrorsPretty -- * Extensions , Extension , useExtension@@ -131,29 +130,11 @@ where import Data.Aeson-import Data.List.NonEmpty (NonEmpty (..)) import Data.Semigroup ((<>))-import Data.Text (Text) import Text.MMark.Parser (MMarkErr (..), parse) import Text.MMark.Render (render) import Text.MMark.Type-import Text.Megaparsec (ParseError (..), parseErrorPretty_, mkPos) import qualified Control.Foldl as L--------------------------------------------------------------------------------- Parsing---- | Pretty-print a collection of parse errors returned from 'parse'.------ __Pro tip__: if you would like to pretty-print a single 'ParseError', use--- @'parseErrorPretty_' ('mkPos' 4)@, because Common Mark suggests that we--- should assume tab width 4, and that's what we do in the parser.--parseErrorsPretty- :: Text -- ^ Original input for parser- -> NonEmpty (ParseError Char MMarkErr) -- ^ Collection of parse errors- -> String -- ^ Result of pretty-printing-parseErrorsPretty input = concatMap (parseErrorPretty_ (mkPos 4) input) ---------------------------------------------------------------------------- -- Extensions
Text/MMark/Parser.hs view
@@ -29,12 +29,11 @@ import Data.Bool (bool) import Data.HTML.Entities (htmlEntityMap) import Data.List.NonEmpty (NonEmpty (..), (<|))-import Data.Maybe (isNothing, fromJust, fromMaybe, catMaybes, isJust)+import Data.Maybe (isNothing, fromJust, catMaybes, isJust) import Data.Monoid (Any (..)) import Data.Ratio ((%)) import Data.Semigroup (Semigroup (..)) import Data.Text (Text)-import Data.Void import Lens.Micro ((^.)) import Text.MMark.Parser.Internal import Text.MMark.Type@@ -91,11 +90,11 @@ -- ^ File name (only to be used in error messages), may be empty -> Text -- ^ Input to parse- -> Either (NonEmpty (ParseError Char MMarkErr)) MMark+ -> Either (ParseErrorBundle Text MMarkErr) MMark -- ^ Parse errors or parsed document parse file input = case runBParser pMMark file input of- Left errs -> Left errs+ Left bundle -> Left bundle Right ((myaml, rawBlocks), defs) -> let parsed = doInline <$> rawBlocks doInline = fmap@@ -107,7 +106,16 @@ { mmarkYaml = myaml , mmarkBlocks = fmap fromRight <$> parsed , mmarkExtension = mempty }- Just errs -> Left errs+ Just errs -> Left ParseErrorBundle+ { bundleErrors = errs+ , bundlePosState = PosState+ { pstateInput = input+ , pstateOffset = 0+ , pstateSourcePos = initialPos file+ , pstateTabWidth = mkPos 4+ , pstateLinePrefix = ""+ }+ } ---------------------------------------------------------------------------- -- Block parser@@ -117,14 +125,13 @@ 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 (Left (o, err)) ->+ (Nothing, prependErr o (YamlParseError err) blocks) Just (Right yaml) -> (Just yaml, blocks) @@ -132,9 +139,8 @@ -- '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 :: BParser (Either (Int, String) Yaml.Value) pYamlBlock = do- dpos <- getPosition string "---" *> sc' *> eol let go acc = do l <- takeWhileP Nothing notNewline@@ -143,12 +149,13 @@ if e || T.stripEnd l == "---" then return acc else go (acc . (l:))+ doffset <- getOffset ls <- go id <*> ([] <$ sc) return $- case (Yaml.decodeEither . TE.encodeUtf8 . T.intercalate "\n") ls of+ case (Yaml.decodeEither' . TE.encodeUtf8 . T.intercalate "\n") ls of Left err' ->- let (apos, err) = splitYamlError (sourceName dpos) err'- in Left (fromMaybe dpos apos, err)+ let (moffset, err) = splitYamlError err'+ in Left (maybe doffset (+ doffset) moffset, err) Right v -> Right v -- | Parse several (possibly zero) blocks in a row.@@ -200,7 +207,7 @@ withRecovery recover $ do hlevel <- length <$> hashIntro sc1'- ispPos <- getPosition+ ispOffset <- getOffset r <- someTill (satisfy notNewline <?> "heading character") . try $ optional (sc1' *> some (char '#') *> sc') *> (eof <|> eol) let toBlock = case hlevel of@@ -210,7 +217,7 @@ 4 -> Heading4 5 -> Heading5 _ -> Heading6- toBlock (IspSpan ispPos (T.strip (T.pack r))) <$ sc+ toBlock (IspSpan ispOffset (T.strip (T.pack r))) <$ sc where hashIntro = count' 1 6 (char '#') recover err =@@ -298,7 +305,7 @@ return (UnorderedList (normalizeListItems (x:|xs))) where innerBlocks bulletPos minLevel indLevel = do- p <- getPosition+ p <- getSourcePos let tooFar = sourceLine p > sourceLine bulletPos <> pos1 rlevel = slevel minLevel indLevel if tooFar || sourceColumn p < minLevel@@ -318,7 +325,7 @@ -- ^ Bullet 'Char' and start position of the first bullet in a list -> BParser (Char, SourcePos, Pos, Pos) pListBullet mbullet = try $ do- pos <- getPosition+ pos <- getSourcePos l <- (<> mkPos 2) <$> L.indentLevel bullet <- case mbullet of@@ -334,28 +341,30 @@ pOrderedList :: BParser (Block Isp) pOrderedList = do+ startOffset <- getOffset (startIx, del, startPos, minLevel, indLevel) <- pListIndex Nothing x <- innerBlocks startPos minLevel indLevel xs <- manyIndexed (startIx + 1) $ \expectedIx -> do+ startOffset' <- getOffset (actualIx, _, startPos', minLevel', indLevel') <- pListIndex (Just (del, startPos)) let f blocks = if actualIx == expectedIx then blocks else prependErr- startPos'+ startOffset' (ListIndexOutOfOrder actualIx expectedIx) blocks f <$> innerBlocks startPos' minLevel' indLevel' return . OrderedList startIx . normalizeListItems $ (if startIx <= 999999999 then x- else prependErr startPos (ListStartIndexTooBig startIx) x)+ else prependErr startOffset (ListStartIndexTooBig startIx) x) :| xs where innerBlocks indexPos minLevel indLevel = do- p <- getPosition+ p <- getSourcePos let tooFar = sourceLine p > sourceLine indexPos <> pos1 rlevel = slevel minLevel indLevel if tooFar || sourceColumn p < minLevel@@ -376,7 +385,7 @@ -- ^ Delimiter 'Char' and start position of the first index in a list -> BParser (Word, Char, SourcePos, Pos, Pos) pListIndex mstart = try $ do- pos <- getPosition+ pos <- getSourcePos i <- L.decimal del <- case mstart of Nothing -> char '.' <|> char ')'@@ -413,7 +422,7 @@ pReferenceDef :: BParser (Maybe (Block Isp)) pReferenceDef = do- (pos, dlabel) <- try (pRefLabel <* char ':')+ (o, dlabel) <- try (pRefLabel <* char ':') withRecovery recover $ do sc' <* optional eol <* sc' uri <- pUri@@ -429,7 +438,7 @@ _ -> hidden eof <|> eol conflict <- registerReference dlabel (uri, mtitle) when conflict $ do- setPosition pos+ setOffset o customFailure (DuplicateReferenceDefinition dlabel) Nothing <$ sc where@@ -462,12 +471,12 @@ Table caligns (headerRow :| otherRows) <$ sc where cell = do- startPos <- getPosition+ o <- getOffset txt <- fmap (T.stripEnd . T.pack) . foldMany' . choice $ [ (++) . T.unpack <$> hidden (string "\\|") , (++) . T.unpack <$> pCodeSpanB , (:) <$> label "inline content" (satisfy cellChar) ]- return (IspSpan startPos txt)+ return (IspSpan o txt) cellChar x = x /= '|' && notNewline x rowWrapper p = do void (optional pipe)@@ -506,7 +515,7 @@ pParagraph :: BParser (Block Isp) pParagraph = do- startPos <- getPosition+ startOffset <- getOffset allowNaked <- isNakedAllowed rlevel <- refLevel let go ls = do@@ -540,7 +549,7 @@ then go id else return (id, Naked) (if allowNaked then toBlock else Paragraph)- (IspSpan startPos (assembleParagraph (l:ls []))) <$ sc+ (IspSpan startOffset (assembleParagraph (l:ls []))) <$ sc ---------------------------------------------------------------------------- -- Auxiliary block-level parsers@@ -582,7 +591,7 @@ then (return . nes . Plain) "" else unexpEic EndOfInput else NE.some $ do- mch <- lookAhead (anyChar <?> "inline content")+ mch <- lookAhead (anySingle <?> "inline content") case mch of '`' -> pCodeSpan '[' -> do@@ -632,10 +641,10 @@ pLink :: IParser Inline pLink = do void (char '[')- pos <- getPosition+ o <- getOffset txt <- disallowLinks (disallowEmpty pInlines) void (char ']')- (dest, mtitle) <- pLocation pos txt+ (dest, mtitle) <- pLocation o txt Link txt dest mtitle <$ lastChar OtherChar -- | Parse an image.@@ -647,17 +656,15 @@ Image alt src mtitle <$ lastChar OtherChar where emptyAlt = do- pos <- getPosition+ o <- getOffset void (string "![]")- let alt = nes (Plain "")- newColumn = sourceColumn pos <> mkPos 2- return (pos { sourceColumn = newColumn }, alt)+ return (o + 2, nes (Plain "")) nonEmptyAlt = do void (string "![")- pos <- getPosition+ o <- getOffset alt <- disallowImages (disallowEmpty pInlines) void (char ']')- return (pos, alt)+ return (o, alt) -- | Parse an autolink. @@ -710,7 +717,7 @@ pPlain :: IParser Inline pPlain = fmap (Plain . bakeText) . foldSome $ do- ch <- lookAhead (anyChar <?> "inline content")+ ch <- lookAhead (anySingle <?> "inline content") let newline' = (('\n':) . dropWhile isSpace) <$ eol <* sc' <* lastChar SpaceChar case ch of@@ -749,14 +756,14 @@ -- | Parse an inline and reference-style link\/image location. pLocation- :: SourcePos -- ^ Location where the content inlines start+ :: Int -- ^ Offset where the content inlines start -> NonEmpty Inline -- ^ The inner content inlines -> IParser (URI, Maybe Text) -- ^ URI and optionally title-pLocation innerPos inner = do+pLocation innerOffset inner = do mr <- optional (inplace <|> withRef) case mr of Nothing ->- collapsed innerPos inner <|> shortcut innerPos inner+ collapsed innerOffset inner <|> shortcut innerOffset inner Just (dest, mtitle) -> return (dest, mtitle) where@@ -772,20 +779,20 @@ return (dest, mtitle) withRef = pRefLabel >>= uncurry lookupRef- collapsed pos inlines = do+ collapsed o inlines = do -- NOTE We need to do these manipulations so the failure caused by -- 'string' "" does not overwrite our custom failures.- pos' <- getPosition- setPosition pos+ o' <- getOffset+ setOffset o (void . hidden . string) "[]"- setPosition pos'- lookupRef pos (mkLabel inlines)- shortcut pos inlines =- lookupRef pos (mkLabel inlines)- lookupRef pos dlabel =+ setOffset o'+ lookupRef o (mkLabel inlines)+ shortcut o inlines =+ lookupRef o (mkLabel inlines)+ lookupRef o dlabel = lookupReference dlabel >>= \case Left names -> do- setPosition pos+ setOffset o customFailure (CouldNotFindReferenceDefinition dlabel names) Right x -> return x@@ -821,23 +828,23 @@ -- | Parse label of a reference link. -pRefLabel :: MonadParsec MMarkErr Text m => m (SourcePos, Text)+pRefLabel :: MonadParsec MMarkErr Text m => m (Int, Text) pRefLabel = do try $ do void (char '[') notFollowedBy (char ']')- pos <- getPosition+ o <- getOffset sc let f x = x /= '[' && x /= ']' dlabel <- someEscapedWith f <?> "reference label" void (char ']')- return (pos, dlabel)+ return (o, dlabel) -- | Parse an opening markup sequence corresponding to given 'InlineState'. pLfdr :: IParser InlineState pLfdr = try $ do- pos <- getPosition+ o <- getOffset let r st = st <$ string (inlineStateDel st) st <- hidden $ choice [ r (DoubleFrame StrongFrame StrongFrame)@@ -855,7 +862,7 @@ , r (SingleFrame SuperscriptFrame) ] let dels = inlineStateDel st failNow = do- setPosition pos+ setOffset o (customFailure . NonFlankingDelimiterRun . toNesTokens) dels lch <- getLastChar rch <- getNextChar OtherChar@@ -871,10 +878,10 @@ TrivialError pos us es -> TrivialError pos us $ E.insert (Label $ NE.fromList "inline content") es other -> other- pos <- getPosition+ o <- getOffset (void . expectingInlineContent . string) dels let failNow = do- setPosition pos+ setOffset o (customFailure . NonFlankingDelimiterRun . toNesTokens) dels lch <- getLastChar rch <- getNextChar SpaceChar@@ -886,7 +893,7 @@ getNextChar :: CharType -- ^ What we should consider frame constituent characters -> IParser CharType-getNextChar frameType = lookAhead (option SpaceChar (charType <$> anyChar))+getNextChar frameType = lookAhead (option SpaceChar (charType <$> anySingle)) where charType ch | isFrameConstituent ch = frameType@@ -959,14 +966,14 @@ entityRef :: MonadParsec MMarkErr Text m => m String entityRef = do- pos <- getPosition- let f (TrivialError _ us es) = TrivialError (nes pos) us es- f (FancyError _ xs) = FancyError (nes pos) xs+ o <- getOffset+ let f (TrivialError _ us es) = TrivialError o us es+ f (FancyError _ xs) = FancyError o xs name <- try . region f $ between (char '&') (char ';') (takeWhile1P Nothing Char.isAlphaNum <?> "HTML5 entity name") case HM.lookup name htmlEntityMap of Nothing -> do- setPosition pos+ setOffset o customFailure (UnknownHtmlEntityName name) Just txt -> return (T.unpack txt) @@ -974,12 +981,12 @@ numRef :: MonadParsec MMarkErr Text m => m Char numRef = do- pos <- getPosition+ o <- getOffset let f = between (string "&#") (char ';') n <- try (f (char' 'x' *> L.hexadecimal)) <|> f L.decimal if n == 0 || n > fromEnum (maxBound :: Char) then do- setPosition pos+ setOffset o customFailure (InvalidNumericCharacter n) else return (Char.chr n) @@ -1119,7 +1126,7 @@ SubscriptFrame -> "~" SuperscriptFrame -> "^" -replaceEof :: forall e. Show e => String -> ParseError Char e -> ParseError Char e+replaceEof :: forall e. Show e => String -> ParseError Text e -> ParseError Text e replaceEof altLabel = \case TrivialError pos us es -> TrivialError pos (f <$> us) (E.map f es) FancyError pos xs -> FancyError pos xs@@ -1138,21 +1145,38 @@ else Nothing _ -> Nothing -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)+splitYamlError+ :: Yaml.ParseException+ -> (Maybe Int, String)+splitYamlError = \case+ Yaml.NonScalarKey -> (Nothing, "non scalar key")+ Yaml.UnknownAlias anchor -> (Nothing, "unknown alias \"" ++ anchor ++ "\"")+ Yaml.UnexpectedEvent exptd unexptd ->+ ( Nothing+ , "unexpected event: expected " ++ show exptd+ ++ ", but received " ++ show unexptd+ )+ Yaml.InvalidYaml myerror -> case myerror of+ Nothing -> (Nothing, "unspecified error")+ Just yerror -> case yerror of+ Yaml.YamlException s -> (Nothing, s)+ Yaml.YamlParseException problem context mark ->+ ( Just (Yaml.yamlIndex mark)+ , case context of+ "" -> problem+ _ -> context ++ ", " ++ problem+ )+ Yaml.AesonException s -> (Nothing, s)+ Yaml.OtherParseException exc -> (Nothing, show exc)+ Yaml.NonStringKeyAlias anchor value ->+ ( Nothing+ , "non-string key alias; anchor name: " ++ anchor+ ++ ", value: " ++ show value+ )+ Yaml.CyclicIncludes -> (Nothing, "cyclic includes") emptyIspSpan :: Isp-emptyIspSpan = IspSpan (initialPos "") ""+emptyIspSpan = IspSpan 0 "" normalizeListItems :: NonEmpty [Block Isp] -> NonEmpty [Block Isp] normalizeListItems xs' =@@ -1177,10 +1201,10 @@ 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+prependErr :: Int -> MMarkErr -> [Block Isp] -> [Block Isp]+prependErr o custom blocks = Naked (IspError err) : blocks where- err = FancyError (nes pos) (E.singleton $ ErrorCustom custom)+ err = FancyError o (E.singleton $ ErrorCustom custom) mailtoScheme :: URI.RText 'URI.Scheme mailtoScheme = fromJust (URI.mkScheme "mailto")
Text/MMark/Parser/Internal.hs view
@@ -41,10 +41,10 @@ where import Control.Monad.State.Strict+import Data.Bifunctor import Data.Default.Class import Data.Function ((&)) import Data.HashMap.Strict (HashMap)-import Data.List.NonEmpty (NonEmpty (..)) import Data.Ratio ((%)) import Data.Text (Text) import Data.Text.Metrics (damerauLevenshteinNorm)@@ -54,6 +54,7 @@ import Text.Megaparsec hiding (State) import Text.URI (URI) import qualified Data.HashMap.Strict as HM+import qualified Data.List.NonEmpty as NE import qualified Text.Megaparsec as M ----------------------------------------------------------------------------@@ -72,12 +73,14 @@ -- ^ File name (only to be used in error messages), may be empty -> Text -- ^ Input to parse- -> Either (NonEmpty (ParseError Char MMarkErr)) (a, Defs)+ -> Either (ParseErrorBundle Text MMarkErr) (a, Defs) -- ^ Result of parsing runBParser p file input =- case runState (runParserT p file input) def of- (Left err, _) -> Left (err :| [])- (Right x, st) -> Right (x, st ^. bstDefs)+ case runState (snd <$> runParserT' p st) def of+ (Left bundle, _) -> Left bundle+ (Right x, st') -> Right (x, st' ^. bstDefs)+ where+ st = mkInitialState file input 0 -- | Ask whether naked paragraphs are allowed in this context. @@ -141,19 +144,14 @@ -- ^ The parser to run -> Isp -- ^ Input for the parser- -> Either (ParseError Char MMarkErr) a+ -> Either (ParseError Text MMarkErr) a -- ^ Result of parsing runIParser _ _ (IspError err) = Left err-runIParser defs p (IspSpan startPos input) =- snd (runParser' (evalStateT p ist) pst)+runIParser defs p (IspSpan offset input) =+ first (NE.head . bundleErrors) (snd (runParser' (evalStateT p ist) pst)) where ist = def & istDefs .~ defs- pst = M.State- { stateInput = input- , statePos = startPos :| []- , stateTokensProcessed = 0- , stateTabWidth = mkPos 4- }+ pst = mkInitialState "" input offset -- | Disallow parsing of empty inlines. @@ -235,6 +233,25 @@ ---------------------------------------------------------------------------- -- Helpers++-- | Setup initial parser state.++mkInitialState+ :: FilePath -- ^ File name to use+ -> Text -- ^ Input+ -> Int -- ^ Starting offset+ -> M.State Text+mkInitialState file input offset = M.State+ { stateInput = input+ , stateOffset = offset+ , statePosState = PosState+ { pstateInput = input+ , pstateOffset = offset+ , pstateSourcePos = initialPos file+ , pstateTabWidth = mkPos 4+ , pstateLinePrefix = ""+ }+ } -- | Locally change state in a state monad and then restore it back.
Text/MMark/Parser/Internal/Type.hs view
@@ -48,6 +48,7 @@ import Data.Hashable (Hashable) import Data.List (intercalate) import Data.List.NonEmpty (NonEmpty (..))+import Data.Proxy import Data.Semigroup ((<>)) import Data.Text (Text) import Data.Typeable (Typeable)@@ -114,9 +115,9 @@ -- | 'Inline' source pending parsing. data Isp- = IspSpan SourcePos Text+ = IspSpan Int Text -- ^ We have an inline source pending parsing- | IspError (ParseError Char MMarkErr)+ | IspError (ParseError Text MMarkErr) -- ^ We should just return this parse error deriving (Eq, Show) @@ -201,7 +202,8 @@ YamlParseError str -> "YAML parse error: " ++ str NonFlankingDelimiterRun dels ->- showTokens dels ++ " should be in left- or right- flanking position"+ showTokens (Proxy :: Proxy Text) dels+ ++ " should be in left- or right- flanking position" ListStartIndexTooBig n -> "ordered list start numbers must be nine digits or less, " ++ show n ++ " is too big"
Text/MMark/Render.hs view
@@ -9,6 +9,7 @@ -- -- MMark rendering machinery. +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -22,7 +23,6 @@ import Data.Char (isSpace) import Data.Function (fix) import Data.List.NonEmpty (NonEmpty (..))-import Data.Semigroup import Lucid import Text.MMark.Trans import Text.MMark.Type@@ -30,6 +30,10 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Text.URI as URI++#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif -- | Render a 'MMark' markdown document. You can then render @'Html' ()@ to -- various things:
Text/MMark/Type.hs view
@@ -10,6 +10,7 @@ -- Internal type definitions. Some of these are re-exported in the public -- modules. +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-}@@ -35,12 +36,15 @@ import Data.Function (on) import Data.List.NonEmpty (NonEmpty (..)) import Data.Monoid hiding ((<>))-import Data.Semigroup import Data.Text (Text) import Data.Typeable (Typeable) import GHC.Generics import Lucid import Text.URI (URI (..))++#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif -- | Representation of complete markdown document. You can't look inside of -- 'MMark' on purpose. The only way to influence an 'MMark' document you
Text/MMark/Util.hs view
@@ -9,7 +9,6 @@ -- -- Internal utilities. -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -63,10 +62,6 @@ headerFragment fragment = URI { uriScheme = Nothing , uriAuthority = Left False-#if MIN_VERSION_modern_uri(0,2,0) , uriPath = Nothing-#else- , uriPath = []-#endif , uriQuery = [] , uriFragment = URI.mkFragment fragment }
mmark.cabal view
@@ -1,7 +1,7 @@ name: mmark-version: 0.0.5.6-cabal-version: >= 1.18-tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2+version: 0.0.6.0+cabal-version: 1.18+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 license: BSD3 license-file: LICENSE.md author: Mark Karpov <markkarpov92@gmail.com>@@ -27,7 +27,7 @@ default: False library- build-depends: aeson >= 0.11 && < 1.4+ build-depends: aeson >= 0.11 && < 1.5 , base >= 4.8 && < 5.0 , case-insensitive >= 1.2 && < 1.3 , containers >= 0.5 && < 0.6@@ -35,20 +35,20 @@ , deepseq >= 1.3 && < 1.5 , dlist >= 0.8 && < 0.9 , email-validate >= 2.2 && < 2.4- , foldl >= 1.2 && < 1.4+ , foldl >= 1.2 && < 1.5 , hashable >= 1.0.1.1 && < 1.3 , html-entity-map >= 0.1 && < 0.2 , lucid >= 2.6 && < 3.0- , megaparsec >= 6.4 && < 7.0+ , megaparsec >= 7.0 && < 8.0 , microlens >= 0.4 && < 0.5 , microlens-th >= 0.4 && < 0.5- , modern-uri >= 0.1.2.1 && < 0.3+ , modern-uri >= 0.3 && < 0.4 , mtl >= 2.0 && < 3.0- , parser-combinators >= 0.4 && < 1.0+ , parser-combinators >= 0.4 && < 2.0 , text >= 0.2 && < 1.3 , text-metrics >= 0.3 && < 0.4 , unordered-containers >= 0.2.5 && < 0.3- , yaml >= 0.8.10 && < 0.9+ , yaml >= 0.8.10 && < 0.11 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* if !impl(ghc >= 7.10)@@ -68,6 +68,12 @@ ghc-options: -O0 -Wall -Werror else ghc-options: -O2 -Wall+ if flag(dev) && impl(ghc >= 8.0)+ ghc-options: -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wnoncanonical-monad-instances+ -Wnoncanonical-monadfail-instances default-language: Haskell2010 test-suite tests@@ -75,16 +81,17 @@ hs-source-dirs: tests type: exitcode-stdio-1.0 build-depends: QuickCheck >= 2.4 && < 3.0- , aeson >= 0.11 && < 1.4+ , aeson >= 0.11 && < 1.5 , base >= 4.8 && < 5.0- , foldl >= 1.2 && < 1.4+ , foldl >= 1.2 && < 1.5 , hspec >= 2.0 && < 3.0- , hspec-megaparsec >= 1.0 && < 2.0+ , hspec-megaparsec >= 2.0 && < 3.0 , lucid >= 2.6 && < 3.0- , megaparsec >= 6.4 && < 7.0+ , megaparsec >= 7.0 && < 8.0 , mmark- , modern-uri >= 0.1.2.1 && < 0.3+ , modern-uri >= 0.3 && < 0.4 , text >= 0.2 && < 1.3+ build-tools: hspec-discover >= 2.0 && < 3.0 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* other-modules: Text.MMarkSpec@@ -101,7 +108,7 @@ hs-source-dirs: bench/speed type: exitcode-stdio-1.0 build-depends: base >= 4.8 && < 5.0- , criterion >= 0.6.2.1 && < 1.5+ , criterion >= 0.6.2.1 && < 1.6 , mmark , text >= 0.2 && < 1.3 if flag(dev)
tests/Text/MMark/ExtensionSpec.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-}@@ -107,11 +106,7 @@ frag <- URI.mkFragment fragment URI.uriScheme uri `shouldBe` Nothing URI.uriAuthority uri `shouldBe` Left False-#if MIN_VERSION_modern_uri(0,2,0) URI.uriPath uri `shouldBe` Nothing-#else- URI.uriPath uri `shouldBe` []-#endif URI.uriQuery uri `shouldBe` [] URI.uriFragment uri `shouldBe` Just frag
tests/Text/MMark/TestUtils.hs view
@@ -30,10 +30,10 @@ mkDoc :: Text -> IO MMark mkDoc input = case MMark.parse "" input of- Left errs -> do+ Left bundle -> do expectationFailure $ "while parsing a document, parse error(s) occurred:\n" ++- MMark.parseErrorsPretty input errs+ errorBundlePretty bundle undefined Right x -> return x @@ -53,20 +53,29 @@ (~~->) :: Text -- ^ Input for parser- -> [ParseError Char MMarkErr]+ -> [ParseError Text 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'+ Left bundle' -> unless (bundle == bundle') . expectationFailure $+ "\nthe parser is expected to fail with:\n\n" +++ errorBundlePretty bundle +++ "\nbut it failed with:\n\n" +++ errorBundlePretty bundle' Right x -> expectationFailure $ "the parser is expected to fail, but it parsed: " ++ show (toText x) where- errs = NE.fromList errs''+ bundle = ParseErrorBundle+ { bundleErrors = NE.fromList errs''+ , bundlePosState = PosState+ { pstateInput = input+ , pstateOffset = 0+ , pstateSourcePos = initialPos ""+ , pstateTabWidth = mkPos 4+ , pstateLinePrefix = ""+ }+ } -- | The same as @('~~->')@, but expects only one parse error. @@ -75,7 +84,7 @@ (~->) :: Text -- ^ Input for parser- -> ParseError Char MMarkErr+ -> ParseError Text MMarkErr -- ^ Expected parse error to compare with -> Expectation input ~-> err = input ~~-> [err]@@ -91,9 +100,9 @@ -> Expectation input =-> expected = case MMark.parse "" input of- Left errs -> expectationFailure $+ Left bundle -> expectationFailure $ "the parser is expected to succeed, but it failed with:\n" ++- MMark.parseErrorsPretty input errs+ errorBundlePretty bundle Right factual -> toText factual `shouldBe` expected -- | Just like @('=->')@, but also appends newline to given input and tries
tests/Text/MMarkSpec.hs view
@@ -13,7 +13,7 @@ import Text.MMark (MMarkErr (..)) import Text.MMark.Extension (Inline (..)) import Text.MMark.TestUtils-import Text.Megaparsec (ErrorFancy (..))+import Text.Megaparsec (ErrorFancy (..), Stream) import qualified Control.Foldl as L import qualified Data.List.NonEmpty as NE import qualified Data.Text as T@@ -66,8 +66,8 @@ it "CM12" $ let s = "- `one\n- two`" in s ~~->- [ err (posN 6 s) (ueib <> etok '`' <> ecsc)- , err (posN 13 s) (ueib <> etok '`' <> ecsc) ]+ [ err 6 (ueib <> etok '`' <> ecsc)+ , err 13 (ueib <> etok '`' <> ecsc) ] context "4.1 Thematic breaks" $ do it "CM13" $ "***\n---\n___" ==-> "<hr>\n<hr>\n<hr>\n"@@ -77,14 +77,14 @@ "===" ==-> "<p>===</p>\n" it "CM16" $ let s = "--\n**\n__\n"- in s ~-> errFancy (posN 3 s) (nonFlanking "**")+ in s ~-> errFancy 3 (nonFlanking "**") it "CM17" $ " ***\n ***\n ***" ==-> "<hr>\n<hr>\n<hr>\n" it "CM18" $ " ***" ==-> "<pre><code>***\n</code></pre>\n" it "CM19" $ let s = "Foo\n ***\n"- in s ~-> errFancy (posN 8 s) (nonFlanking "***")+ in s ~-> errFancy 8 (nonFlanking "***") it "CM20" $ "_____________________________________" ==-> "<hr>\n"@@ -98,7 +98,7 @@ "- - - - " ==-> "<hr>\n" it "CM25" $ let s = "_ _ _ _ a\n\na------\n\n---a---\n"- in s ~-> errFancy posI (nonFlanking "_")+ in s ~-> errFancy 0 (nonFlanking "_") it "CM26" $ " *-*" ==-> "<p><em>-</em></p>\n" it "CM27" $@@ -122,12 +122,12 @@ "<h1 id=\"foo\">foo</h1>\n<h2 id=\"foo\">foo</h2>\n<h3 id=\"foo\">foo</h3>\n<h4 id=\"foo\">foo</h4>\n<h5 id=\"foo\">foo</h5>\n<h6 id=\"foo\">foo</h6>\n" it "CM33" $ let s = "####### foo"- in s ~-> err (posN 6 s) (utok '#' <> ews)+ in s ~-> err 6 (utok '#' <> ews) it "CM34" $ let s = "#5 bolt\n\n#hashtag" in s ~~->- [ err (posN 1 s) (utok '5' <> etok '#' <> ews)- , err (posN 10 s) (utok 'h' <> etok '#' <> ews) ]+ [ err 1 (utok '5' <> etok '#' <> ews)+ , err 10 (utok 'h' <> etok '#' <> ews) ] it "CM35" $ "\\## foo" ==-> "<p>## foo</p>\n" it "CM36" $@@ -166,8 +166,8 @@ it "CM49" $ let s = "## \n#\n### ###" in s ~~->- [ err (posN 3 s) (utok '\n' <> elabel "heading character" <> ews)- , err (posN 5 s) (utok '\n' <> etok '#' <> ews) ]+ [ err 3 (utok '\n' <> elabel "heading character" <> ews)+ , err 5 (utok '\n' <> etok '#' <> ews) ] context "4.3 Setext headings" $ do -- NOTE we do not support them, the tests have been adjusted -- accordingly.@@ -204,8 +204,8 @@ it "CM60" $ let s = "`Foo\n----\n`\n\n<a title=\"a lot\n---\nof dashes\"/>\n" in s ~~->- [ err (posN 4 s) (ueib <> etok '`' <> ecsc)- , err (posN 11 s) (ueib <> etok '`' <> ecsc) ]+ [ err 4 (ueib <> etok '`' <> ecsc)+ , err 11 (ueib <> etok '`' <> ecsc) ] it "CM61" $ "> Foo\n---" ==-> "<blockquote>\n<p>Foo</p>\n</blockquote>\n<hr>\n"@@ -312,15 +312,14 @@ "<pre><code>aaa\n~~~\n</code></pre>\n" it "CM95" $ let s = "```"- in s ~-> err (posN 3 s)- (ueib <> etok '`' <> ecsc)+ in s ~-> err 3 (ueib <> etok '`' <> ecsc) it "CM96" $ let s = "`````\n\n```\naaa\n"- in s ~-> err (posN 15 s)+ in s ~-> err 15 (ueof <> elabel "closing code fence" <> elabel "code block content") it "CM97" $ let s = "> ```\n> aaa\n\nbbb\n"- in s ~-> err (posN 17 s) (ueof <> elabel "closing code fence" <> elabel "code block content")+ in s ~-> err 17 (ueof <> elabel "closing code fence" <> elabel "code block content") it "CM98" $ "```\n\n \n```" ==-> "<pre><code>\n \n</code></pre>\n"@@ -347,14 +346,14 @@ "<pre><code>aaa\n</code></pre>\n" it "CM106" $ let s = "```\naaa\n ```\n"- in s ~-> err (posN 16 s)+ in s ~-> err 16 (ueof <> elabel "closing code fence" <> elabel "code block content") it "CM107" $ "``` ```\naaa" ==-> "<p><code></code>\naaa</p>\n" it "CM108" $ let s = "~~~~~~\naaa\n~~~ ~~\n"- in s ~-> err (posN 18 s)+ in s ~-> err 18 (ueof <> elabel "closing code fence" <> elabel "code block content") it "CM109" $ "foo\n```\nbar\n```\nbaz" ==->@@ -390,9 +389,9 @@ it "CM161" $ let s = "[Foo bar\\]]:my_(url) 'title (with parens)'\n\n[Foo bar\\]]" in s ~~->- [ err (posN 19 s) (utoks ") " <> etok '#' <> etok '/' <> etok '?'- <> elabel "newline" <> elabel "the rest of path piece" <> ews )- , errFancy (posN 45 s) (couldNotMatchRef "Foo bar]" []) ]+ [ err 19 (utoks ") " <> euric <> elabel "newline" <> ews)+ , errFancy 45 (couldNotMatchRef "Foo bar]" [])+ ] it "CM162" $ "[Foo bar]:\n<my%20url>\n'title'\n\n[Foo bar]" ==-> "<p><a href=\"my%20url\" title=\"title\">Foo bar</a></p>\n"@@ -408,18 +407,17 @@ it "CM166" $ let s = "[foo]:\n\n[foo]" in s ~~->- [ err (posN 7 s) (utok '\n' <> etok '<' <> elabel "URI" <> ews)- , errFancy (posN 9 s) (couldNotMatchRef "foo" []) ]+ [ err 7 (utok '\n' <> etok '<' <> elabel "URI" <> ews)+ , errFancy 9 (couldNotMatchRef "foo" []) ] it "CM167" $ let s = "[foo]: /url\\bar\\*baz \"foo\\\"bar\\baz\"\n\n[foo]\n"- in s ~-> err (posN 11 s) (utok '\\' <> etok '#' <> etok '/'- <> etok '?' <> euri <> elabel "the rest of path piece")+ in s ~-> err 11 (utok '\\' <> euric <> euri) it "CM168" $ "[foo]\n\n[foo]: url" ==-> "<p><a href=\"url\">foo</a></p>\n" it "CM169" $ let s = "[foo]\n\n[foo]: first\n[foo]: second\n"- in s ~-> errFancy (posN 21 s) (duplicateRef "foo")+ in s ~-> errFancy 21 (duplicateRef "foo") it "CM170" $ "[FOO]: /url\n\n[Foo]" ==-> "<p><a href=\"/url\">Foo</a></p>\n"@@ -434,10 +432,10 @@ "<p>bar</p>\n" it "CM174" $ let s = "[foo]: /url \"title\" ok"- in s ~-> err (posN 20 s) (utoks "ok" <> elabel "newline" <> ews)+ in s ~-> err 20 (utoks "ok" <> elabel "newline" <> ews) it "CM175" $ let s = "[foo]: /url\n\"title\" ok\n"- in s ~-> err (posN 20 s) (utoks "ok" <> elabel "newline" <> ews)+ in s ~-> err 20 (utoks "ok" <> elabel "newline" <> ews) it "CM176" $ " [foo]: /url \"title\"" ==-> "<pre><code>[foo]: /url "title"\n</code></pre>\n"@@ -447,8 +445,8 @@ it "CM178" $ let s = "Foo\n[bar]: /baz\n\n[bar]\n" in s ~~->- [ errFancy (posN 5 s) (couldNotMatchRef "bar" [])- , errFancy (posN 18 s) (couldNotMatchRef "bar" []) ]+ [ errFancy 5 (couldNotMatchRef "bar" [])+ , errFancy 18 (couldNotMatchRef "bar" []) ] it "CM179" $ "# [Foo]\n[foo]: /url\n> bar" ==-> "<h1 id=\"foo\"><a href=\"/url\">Foo</a></h1>\n<blockquote>\n<p>bar</p>\n</blockquote>\n"@@ -604,7 +602,7 @@ "<ol start=\"123456789\">\n<li>\nok\n</li>\n</ol>\n" it "CM229" $ let s = "1234567890. not ok\n"- in s ~-> errFancy posI (indexTooBig 1234567890)+ in s ~-> errFancy 0 (indexTooBig 1234567890) it "CM230" $ "0. ok" ==-> "<ol start=\"0\">\n<li>\nok\n</li>\n</ol>\n"@@ -786,7 +784,7 @@ context "6 Inlines" $ it "CM288" $ let s = "`hi`lo`\n"- in s ~-> err (posN 7 s) (ueib <> etok '`' <> ecsc)+ in s ~-> err 7 (ueib <> etok '`' <> ecsc) context "6.1 Blackslash escapes" $ do it "CM289" $ "\\!\\\"\\#\\$\\%\\&\\'\\(\\)\\*\\+\\,\\-\\.\\/\\:\\;\\<\\=\\>\\?\\@\\[\\\\\\]\\^\\_\\`\\{\\|\\}\\~\n"@@ -799,7 +797,7 @@ "<p>*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"</p>\n" it "CM292" $ let s = "\\\\*emphasis*"- in s ~-> errFancy (posN 2 s) (nonFlanking "*")+ in s ~-> errFancy 2 (nonFlanking "*") it "CM293" $ "foo\\\nbar" ==-> "<p>foo<br>\nbar</p>\n"@@ -820,14 +818,13 @@ "<p><a href="/bar/)"></p>\n" it "CM299" $ let s = "[foo](/bar\\* \"ti\\*tle\")"- in s ~-> err (posN 10 s)- (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi)+ in s ~-> err 10 (utok '\\' <> euric <> euri) it "CM300" $ let s = "[foo]\n\n[foo]: /bar\\* \"ti\\*tle\"" in s ~~->- [ errFancy (posN 1 s) (couldNotMatchRef "foo" [])- , err (posN 18 s)- (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi) ]+ [ errFancy 1 (couldNotMatchRef "foo" [])+ , err 18 (utok '\\' <> euric <> euri)+ ] it "CM301" $ "``` foo\\+bar\nfoo\n```" ==-> "<pre><code class=\"language-foo+bar\">foo\n</code></pre>\n"@@ -839,9 +836,9 @@ "# Ӓ Ϡ" ==-> "<p># Ӓ Ϡ</p>\n" it "CM303b" $- "�" ~-> errFancy posI (invalidNumChar 98765432)+ "�" ~-> errFancy 0 (invalidNumChar 98765432) it "CM303c" $- "�" ~-> errFancy posI (invalidNumChar 0)+ "�" ~-> errFancy 0 (invalidNumChar 0) it "CM304" $ "" ആ ಫ" ==-> "<p>" ആ ಫ</p>\n"@@ -849,16 +846,16 @@ " " ==-> "<p>&nbsp</p>\n" it "CM305b" $ let s = "&x;"- in s ~-> errFancy posI (unknownEntity "x")+ in s ~-> errFancy 0 (unknownEntity "x") it "CM305c" $ let s = "&#;"- in s ~-> err (posN 2 s) (utok ';' <> etok 'x' <> etok 'X' <> elabel "integer")+ in s ~-> err 2 (utok ';' <> etok 'x' <> etok 'X' <> elabel "integer") it "CM305d" $ let s = "&#x;"- in s ~-> err (posN 3 s) (utok ';' <> elabel "hexadecimal integer")+ in s ~-> err 3 (utok ';' <> elabel "hexadecimal integer") it "CM305e" $ let s = "&ThisIsNotDefined;"- in s ~-> errFancy posI (unknownEntity "ThisIsNotDefined")+ in s ~-> errFancy 0 (unknownEntity "ThisIsNotDefined") it "CM305f" $ "&hi?;" ==-> "<p>&hi?;</p>\n" it "CM306" $@@ -866,7 +863,7 @@ "<p>&copy</p>\n" it "CM307" $ let s = "&MadeUpEntity;"- in s ~-> errFancy posI (unknownEntity "MadeUpEntity")+ in s ~-> errFancy 0 (unknownEntity "MadeUpEntity") it "CM308" $ "<a href=\"öö.html\">" ==-> "<p><a href="\246\246.html"></p>\n"@@ -903,144 +900,144 @@ "`foo `` bar`" ==-> "<p><code>foo `` bar</code></p>\n" it "CM321" $ let s = "`foo\\`bar`\n"- in s ~-> err (posN 10 s) (ueib <> etok '`' <> ecsc)+ in s ~-> err 10 (ueib <> etok '`' <> ecsc) it "CM322" $ let s = "*foo`*`\n"- in s ~-> err (posN 7 s) (ueib <> etok '*' <> eic)+ in s ~-> err 7 (ueib <> etok '*' <> eic) it "CM323" $ let s = "[not a `link](/foo`)\n"- in s ~-> err (posN 20 s) (ueib <> etok ']' <> eic)+ in s ~-> err 20 (ueib <> etok ']' <> eic) it "CM324" $ let s = "`<a href=\"`\">`\n"- in s ~-> err (posN 14 s) (ueib <> etok '`' <> ecsc)+ in s ~-> err 14 (ueib <> etok '`' <> ecsc) it "CM325" $ "<a href=\"`\">`" ==-> "<p><a href="<code>"></code></p>\n" it "CM326" $ let s = "`<http://foo.bar.`baz>`\n"- in s ~-> err (posN 23 s) (ueib <> etok '`' <> ecsc)+ in s ~-> err 23 (ueib <> etok '`' <> ecsc) it "CM327" $ "<http://foo.bar.`baz>`" ==-> "<p><http://foo.bar.<code>baz></code></p>\n" it "CM328" $ let s = "```foo``\n"- in s ~-> err (posN 8 s) (ueib <> etok '`' <> ecsc)+ in s ~-> err 8 (ueib <> etok '`' <> ecsc) it "CM329" $ let s = "`foo\n"- in s ~-> err (posN 4 s) (ueib <> etok '`' <> ecsc)+ in s ~-> err 4 (ueib <> etok '`' <> ecsc) it "CM330" $ let s = "`foo``bar``\n"- in s ~-> err (posN 11 s) (ueib <> etok '`' <> ecsc)+ in s ~-> err 11 (ueib <> etok '`' <> ecsc) context "6.4 Emphasis and strong emphasis" $ do it "CM331" $ "*foo bar*" ==-> "<p><em>foo bar</em></p>\n" it "CM332" $ let s = "a * foo bar*\n"- in s ~-> errFancy (posN 2 s) (nonFlanking "*")+ in s ~-> errFancy 2 (nonFlanking "*") it "CM333" $ let s = "a*\"foo\"*\n"- in s ~-> errFancy (posN 1 s) (nonFlanking "*")+ in s ~-> errFancy 1 (nonFlanking "*") it "CM334" $ let s = "* a *\n"- in s ~-> errFancy posI (nonFlanking "*")+ in s ~-> errFancy 0 (nonFlanking "*") it "CM335" $ let s = "foo*bar*\n"- in s ~-> errFancy (posN 3 s) (nonFlanking "*")+ in s ~-> errFancy 3 (nonFlanking "*") it "CM336" $ let s = "5*6*78\n"- in s ~-> errFancy (posN 1 s) (nonFlanking "*")+ in s ~-> errFancy 1 (nonFlanking "*") it "CM337" $ "_foo bar_" ==-> "<p><em>foo bar</em></p>\n" it "CM338" $ let s = "_ foo bar_\n"- in s ~-> errFancy posI (nonFlanking "_")+ in s ~-> errFancy 0 (nonFlanking "_") it "CM339" $ let s = "a_\"foo\"_\n"- in s ~-> errFancy (posN 1 s) (nonFlanking "_")+ in s ~-> errFancy 1 (nonFlanking "_") it "CM340" $ let s = "foo_bar_\n"- in s ~-> errFancy (posN 3 s) (nonFlanking "_")+ in s ~-> errFancy 3 (nonFlanking "_") it "CM341" $ let s = "5_6_78\n"- in s ~-> errFancy (posN 1 s) (nonFlanking "_")+ in s ~-> errFancy 1 (nonFlanking "_") it "CM342" $ let s = "пристаням_стремятся_\n"- in s ~-> errFancy (posN 9 s) (nonFlanking "_")+ in s ~-> errFancy 9 (nonFlanking "_") it "CM343" $ let s = "aa_\"bb\"_cc\n"- in s ~-> errFancy (posN 2 s) (nonFlanking "_")+ in s ~-> errFancy 2 (nonFlanking "_") it "CM344" $ let s = "foo-_(bar)_\n"- in s ~-> errFancy (posN 4 s) (nonFlanking "_")+ in s ~-> errFancy 4 (nonFlanking "_") it "CM345" $ let s = "_foo*\n"- in s ~-> err (posN 4 s) (utok '*' <> etok '_' <> eic)+ in s ~-> err 4 (utok '*' <> etok '_' <> eic) it "CM346" $ let s = "*foo bar *\n"- in s ~-> errFancy (posN 9 s) (nonFlanking "*")+ in s ~-> errFancy 9 (nonFlanking "*") it "CM347" $ let s = "*foo bar\n*\n"- in s ~-> err (posN 8 s) (ueib <> etok '*' <> eic)+ in s ~-> err 8 (ueib <> etok '*' <> eic) it "CM348" $ let s = "*(*foo)\n"- in s ~-> err (posN 7 s) (ueib <> etok '*' <> eic)+ in s ~-> err 7 (ueib <> etok '*' <> eic) it "CM349" $ "*(*foo*)*" ==-> "<p><em>(<em>foo</em>)</em></p>\n" it "CM350" $ let s = "*foo*bar\n"- in s ~-> errFancy (posN 4 s) (nonFlanking "*")+ in s ~-> errFancy 4 (nonFlanking "*") it "CM351" $ let s = "_foo bar _\n"- in s ~-> errFancy (posN 9 s) (nonFlanking "_")+ in s ~-> errFancy 9 (nonFlanking "_") it "CM352" $ let s = "_(_foo)"- in s ~-> err (posN 7 s) (ueib <> etok '_' <> eic)+ in s ~-> err 7 (ueib <> etok '_' <> eic) it "CM353" $ "_(_foo_)_" ==-> "<p><em>(<em>foo</em>)</em></p>\n" it "CM354" $ let s = "_foo_bar\n"- in s ~-> errFancy (posN 4 s) (nonFlanking "_")+ in s ~-> errFancy 4 (nonFlanking "_") it "CM355" $ let s = "_пристаням_стремятся\n"- in s ~-> errFancy (posN 10 s) (nonFlanking "_")+ in s ~-> errFancy 10 (nonFlanking "_") it "CM356" $ let s = "_foo_bar_baz_\n"- in s ~-> errFancy (posN 4 s) (nonFlanking "_")+ in s ~-> errFancy 4 (nonFlanking "_") it "CM357" $ "_(bar\\)_.\n" ==-> "<p><em>(bar)</em>.</p>\n" it "CM358" $ "**foo bar**\n" ==-> "<p><strong>foo bar</strong></p>\n" it "CM359" $ let s = "** foo bar**\n"- in s ~-> errFancy posI (nonFlanking "**")+ in s ~-> errFancy 0 (nonFlanking "**") it "CM360" $ let s = "a**\"foo\"**\n"- in s ~-> errFancy (posN 1 s) (nonFlanking "**")+ in s ~-> errFancy 1 (nonFlanking "**") it "CM361" $ let s = "foo**bar**\n"- in s ~-> errFancy (posN 3 s) (nonFlanking "**")+ in s ~-> errFancy 3 (nonFlanking "**") it "CM362" $ "__foo bar__" ==-> "<p><strong>foo bar</strong></p>\n" it "CM363" $ let s = "__ foo bar__\n"- in s ~-> errFancy posI (nonFlanking "__")+ in s ~-> errFancy 0 (nonFlanking "__") it "CM364" $ let s = "__\nfoo bar__\n"- in s ~-> errFancy posI (nonFlanking "__")+ in s ~-> errFancy 0 (nonFlanking "__") it "CM365" $ let s = "a__\"foo\"__\n"- in s ~-> errFancy (posN 1 s) (nonFlanking "__")+ in s ~-> errFancy 1 (nonFlanking "__") it "CM366" $ let s = "foo__bar__\n"- in s ~-> errFancy (posN 3 s) (nonFlanking "__")+ in s ~-> errFancy 3 (nonFlanking "__") it "CM367" $ let s = "5__6__78\n"- in s ~-> errFancy (posN 1 s) (nonFlanking "__")+ in s ~-> errFancy 1 (nonFlanking "__") it "CM368" $ let s = "пристаням__стремятся__\n"- in s ~-> errFancy (posN 9 s) (nonFlanking "__")+ in s ~-> errFancy 9 (nonFlanking "__") it "CM369" $ "__foo, __bar__, baz__" ==-> "<p><strong>foo, <strong>bar</strong>, baz</strong></p>\n"@@ -1048,10 +1045,10 @@ "foo-__\\(bar)__" ==-> "<p>foo-<strong>(bar)</strong></p>\n" it "CM371" $ let s = "**foo bar **\n"- in s ~-> errFancy (posN 10 s) (nonFlanking "**")+ in s ~-> errFancy 10 (nonFlanking "**") it "CM372" $ let s = "**(**foo)\n"- in s ~-> err (posN 9 s) (ueib <> etoks "**" <> eic)+ in s ~-> err 9 (ueib <> etoks "**" <> eic) it "CM373" $ "*(**foo**)*" ==-> "<p><em>(<strong>foo</strong>)</em></p>\n"@@ -1063,22 +1060,22 @@ "<p><strong>foo "<em>bar</em>" foo</strong></p>\n" it "CM376" $ let s = "**foo**bar\n"- in s ~-> errFancy (posN 5 s) (nonFlanking "**")+ in s ~-> errFancy 5 (nonFlanking "**") it "CM377" $ let s = "__foo bar __\n"- in s ~-> errFancy (posN 10 s) (nonFlanking "__")+ in s ~-> errFancy 10 (nonFlanking "__") it "CM378" $ let s = "__(__foo)\n"- in s ~-> err (posN 9 s) (ueib <> etoks "__" <> eic)+ in s ~-> err 9 (ueib <> etoks "__" <> eic) it "CM379" $ "_(__foo__)_" ==-> "<p><em>(<strong>foo</strong>)</em></p>\n" it "CM380" $ let s = "__foo__bar\n"- in s ~-> errFancy (posN 5 s) (nonFlanking "__")+ in s ~-> errFancy 5 (nonFlanking "__") it "CM381" $ let s = "__пристаням__стремятся\n"- in s ~-> errFancy (posN 11 s) (nonFlanking "__")+ in s ~-> errFancy 11 (nonFlanking "__") it "CM382" $ "__foo\\_\\_bar\\_\\_baz__" ==-> "<p><strong>foo__bar__baz</strong></p>\n"@@ -1099,7 +1096,7 @@ "<p><em>foo <em>bar</em> baz</em></p>\n" it "CM388" $ let s = "__foo_ bar_"- in s ~-> err (posN 5 s) (utoks "_ " <> etoks "__" <> eic)+ in s ~-> err 5 (utoks "_ " <> etoks "__" <> eic) it "CM389" $ "*foo *bar**" ==-> "<p><em>foo <em>bar</em></em></p>\n"@@ -1108,14 +1105,14 @@ "<p><em>foo <strong>bar</strong> baz</em></p>\n" it "CM391" $ let s = "*foo**bar**baz*\n"- in s ~-> errFancy (posN 5 s) (nonFlanking "*")+ in s ~-> errFancy 5 (nonFlanking "*") it "CM392" $ "***foo** bar*\n" ==-> "<p><em><strong>foo</strong> bar</em></p>\n" it "CM393" $ "*foo **bar***\n" ==-> "<p><em>foo <strong>bar</strong></em></p>\n" it "CM394" $ let s = "*foo**bar***\n"- in s ~-> errFancy (posN 5 s) (nonFlanking "*")+ in s ~-> errFancy 5 (nonFlanking "*") it "CM395" $ "*foo **bar *baz* bim** bop*\n" ==-> "<p><em>foo <strong>bar <em>baz</em> bim</strong> bop</em></p>\n"@@ -1124,10 +1121,10 @@ "<p><em>foo <a href=\"/url\"><em>bar</em></a></em></p>\n" it "CM397" $ let s = "** is not an empty emphasis\n"- in s ~-> errFancy posI (nonFlanking "**")+ in s ~-> errFancy 0 (nonFlanking "**") it "CM398" $ let s = "**** is not an empty strong emphasis\n"- in s ~-> errFancy posI (nonFlanking "****")+ in s ~-> errFancy 0 (nonFlanking "****") it "CM399" $ "**foo [bar](/url)**" ==-> "<p><strong>foo <a href=\"/url\">bar</a></strong></p>\n"@@ -1151,7 +1148,7 @@ "<p><strong>foo <em>bar</em> baz</strong></p>\n" it "CM406" $ let s = "**foo*bar*baz**\n"- in s ~-> err (posN 5 s) (utoks "*b" <> etoks "**" <> eic)+ in s ~-> err 5 (utoks "*b" <> etoks "**" <> eic) it "CM407" $ "***foo* bar**" ==-> "<p><strong><em>foo</em> bar</strong></p>\n"@@ -1166,74 +1163,74 @@ "<p><strong>foo <a href=\"/url\"><em>bar</em></a></strong></p>\n" it "CM411" $ let s = "__ is not an empty emphasis\n"- in s ~-> errFancy posI (nonFlanking "__")+ in s ~-> errFancy 0 (nonFlanking "__") it "CM412" $ let s = "____ is not an empty strong emphasis\n"- in s ~-> errFancy posI (nonFlanking "____")+ in s ~-> errFancy 0 (nonFlanking "____") it "CM413" $ let s = "foo ***\n"- in s ~-> errFancy (posN 4 s) (nonFlanking "***")+ in s ~-> errFancy 4 (nonFlanking "***") it "CM414" $ "foo *\\**" ==-> "<p>foo <em>*</em></p>\n" it "CM415" $ "foo *\\_*\n" ==-> "<p>foo <em>_</em></p>\n" it "CM416" $ let s = "foo *****\n"- in s ~-> errFancy (posN 8 s) (nonFlanking "*")+ in s ~-> errFancy 8 (nonFlanking "*") it "CM417" $ "foo **\\***" ==-> "<p>foo <strong>*</strong></p>\n" it "CM418" $ "foo **\\_**\n" ==-> "<p>foo <strong>_</strong></p>\n" it "CM419" $ let s = "**foo*\n"- in s ~-> err (posN 5 s) (utok '*' <> etoks "**" <> eic)+ in s ~-> err 5 (utok '*' <> etoks "**" <> eic) it "CM420" $ let s = "*foo**\n"- in s ~-> errFancy (posN 5 s) (nonFlanking "*")+ in s ~-> errFancy 5 (nonFlanking "*") it "CM421" $ let s = "***foo**\n"- in s ~-> err (posN 8 s) (ueib <> etok '*' <> eic)+ in s ~-> err 8 (ueib <> etok '*' <> eic) it "CM422" $ let s = "****foo*\n"- in s ~-> err (posN 7 s) (utok '*' <> etoks "**" <> eic)+ in s ~-> err 7 (utok '*' <> etoks "**" <> eic) it "CM423" $ let s = "**foo***\n"- in s ~-> errFancy (posN 7 s) (nonFlanking "*")+ in s ~-> errFancy 7 (nonFlanking "*") it "CM424" $ let s = "*foo****\n"- in s ~-> errFancy (posN 5 s) (nonFlanking "***")+ in s ~-> errFancy 5 (nonFlanking "***") it "CM425" $ let s = "foo ___\n"- in s ~-> errFancy (posN 4 s) (nonFlanking "___")+ in s ~-> errFancy 4 (nonFlanking "___") it "CM426" $ "foo _\\__" ==-> "<p>foo <em>_</em></p>\n" it "CM427" $ "foo _\\*_" ==-> "<p>foo <em>*</em></p>\n" it "CM428" $ let s = "foo _____\n"- in s ~-> errFancy (posN 8 s) (nonFlanking "_")+ in s ~-> errFancy 8 (nonFlanking "_") it "CM429" $ "foo __\\___" ==-> "<p>foo <strong>_</strong></p>\n" it "CM430" $ "foo __\\*__" ==-> "<p>foo <strong>*</strong></p>\n" it "CM431" $ let s = "__foo_\n"- in s ~-> err (posN 5 s) (utok '_' <> etoks "__" <> eic)+ in s ~-> err 5 (utok '_' <> etoks "__" <> eic) it "CM432" $ let s = "_foo__\n"- in s ~-> errFancy (posN 5 s) (nonFlanking "_")+ in s ~-> errFancy 5 (nonFlanking "_") it "CM433" $ let s = "___foo__\n"- in s ~-> err (posN 8 s) (ueib <> etok '_' <> eic)+ in s ~-> err 8 (ueib <> etok '_' <> eic) it "CM434" $ let s = "____foo_\n"- in s ~-> err (posN 7 s) (utok '_' <> etoks "__" <> eic)+ in s ~-> err 7 (utok '_' <> etoks "__" <> eic) it "CM435" $ let s = "__foo___\n"- in s ~-> errFancy (posN 7 s) (nonFlanking "_")+ in s ~-> errFancy 7 (nonFlanking "_") it "CM436" $ let s = "_foo____\n"- in s ~-> errFancy (posN 5 s) (nonFlanking "___")+ in s ~-> errFancy 5 (nonFlanking "___") it "CM437" $ "**foo**" ==-> "<p><strong>foo</strong></p>\n" it "CM438" $@@ -1256,41 +1253,41 @@ "<p><strong><strong><em>foo</em></strong></strong></p>\n" it "CM446" $ let s = "*foo _bar* baz_\n"- in s ~-> err (posN 9 s) (utok '*' <> etok '_' <> eic)+ in s ~-> err 9 (utok '*' <> etok '_' <> eic) it "CM447" $ let s = "*foo __bar *baz bim__ bam*\n"- in s ~-> err (posN 19 s) (utok '_' <> etok '*' <> eic)+ in s ~-> err 19 (utok '_' <> etok '*' <> eic) it "CM448" $ let s = "**foo **bar baz**\n"- in s ~-> err (posN 17 s) (ueib <> etoks "**" <> eic)+ in s ~-> err 17 (ueib <> etoks "**" <> eic) it "CM449" $ let s = "*foo *bar baz*\n"- in s ~-> err (posN 14 s) (ueib <> etok '*' <> eic)+ in s ~-> err 14 (ueib <> etok '*' <> eic) it "CM450" $ let s = "*[bar*](/url)\n"- in s ~-> err (posN 5 s) (utok '*' <> etok ']' <> eic)+ in s ~-> err 5 (utok '*' <> etok ']' <> eic) it "CM451" $ let s = "_foo [bar_](/url)\n"- in s ~-> err (posN 9 s) (utok '_' <> etok ']' <> eic)+ in s ~-> err 9 (utok '_' <> etok ']' <> eic) it "CM452" $ let s = "*<img src=\"foo\" title=\"*\"/>\n"- in s ~-> errFancy (posN 23 s) (nonFlanking "*")+ in s ~-> errFancy 23 (nonFlanking "*") it "CM453" $ let s = "**<a href=\"**\">"- in s ~-> errFancy (posN 11 s) (nonFlanking "**")+ in s ~-> errFancy 11 (nonFlanking "**") it "CM454" $ let s = "__<a href=\"__\">\n"- in s ~-> errFancy (posN 11 s) (nonFlanking "__")+ in s ~-> errFancy 11 (nonFlanking "__") it "CM455" $ "*a `*`*" ==-> "<p><em>a <code>*</code></em></p>\n" it "CM456" $ "_a `_`_" ==-> "<p><em>a <code>_</code></em></p>\n" it "CM457" $ let s = "**a<http://foo.bar/?q=**>"- in s ~-> err (posN 25 s) (ueib <> etoks "**" <> eic)+ in s ~-> err 25 (ueib <> etoks "**" <> eic) it "CM458" $ let s = "__a<http://foo.bar/?q=__>"- in s ~-> err (posN 26 s) (ueib <> etoks "__" <> eic)+ in s ~-> err 25 (ueib <> etoks "__" <> eic) context "6.5 Links" $ do it "CM459" $ "[link](/uri \"title\")" ==->@@ -1300,30 +1297,28 @@ "<p><a href=\"/uri\">link</a></p>\n" it "CM461" $ let s = "[link]()"- in s ~-> err (posN 7 s)+ in s ~-> err 7 (utok ')' <> etok '<' <> elabel "URI" <> ews) it "CM462" $ "[link](<>)" ==-> "<p><a href>link</a></p>\n" it "CM463" $ let s = "[link](/my uri)\n"- in s ~-> err (posN 11 s)+ in s ~-> err 11 (utok 'u' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) it "CM464" $ let s = "[link](</my uri>)\n"- in s ~-> err (posN 11 s)- (utok ' ' <> etok '#' <> etok '/' <> etok '>' <> etok '?' <> eppi)+ in s ~-> err 11 (utok ' ' <> euric <> etok '>') it "CM465" $ let s = "[link](foo\nbar)\n"- in s ~-> err (posN 11 s)+ in s ~-> err 11 (utok 'b' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) it "CM466" $ let s = "[link](<foo\nbar>)\n"- in s ~-> err (posN 11 s)- (utok '\n' <> etok '#' <> etok '/' <> etok '>' <> etok '?' <> eppi)+ in s ~-> err 11 (utok '\n' <> euric <> etok '>') it "CM467" $ let s = "[link](\\(foo\\))"- in s ~-> err (posN 7 s)+ in s ~-> err 7 (utok '\\' <> etoks "//" <> etok '#' <> etok '/' <> etok '<' <> etok '?' <> elabel "ASCII alpha character" <> euri <> elabel "path piece" <> ews)@@ -1332,25 +1327,25 @@ "<p><a href=\"foo(and(bar\">link</a>))</p>\n" it "CM469" $ let s = "[link](foo\\(and\\(bar\\))"- in s ~-> err (posN 10 s) (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi)+ in s ~-> err 10 (utok '\\' <> euric <> euri) it "CM470" $ "[link](<foo(and(bar)>)" ==-> "<p><a href=\"foo(and(bar)\">link</a></p>\n" it "CM471" $ let s = "[link](foo\\)\\:)"- in s ~-> err (posN 10 s) (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi)+ in s ~-> err 10 (utok '\\' <> euric <> euri) it "CM472" $ "[link](#fragment)\n\n[link](http://example.com#fragment)\n\n[link](http://example.com?foo=3#frag)\n" ==-> "<p><a href=\"#fragment\">link</a></p>\n<p><a href=\"http://example.com/#fragment\">link</a></p>\n<p><a href=\"http://example.com/?foo=3#frag\">link</a></p>\n" it "CM473" $ let s = "[link](foo\\bar)"- in s ~-> err (posN 10 s) (utok '\\' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi)+ in s ~-> err 10 (utok '\\' <> euric <> euri) it "CM474" $ "[link](foo%20bä)" ==-> "<p><a href=\"foo%20b&auml;\">link</a></p>\n" it "CM475" $ let s = "[link](\"title\")"- in s ~-> err (posN 7 s)+ in s ~-> err 7 (utok '"' <> etoks "//" <> etok '#' <> etok '/' <> etok '<' <> etok '?' <> elabel "ASCII alpha character" <> euri <> elabel "path piece" <> ews)@@ -1362,11 +1357,10 @@ "<p><a href=\"/url\" title=\"title ""\">link</a></p>\n" it "CM478" $ let s = "[link](/url \"title\")"- in s ~-> err (posN 11 s)- (utok ' ' <> etok '#' <> etok '/' <> etok '?' <> euri <> eppi)+ in s ~-> err 11 (utok ' ' <> euric <> euri) it "CM479" $ let s = "[link](/url \"title \"and\" title\")\n"- in s ~-> err (posN 20 s) (utok 'a' <> etok ')' <> ews)+ in s ~-> err 20 (utok 'a' <> etok ')' <> ews) it "CM480" $ "[link](/url 'title \"and\" title')" ==-> "<p><a href=\"/url\" title=\"title "and" title\">link</a></p>\n"@@ -1375,16 +1369,16 @@ "<p><a href=\"/uri\" title=\"title\">link</a></p>\n" it "CM482" $ let s = "[link] (/uri)\n"- in s ~-> errFancy (posN 1 s) (couldNotMatchRef "link" [])+ in s ~-> errFancy 1 (couldNotMatchRef "link" []) it "CM483" $ let s = "[link [foo [bar]]](/uri)\n"- in s ~-> err (posN 6 s) (utok '[' <> etok ']' <> eic)+ in s ~-> err 6 (utok '[' <> etok ']' <> eic) it "CM484" $ let s = "[link] bar](/uri)\n"- in s ~-> errFancy (posN 1 s) (couldNotMatchRef "link" [])+ in s ~-> errFancy 1 (couldNotMatchRef "link" []) it "CM485" $ let s = "[link [bar](/uri)\n"- in s ~-> err (posN 6 s) (utok '[' <> etok ']' <> eic)+ in s ~-> err 6 (utok '[' <> etok ']' <> eic) it "CM486" $ "[link \\[bar](/uri)\n" ==-> "<p><a href=\"/uri\">link [bar</a></p>\n"@@ -1396,28 +1390,28 @@ "<p><a href=\"/uri\"><img src=\"moon.jpg\" alt=\"moon\"></a></p>\n" it "CM489" $ let s = "[foo [bar](/uri)](/uri)\n"- in s ~-> err (posN 5 s) (utok '[' <> etok ']' <> eic)+ in s ~-> err 5 (utok '[' <> etok ']' <> eic) it "CM490" $ let s = "[foo *[bar [baz](/uri)](/uri)*](/uri)\n"- in s ~-> err (posN 6 s) (utok '[' <> eic)+ in s ~-> err 6 (utok '[' <> eic) it "CM491" $ let s = "](uri2)](uri3)"- in s ~-> err (posN 3 s) (utok '[' <> eic)+ in s ~-> err 3 (utok '[' <> eic) it "CM492" $ let s = "*[foo*](/uri)\n"- in s ~-> err (posN 5 s) (utok '*' <> etok ']' <> eic)+ in s ~-> err 5 (utok '*' <> etok ']' <> eic) it "CM493" $ let s = "[foo *bar](baz*)\n"- in s ~-> err (posN 9 s) (utok ']' <> etok '*' <> eic)+ in s ~-> err 9 (utok ']' <> etok '*' <> eic) it "CM494" $ let s = "*foo [bar* baz]\n"- in s ~-> err (posN 9 s) (utok '*' <> etok ']' <> eic)+ in s ~-> err 9 (utok '*' <> etok ']' <> eic) it "CM495" $ "[foo <bar attr=\"](baz)\">" ==-> "<p><a href=\"baz\">foo <bar attr="</a>"></p>\n" it "CM496" $ let s = "[foo`](/uri)`\n"- in s ~-> err (posN 13 s) (ueib <> etok ']' <> eic)+ in s ~-> err 13 (ueib <> etok ']' <> eic) it "CM497" $ "[foo<http://example.com/?search=](uri)>" ==-> "<p><a href=\"uri\">foo<http://example.com/?search=</a>></p>\n"@@ -1426,7 +1420,7 @@ "<p><a href=\"/url\" title=\"title\">foo</a></p>\n" it "CM499" $ let s = "[link [foo [bar]]][ref]\n\n[ref]: /uri"- in s ~-> err (posN 6 s) (utok '[' <> etok ']' <> eic)+ in s ~-> err 6 (utok '[' <> etok ']' <> eic) it "CM500" $ "[link \\[bar][ref]\n\n[ref]: /uri" ==-> "<p><a href=\"/uri\">link [bar</a></p>\n"@@ -1438,22 +1432,22 @@ "<p><a href=\"/uri\"><img src=\"moon.jpg\" alt=\"moon\"></a></p>\n" it "CM503" $ let s = "[foo [bar](/uri)][ref]\n\n[ref]: /uri"- in s ~-> err (posN 5 s) (utok '[' <> etok ']' <> eic)+ in s ~-> err 5 (utok '[' <> etok ']' <> eic) it "CM504" $ let s = "[foo *bar [baz][ref]*][ref]\n\n[ref]: /uri"- in s ~-> err (posN 10 s) (utok '[' <> etok '*' <> eic)+ in s ~-> err 10 (utok '[' <> etok '*' <> eic) it "CM505" $ let s = "*[foo*][ref]\n\n[ref]: /uri"- in s ~-> err (posN 5 s) (utok '*' <> etok ']' <> eic)+ in s ~-> err 5 (utok '*' <> etok ']' <> eic) it "CM506" $ let s = "[foo *bar][ref]\n\n[ref]: /uri"- in s ~-> err (posN 9 s) (utok ']' <> etok '*' <> eic)+ in s ~-> err 9 (utok ']' <> etok '*' <> eic) it "CM507" $ "[foo <bar attr=\"][ref]\">\n\n[ref]: /uri" ==-> "<p><a href=\"/uri\">foo <bar attr="</a>"></p>\n" it "CM508" $ let s = "[foo`][ref]`\n\n[ref]: /uri"- in s ~-> err (posN 12 s) (ueib <> etok ']' <> eic)+ in s ~-> err 12 (ueib <> etok ']' <> eic) it "CM509" $ "[foo<http://example.com/?search=][ref]>\n\n[ref]: /uri" ==-> "<p><a href=\"/uri\">foo<http://example.com/?search=</a>></p>\n"@@ -1468,31 +1462,33 @@ "<p><a href=\"/url\">Baz</a></p>\n" it "CM513" $ let s = "[foo] [bar]\n\n[bar]: /url \"title\""- in s ~-> errFancy (posN 1 s) (couldNotMatchRef "foo" [])+ in s ~-> errFancy 1 (couldNotMatchRef "foo" []) it "CM514" $ let s = "[foo]\n[bar]\n\n[bar]: /url \"title\""- in s ~-> errFancy (posN 1 s) (couldNotMatchRef "foo" [])+ in s ~-> errFancy 1 (couldNotMatchRef "foo" []) it "CM515" $ let s = "[foo]: /url1\n\n[foo]: /url2\n\n[bar][foo]"- in s ~-> errFancy (posN 15 s) (duplicateRef "foo")+ in s ~-> errFancy 15 (duplicateRef "foo") it "CM516" $ "[bar][foo\\!]\n\n[foo!]: /url" ==-> "<p><a href=\"/url\">bar</a></p>\n" it "CM517" $ let s = "[foo][ref[]\n\n[ref[]: /uri" in s ~~->- [ err (posN 9 s) (utok '[' <> etok ']' <> elabel "the rest of reference label")- , err (posN 17 s) (utok '[' <> etok ']' <> eic) ]+ [ err 9 (utok '[' <> etoks "&#" <> etok '&' <> etok ']'+ <> elabel "escaped character")+ , err 17 (utok '[' <> etok ']' <> eic) ] it "CM518" $ let s = "[foo][ref[bar]]\n\n[ref[bar]]: /uri" in s ~~->- [ err (posN 9 s) (utok '[' <> etok ']' <> elabel "the rest of reference label")- , err (posN 21 s) (utok '[' <> etok ']' <> eic) ]+ [ err 9 (utok '[' <> etoks "&#" <> etok '&' <> etok ']'+ <> elabel "escaped character")+ , err 21 (utok '[' <> etok ']' <> eic) ] it "CM519" $ let s = "[[[foo]]]\n\n[[[foo]]]: /url" in s ~~->- [ err (posN 1 s) (utok '[' <> eic)- , err (posN 12 s) (utok '[' <> eic) ]+ [ err 1 (utok '[' <> eic)+ , err 12 (utok '[' <> eic) ] it "CM520" $ "[foo][ref\\[]\n\n[ref\\[]: /uri" ==-> "<p><a href=\"/uri\">foo</a></p>\n"@@ -1502,37 +1498,37 @@ it "CM522" $ let s = "[]\n\n[]: /uri" in s ~~->- [ err (posN 1 s) (utok ']' <> eic)- , err (posN 5 s) (utok ']' <> eic) ]+ [ err 1 (utok ']' <> eic)+ , err 5 (utok ']' <> eic) ] it "CM523" $ let s = "[\n ]\n\n[\n ]: /uri" in s ~~->- [ errFancy (posN 1 s) (couldNotMatchRef "" [])- , errFancy (posN 7 s) (couldNotMatchRef "" []) ]+ [ errFancy 1 (couldNotMatchRef "" [])+ , errFancy 7 (couldNotMatchRef "" []) ] it "CM524" $ "[foo][]\n\n[foo]: /url \"title\"" ==-> "<p><a href=\"/url\" title=\"title\">foo</a></p>\n" it "CM525" $ let s = "[*foo* bar][]\n\n[*foo* bar]: /url \"title\""- in s ~-> errFancy (posN 1 s) (couldNotMatchRef "foo bar" ["*foo* bar"])+ in s ~-> errFancy 1 (couldNotMatchRef "foo bar" ["*foo* bar"]) it "CM526" $ "[Foo][]\n\n[foo]: /url \"title\"" ==-> "<p><a href=\"/url\" title=\"title\">Foo</a></p>\n" it "CM527" $ let s = "[foo] \n[]\n\n[foo]: /url \"title\""- in s ~-> err (posN 8 s) (utok ']' <> eic)+ in s ~-> err 8 (utok ']' <> eic) it "CM528" $ "[foo]\n\n[foo]: /url \"title\"" ==-> "<p><a href=\"/url\" title=\"title\">foo</a></p>\n" it "CM529" $ let s = "[*foo* bar]\n\n[*foo* bar]: /url \"title\""- in s ~-> errFancy (posN 1 s) (couldNotMatchRef "foo bar" ["*foo* bar"])+ in s ~-> errFancy 1 (couldNotMatchRef "foo bar" ["*foo* bar"]) it "CM530" $ let s = "[[*foo* bar]]\n\n[*foo* bar]: /url \"title\""- in s ~-> err (posN 1 s) (utok '[' <> eic)+ in s ~-> err 1 (utok '[' <> eic) it "CM531" $ let s = "[[bar [foo]\n\n[foo]: /url"- in s ~-> err (posN 1 s) (utok '[' <> eic)+ in s ~-> err 1 (utok '[' <> eic) it "CM532" $ "[Foo]\n\n[foo]: /url \"title\"" ==-> "<p><a href=\"/url\" title=\"title\">Foo</a></p>\n"@@ -1541,10 +1537,10 @@ "<p><a href=\"/url\">foo</a> bar</p>\n" it "CM534" $ let s = "\\[foo]\n\n[foo]: /url \"title\""- in s ~-> err (posN 5 s) (utok ']' <> eeib <> eic)+ in s ~-> err 5 (utok ']' <> eeib <> eic) it "CM535" $ let s = "[foo*]: /url\n\n*[foo*]"- in s ~-> err (posN 19 s) (utok '*' <> etok ']' <> eic)+ in s ~-> err 19 (utok '*' <> etok ']' <> eic) it "CM536" $ "[foo][bar]\n\n[foo]: /url1\n[bar]: /url2" ==-> "<p><a href=\"/url2\">foo</a></p>\n"@@ -1553,20 +1549,20 @@ "<p><a href=\"/url1\">foo</a></p>\n" it "CM538" $ let s = "[foo]()\n\n[foo]: /url1"- in s ~-> err (posN 6 s) (utok ')' <> etok '<' <> elabel "URI" <> ews)+ in s ~-> err 6 (utok ')' <> etok '<' <> elabel "URI" <> ews) it "CM539" $ let s = "[foo](not a link)\n\n[foo]: /url1"- in s ~-> err (posN 10 s)+ in s ~-> err 10 (utok 'a' <> etok '"' <> etok '\'' <> etok '(' <> etok ')' <> ews) it "CM540" $ let s = "[foo][bar][baz]\n\n[baz]: /url"- in s ~-> errFancy (posN 6 s) (couldNotMatchRef "bar" ["baz"])+ in s ~-> errFancy 6 (couldNotMatchRef "bar" ["baz"]) it "CM541" $ "[foo][bar][baz]\n\n[baz]: /url1\n[bar]: /url2" ==-> "<p><a href=\"/url2\">foo</a><a href=\"/url1\">baz</a></p>\n" it "CM542" $ let s = "[foo][bar][baz]\n\n[baz]: /url1\n[foo]: /url2"- in s ~-> errFancy (posN 6 s) (couldNotMatchRef "bar" ["baz"])+ in s ~-> errFancy 6 (couldNotMatchRef "bar" ["baz"]) context "6.6 Images" $ do it "CM543" $ "![foo](/url \"title\")" ==->@@ -1576,13 +1572,13 @@ "<p><img src=\"train.jpg\" title=\"train & tracks\" alt=\"foo bar\"></p>\n" it "CM545" $ let s = "](/url2)\n"- in s ~-> err (posN 6 s) (utok '!' <> etok ']' <> eic)+ in s ~-> err 6 (utok '!' <> etok ']' <> eic) it "CM546" $ "](/url2)" ==-> "<p><img src=\"/url2\" alt=\"foo bar\"></p>\n" it "CM547" $ let s = "![foo *bar*][]\n\n[foo *bar*]: train.jpg \"train & tracks\"\n"- in s ~-> errFancy (posN 2 s) (couldNotMatchRef "foo bar" ["foo *bar*"])+ in s ~-> errFancy 2 (couldNotMatchRef "foo bar" ["foo *bar*"]) it "CM548" $ "![foo *bar*][foobar]\n\n[FOOBAR]: train.jpg \"train & tracks\"" ==-> "<p><img src=\"train.jpg\" title=\"train & tracks\" alt=\"foo bar\"></p>\n"@@ -1614,7 +1610,7 @@ "<p><img src=\"/url\" title=\"title\" alt=\"Foo\"></p>\n" it "CM558" $ let s = "![foo] \n[]\n\n[foo]: /url \"title\""- in s ~-> err (posN 9 s) (utok ']' <> eic)+ in s ~-> err 9 (utok ']' <> eic) it "CM559" $ "![foo]\n\n[foo]: /url \"title\"" ==-> "<p><img src=\"/url\" title=\"title\" alt=\"foo\"></p>\n"@@ -1624,8 +1620,8 @@ it "CM561" $ let s = "![[foo]]\n\n[[foo]]: /url \"title\"" in s ~~->- [ errFancy (posN 3 s) (couldNotMatchRef "foo" [])- , err (posN 11 s) (utok '[' <> eic) ]+ [ errFancy 3 (couldNotMatchRef "foo" [])+ , err 11 (utok '[' <> eic) ] it "CM562" $ "![Foo]\n\n[foo]: /url \"title\"" ==-> "<p><img src=\"/url\" title=\"title\" alt=\"Foo\"></p>\n"@@ -1656,7 +1652,7 @@ "<p><a href=\"made-up-scheme://foo/,bar\">made-up-scheme://foo/,bar</a></p>\n" it "CM571" $ "<http://../>" ==->- "<p><http://../></p>\n"+ "<p><a href=\"http://../\">http://../</a></p>\n" it "CM572" $ "<localhost:5001/foo>" ==-> "<p><a href=\"localhost:5001/foo\">localhost:5001/foo</a></p>\n"@@ -1797,7 +1793,7 @@ context "title parse errors" $ it "parse error is OK in reference definitions" $ let s = "[something]: something something"- in s ~-> err (posN 23 s)+ in s ~-> err 23 (utoks "so" <> etok '\'' <> etok '\"' <> etok '(' <> elabel "white space" <> elabel "newline") context "tables" $ do@@ -1809,25 +1805,25 @@ "| Foo |\n| --- |\n| foo |" ==-> o it "reports correct parse errors when parsing the header line" $ (let s = "Foo | Bar\na-- | ---"- in s ~-> err (posN 10 s) (utok 'a' <> etok '-' <> etok ':' <> etok '|' <> elabel "white space"))+ in s ~-> err 10 (utok 'a' <> etok '-' <> etok ':' <> etok '|' <> elabel "white space")) >> (let s = "Foo | Bar\n-a- | ---"- in s ~-> err (posN 11 s) (utok 'a' <> etok '-'))+ in s ~-> err 11 (utok 'a' <> etok '-')) >> (let s = "Foo | Bar\n--a | ---"- in s ~-> err (posN 12 s) (utok 'a' <> etok '-'))+ in s ~-> err 12 (utok 'a' <> etok '-')) >> (let s = "Foo | Bar\n---a | ---"- in s ~-> err (posN 13 s) (utok 'a' <> etok '-' <> etok ':' <> etok '|' <> elabel "white space"))+ in s ~-> err 13 (utok 'a' <> etok '-' <> etok ':' <> etok '|' <> elabel "white space")) it "falls back to paragraph when header line is weird enough" $ "Foo | Bar\nab- | ---" ==-> "<p>Foo | Bar\nab- | ---</p>\n" it "demands that number of columns in rows match number of columns in header" $ (let s = "Foo | Bar | Baz\n--- | --- | ---\nfoo | bar"- in s ~-> err (posN 41 s) (ulabel "end of table block" <> etok '|' <> eic))+ in s ~-> err 41 (ulabel "end of table block" <> etok '|' <> eic)) >> (let s = "Foo | Bar | Baz\n--- | --- | ---\nfoo | bar\n\nHere it goes."- in s ~-> err (posN 41 s) (utok '\n' <> etok '|' <> eic))+ in s ~-> err 41 (utok '\n' <> etok '|' <> eic)) it "recognizes escaped pipes" $ "Foo \\| | Bar\n--- | ---\nfoo | \\|" ==-> "<table>\n<thead>\n<tr><th>Foo |</th><th>Bar</th></tr>\n</thead>\n<tbody>\n<tr><td>foo</td><td>|</td></tr>\n</tbody>\n</table>\n"@@ -1836,7 +1832,7 @@ "<table>\n<thead>\n<tr><th>Foo</th><th>Bar</th></tr>\n</thead>\n<tbody>\n<tr><td>*foo*</td><td>bar</td></tr>\n</tbody>\n</table>\n" it "escaped pipes do not fool position tracking" $ let s = "Foo | Bar\n--- | ---\n\\| *fo | bar"- in s ~-> err (posN 26 s) (ueib <> etok '*' <> elabel "inline content")+ in s ~-> err 26 (ueib <> etok '*' <> elabel "inline content") it "pipes in code spans in headers do not fool the parser" $ "`|Foo|` | `|Bar|`\n--- | ---\nfoo | bar" ==-> "<table>\n<thead>\n<tr><th><code>|Foo|</code></th><th><code>|Bar|</code></th></tr>\n</thead>\n<tbody>\n<tr><td>foo</td><td>bar</td></tr>\n</tbody>\n</table>\n"@@ -1849,8 +1845,8 @@ it "multi-line code spans are disallowed in table cells" $ let s = "Foo | Bar\n--- | ---\n`foo\nbar` | bar" in s ~~->- [ err (posN 24 s) (utok '\n' <> etok '`' <> ecsc)- , err (posN 35 s) (ueib <> etok '`' <> ecsc)+ [ err 24 (utok '\n' <> etok '`' <> ecsc)+ , err 35 (ueib <> etok '`' <> ecsc) ] it "parses tables with just header row" $ "Foo | Bar\n--- | ---" ==->@@ -1861,9 +1857,9 @@ it "is capable of reporting a parse error per cell" $ let s = "Foo | *Bar\n--- | ----\n_foo | bar_" in s ~~->- [ err (posN 10 s) (ueib <> etok '*' <> eic)- , err (posN 26 s) (ueib <> etok '_' <> eic)- , errFancy (posN 32 s) (nonFlanking "_") ]+ [ err 10 (ueib <> etok '*' <> eic)+ , err 26 (ueib <> etok '_' <> eic)+ , errFancy 32 (nonFlanking "_") ] it "tables have higher precedence than unordered lists" $ do "+ foo | bar\n------|----\n" ==-> "<table>\n<thead>\n<tr><th>+ foo</th><th>bar</th></tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n"@@ -1887,58 +1883,50 @@ let s = "Foo `\n\nBar `.\n" pe = ueib <> etok '`' <> ecsc s ~~->- [ err (posN 5 s) pe- , err (posN 13 s) pe ]+ [ err 5 pe+ , err 13 pe ] it "invalid headers are skipped properly" $ do let s = "#My header\n\nSomething goes __here __.\n" s ~~->- [ err (posN 1 s) (utok 'M' <> etok '#' <> ews)- , err (posN 37 s) (ueib <> etoks "__" <> eic) ]+ [ err 1 (utok 'M' <> etok '#' <> ews)+ , err 37 (ueib <> etoks "__" <> eic) ] 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 s ~~->- [ err (posN 6 s) e- , err (posN 14 s) e- , err (posN 21 s) e- , err (posN 30 s) e ]+ [ err 6 e+ , err 14 e+ , err 21 e+ , err 30 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 s ~~->- [ err (posN 7 s) e- , err (posN 16 s) e- , err (posN 24 s) e- , err (posN 34 s) e ]+ [ err 7 e+ , err 16 e+ , err 24 e+ , err 34 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)- , err (posN 36 s) (ueib <> eic) ]+ [ errFancy 0 (indexTooBig 1234567890)+ , err 22 (ueib <> etok '*' <> eic)+ , err 36 (ueib <> eic) ] 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 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 ]+ [ err 7 e+ , errFancy 8 (indexNonCons 3 2)+ , err 15 e+ , errFancy 16 (indexNonCons 4 3)+ , err 23 e ] 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."@@ -1988,12 +1976,12 @@ "mapping values are not allowed in this context" it "signal correct parse error" $ let s = "---\nx: 100\ny: x:\n---\nHere we go."- in s ~-> errFancy (posN 15 s) mappingErr+ in s ~-> errFancy 15 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)+ [ errFancy 15 mappingErr+ , err 33 (ueib <> etok '*' <> eic) ] ----------------------------------------------------------------------------@@ -2039,38 +2027,47 @@ -- | Unexpected end of inline block. -ueib :: Ord t => ET t+ueib :: Stream s => ET s ueib = ulabel "end of inline block" -- | Expecting end of inline block. -eeib :: Ord t => ET t+eeib :: Stream s => ET s eeib = elabel "end of inline block" -- | Expecting end of URI. -euri :: Ord t => ET t+euri :: Stream s => ET s euri = elabel "end of URI" --- | 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 :: Stream s => ET s eic = elabel "inline content" -- | Expecting white space. -ews :: Ord t => ET t+ews :: Stream s => ET s ews = elabel "white space" -- | Expecting code span content. -ecsc :: Ord t => ET t+ecsc :: Stream s => ET s ecsc = elabel "code span content"++-- | Expecting common URI components.++euric :: ET Text+euric = mconcat+ [ etok '#'+ , etok '%'+ , etok '/'+ , etok ':'+ , etok '?'+ , etok '@'+ , elabel "sub-delimiter"+ , elabel "unreserved character"+ ] -- | Error component complaining that the given 'Text' is not in left- or -- right- flanking position.