diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,7 +5,6 @@ [![Stackage Nightly](http://stackage.org/package/mmark/badge/nightly)](http://stackage.org/nightly/package/mmark) [![Stackage LTS](http://stackage.org/package/mmark/badge/lts)](http://stackage.org/lts/package/mmark) [![Build Status](https://travis-ci.org/mmark-md/mmark.svg?branch=master)](https://travis-ci.org/mmark-md/mmark) -[![Coverage Status](https://coveralls.io/repos/mmark-md/mmark/badge.svg?branch=master&service=github)](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 diff --git a/Text/MMark.hs b/Text/MMark.hs --- a/Text/MMark.hs +++ b/Text/MMark.hs @@ -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 diff --git a/Text/MMark/Parser.hs b/Text/MMark/Parser.hs --- a/Text/MMark/Parser.hs +++ b/Text/MMark/Parser.hs @@ -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") diff --git a/Text/MMark/Parser/Internal.hs b/Text/MMark/Parser/Internal.hs --- a/Text/MMark/Parser/Internal.hs +++ b/Text/MMark/Parser/Internal.hs @@ -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. diff --git a/Text/MMark/Parser/Internal/Type.hs b/Text/MMark/Parser/Internal/Type.hs --- a/Text/MMark/Parser/Internal/Type.hs +++ b/Text/MMark/Parser/Internal/Type.hs @@ -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" diff --git a/Text/MMark/Render.hs b/Text/MMark/Render.hs --- a/Text/MMark/Render.hs +++ b/Text/MMark/Render.hs @@ -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: diff --git a/Text/MMark/Type.hs b/Text/MMark/Type.hs --- a/Text/MMark/Type.hs +++ b/Text/MMark/Type.hs @@ -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 diff --git a/Text/MMark/Util.hs b/Text/MMark/Util.hs --- a/Text/MMark/Util.hs +++ b/Text/MMark/Util.hs @@ -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 } diff --git a/mmark.cabal b/mmark.cabal --- a/mmark.cabal +++ b/mmark.cabal @@ -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 @@ -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) diff --git a/tests/Text/MMark/ExtensionSpec.hs b/tests/Text/MMark/ExtensionSpec.hs --- a/tests/Text/MMark/ExtensionSpec.hs +++ b/tests/Text/MMark/ExtensionSpec.hs @@ -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 diff --git a/tests/Text/MMark/TestUtils.hs b/tests/Text/MMark/TestUtils.hs --- a/tests/Text/MMark/TestUtils.hs +++ b/tests/Text/MMark/TestUtils.hs @@ -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 diff --git a/tests/Text/MMarkSpec.hs b/tests/Text/MMarkSpec.hs --- a/tests/Text/MMarkSpec.hs +++ b/tests/Text/MMarkSpec.hs @@ -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___" ==-> "
\n
\n
\n" @@ -77,14 +77,14 @@ "===" ==-> "

===

\n" it "CM16" $ let s = "--\n**\n__\n" - in s ~-> errFancy (posN 3 s) (nonFlanking "**") + in s ~-> errFancy 3 (nonFlanking "**") it "CM17" $ " ***\n ***\n ***" ==-> "
\n
\n
\n" it "CM18" $ " ***" ==-> "
***\n
\n" it "CM19" $ let s = "Foo\n ***\n" - in s ~-> errFancy (posN 8 s) (nonFlanking "***") + in s ~-> errFancy 8 (nonFlanking "***") it "CM20" $ "_____________________________________" ==-> "
\n" @@ -98,7 +98,7 @@ "- - - - " ==-> "
\n" it "CM25" $ let s = "_ _ _ _ a\n\na------\n\n---a---\n" - in s ~-> errFancy posI (nonFlanking "_") + in s ~-> errFancy 0 (nonFlanking "_") it "CM26" $ " *-*" ==-> "

-

\n" it "CM27" $ @@ -122,12 +122,12 @@ "

foo

\n

foo

\n

foo

\n

foo

\n
foo
\n
foo
\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" ==-> "

## foo

\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\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---" ==-> "
\n

Foo

\n
\n
\n" @@ -312,15 +312,14 @@ "
aaa\n~~~\n
\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```" ==-> "
\n  \n
\n" @@ -347,14 +346,14 @@ "
aaa\n
\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" ==-> "

\naaa

\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\n'title'\n\n[Foo bar]" ==-> "

Foo bar

\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" ==-> "

foo

\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]" ==-> "

Foo

\n" @@ -434,10 +432,10 @@ "

bar

\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\"" ==-> "
[foo]: /url "title"\n
\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" ==-> "

Foo

\n
\n

bar

\n
\n" @@ -604,7 +602,7 @@ "
    \n
  1. \nok\n
    2. \n
\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" ==-> "
    \n
  1. \nok\n
    2. \n
\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 @@ "

*not emphasized*\n<br/> not a tag\n[not a link](/foo)\n`not code`\n1. not a list\n* not a list\n# not a heading\n[foo]: /url "not a reference"

\n" it "CM292" $ let s = "\\\\*emphasis*" - in s ~-> errFancy (posN 2 s) (nonFlanking "*") + in s ~-> errFancy 2 (nonFlanking "*") it "CM293" $ "foo\\\nbar" ==-> "

foo
\nbar

\n" @@ -820,14 +818,13 @@ "

<a href="/bar/)">

\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```" ==-> "
foo\n
\n" @@ -839,9 +836,9 @@ "# Ӓ Ϡ" ==-> "

# Ӓ Ϡ

\n" it "CM303b" $ - "�" ~-> errFancy posI (invalidNumChar 98765432) + "�" ~-> errFancy 0 (invalidNumChar 98765432) it "CM303c" $ - "�" ~-> errFancy posI (invalidNumChar 0) + "�" ~-> errFancy 0 (invalidNumChar 0) it "CM304" $ "" ആ ಫ" ==-> "

" ആ ಫ

\n" @@ -849,16 +846,16 @@ " " ==-> "

&nbsp

\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?;" ==-> "

&hi?;

\n" it "CM306" $ @@ -866,7 +863,7 @@ "

&copy

\n" it "CM307" $ let s = "&MadeUpEntity;" - in s ~-> errFancy posI (unknownEntity "MadeUpEntity") + in s ~-> errFancy 0 (unknownEntity "MadeUpEntity") it "CM308" $ "" ==-> "

<a href="\246\246.html">

\n" @@ -903,144 +900,144 @@ "`foo `` bar`" ==-> "

foo `` bar

\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 = "``\n" - in s ~-> err (posN 14 s) (ueib <> etok '`' <> ecsc) + in s ~-> err 14 (ueib <> etok '`' <> ecsc) it "CM325" $ "`" ==-> "

<a href="">

\n" it "CM326" $ let s = "``\n" - in s ~-> err (posN 23 s) (ueib <> etok '`' <> ecsc) + in s ~-> err 23 (ueib <> etok '`' <> ecsc) it "CM327" $ "`" ==-> "

<http://foo.bar.baz>

\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*" ==-> "

foo bar

\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_" ==-> "

foo bar

\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*)*" ==-> "

(foo)

\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_)_" ==-> "

(foo)

\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" ==-> "

(bar).

\n" it "CM358" $ "**foo bar**\n" ==-> "

foo bar

\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__" ==-> "

foo bar

\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__" ==-> "

foo, bar, baz

\n" @@ -1048,10 +1045,10 @@ "foo-__\\(bar)__" ==-> "

foo-(bar)

\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**)*" ==-> "

(foo)

\n" @@ -1063,22 +1060,22 @@ "

foo "bar" foo

\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__)_" ==-> "

(foo)

\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__" ==-> "

foo__bar__baz

\n" @@ -1099,7 +1096,7 @@ "

foo bar baz

\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**" ==-> "

foo bar

\n" @@ -1108,14 +1105,14 @@ "

foo bar baz

\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" ==-> "

foo bar

\n" it "CM393" $ "*foo **bar***\n" ==-> "

foo bar

\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" ==-> "

foo bar baz bim bop

\n" @@ -1124,10 +1121,10 @@ "

foo bar

\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)**" ==-> "

foo bar

\n" @@ -1151,7 +1148,7 @@ "

foo bar baz

\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**" ==-> "

foo bar

\n" @@ -1166,74 +1163,74 @@ "

foo bar

\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 *\\**" ==-> "

foo *

\n" it "CM415" $ "foo *\\_*\n" ==-> "

foo _

\n" it "CM416" $ let s = "foo *****\n" - in s ~-> errFancy (posN 8 s) (nonFlanking "*") + in s ~-> errFancy 8 (nonFlanking "*") it "CM417" $ "foo **\\***" ==-> "

foo *

\n" it "CM418" $ "foo **\\_**\n" ==-> "

foo _

\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 _\\__" ==-> "

foo _

\n" it "CM427" $ "foo _\\*_" ==-> "

foo *

\n" it "CM428" $ let s = "foo _____\n" - in s ~-> errFancy (posN 8 s) (nonFlanking "_") + in s ~-> errFancy 8 (nonFlanking "_") it "CM429" $ "foo __\\___" ==-> "

foo _

\n" it "CM430" $ "foo __\\*__" ==-> "

foo *

\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**" ==-> "

foo

\n" it "CM438" $ @@ -1256,41 +1253,41 @@ "

foo

\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 = "*\n" - in s ~-> errFancy (posN 23 s) (nonFlanking "*") + in s ~-> errFancy 23 (nonFlanking "*") it "CM453" $ let s = "**" - in s ~-> errFancy (posN 11 s) (nonFlanking "**") + in s ~-> errFancy 11 (nonFlanking "**") it "CM454" $ let s = "__\n" - in s ~-> errFancy (posN 11 s) (nonFlanking "__") + in s ~-> errFancy 11 (nonFlanking "__") it "CM455" $ "*a `*`*" ==-> "

a *

\n" it "CM456" $ "_a `_`_" ==-> "

a _

\n" it "CM457" $ let s = "**a" - in s ~-> err (posN 25 s) (ueib <> etoks "**" <> eic) + in s ~-> err 25 (ueib <> etoks "**" <> eic) it "CM458" $ let s = "__a" - 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 @@ "

link

\n" it "CM461" $ let s = "[link]()" - in s ~-> err (posN 7 s) + in s ~-> err 7 (utok ')' <> etok '<' <> elabel "URI" <> ews) it "CM462" $ "[link](<>)" ==-> "

link

\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]()\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]()\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 @@ "

link))

\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]()" ==-> "

link

\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" ==-> "

link

\n

link

\n

link

\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ä)" ==-> "

link

\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 @@ "

link

\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')" ==-> "

link

\n" @@ -1375,16 +1369,16 @@ "

link

\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" ==-> "

link [bar

\n" @@ -1396,28 +1390,28 @@ "

\"moon\"

\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 = "![[[foo](uri1)](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 " ==-> "

foo <bar attr="">

\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" ==-> "

foo<http://example.com/?search=>

\n" @@ -1426,7 +1420,7 @@ "

foo

\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" ==-> "

link [bar

\n" @@ -1438,22 +1432,22 @@ "

\"moon\"

\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 \n\n[ref]: /uri" ==-> "

foo <bar attr="">

\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\n\n[ref]: /uri" ==-> "

foo<http://example.com/?search=>

\n" @@ -1468,31 +1462,33 @@ "

Baz

\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" ==-> "

bar

\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" ==-> "

foo

\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\"" ==-> "

foo

\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\"" ==-> "

Foo

\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\"" ==-> "

foo

\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\"" ==-> "

Foo

\n" @@ -1541,10 +1537,10 @@ "

foo bar

\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" ==-> "

foo

\n" @@ -1553,20 +1549,20 @@ "

foo

\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" ==-> "

foobaz

\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 @@ "

\"foo

\n" it "CM545" $ let s = "![foo ![bar](/url)](/url2)\n" - in s ~-> err (posN 6 s) (utok '!' <> etok ']' <> eic) + in s ~-> err 6 (utok '!' <> etok ']' <> eic) it "CM546" $ "![foo [bar](/url)](/url2)" ==-> "

\"foo

\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\"" ==-> "

\"foo

\n" @@ -1614,7 +1610,7 @@ "

\"Foo\"

\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\"" ==-> "

\"foo\"

\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\"" ==-> "

\"Foo\"

\n" @@ -1656,7 +1652,7 @@ "

made-up-scheme://foo/,bar

\n" it "CM571" $ "" ==-> - "

<http://../>

\n" + "

http://../

\n" it "CM572" $ "" ==-> "

localhost:5001/foo

\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- | ---" ==-> "

Foo | Bar\nab- | ---

\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 | \\|" ==-> "\n\n\n\n\n\n\n
Foo |Bar
foo|
\n" @@ -1836,7 +1832,7 @@ "\n\n\n\n\n\n\n
FooBar
*foo*bar
\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" ==-> "\n\n\n\n\n\n\n
|Foo||Bar|
foobar
\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" ==-> "\n\n\n\n\n\n
+ foobar
\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.