mmark 0.0.6.2 → 0.0.7.0
raw patch · 6 files changed
+134/−56 lines, 6 filesdep ~hashabledep ~yamlPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hashable, yaml
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- Text/MMark/Parser.hs +26/−10
- mmark.cabal +20/−4
- tests/Spec.hs +7/−1
- tests/Text/MMark/TestUtils.hs +16/−1
- tests/Text/MMarkSpec.hs +60/−40
CHANGELOG.md view
@@ -1,3 +1,8 @@+## MMark 0.0.7.0++* Added GHCJS support by making `yaml` dependency optional. With GHCJS a+ yaml block simply always returns the empty object.+ ## MMark 0.0.6.2 * Fixed setting offset after parsing of collapsed reference links.
Text/MMark/Parser.hs view
@@ -9,6 +9,7 @@ -- -- MMark markdown parser. +{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}@@ -43,6 +44,7 @@ import Text.URI (URI) import Text.URI.Lens (uriPath) import qualified Control.Monad.Combinators.NonEmpty as NE+import qualified Data.Aeson as Aeson import qualified Data.Char as Char import qualified Data.DList as DList import qualified Data.HashMap.Strict as HM@@ -50,11 +52,14 @@ import qualified Data.Set as E import qualified Data.Text as T import qualified Data.Text.Encoding as TE-import qualified Data.Yaml as Yaml import qualified Text.Email.Validate as Email import qualified Text.Megaparsec.Char.Lexer as L import qualified Text.URI as URI +#if !defined(ghcjs_HOST_OS)+import qualified Data.Yaml as Yaml+#endif+ ---------------------------------------------------------------------------- -- Auxiliary data types @@ -121,7 +126,7 @@ -- | Parse an MMark document on block level. -pMMark :: BParser (Maybe Yaml.Value, [Block Isp])+pMMark :: BParser (Maybe Aeson.Value, [Block Isp]) pMMark = do meyaml <- optional pYamlBlock blocks <- pBlocks@@ -134,11 +139,11 @@ Just (Right yaml) -> (Just yaml, blocks) --- | Parse a YAML block. On success return the actual parsed 'Yaml.Value' in+-- | Parse a YAML block. On success return the actual parsed 'Aeson.Value' in -- 'Right', otherwise return 'SourcePos' of parse error and 'String' -- describing the error as generated by the @yaml@ package in 'Left'. -pYamlBlock :: BParser (Either (Int, String) Yaml.Value)+pYamlBlock :: BParser (Either (Int, String) Aeson.Value) pYamlBlock = do string "---" *> sc' *> eol let go acc = do@@ -150,12 +155,7 @@ else go (acc . (l:)) doffset <- getOffset ls <- go id <*> ([] <$ sc)- return $- case (Yaml.decodeEither' . TE.encodeUtf8 . T.intercalate "\n") ls of- Left err' ->- let (moffset, err) = splitYamlError err'- in Left (maybe doffset (+ doffset) moffset, err)- Right v -> Right v+ return $ decodeYaml ls doffset -- | Parse several (possibly zero) blocks in a row. @@ -1144,6 +1144,21 @@ else Nothing _ -> Nothing +-- | Decode the yaml block to a 'Aeson.Value'. On GHCJs, without access to+-- libyaml we just return an empty object. It's worth using a pure haskell+-- parser later if this is unacceptable for someone's needs.++decodeYaml :: [T.Text] -> Int -> (Either (Int,String) Aeson.Value)+#ifdef ghcjs_HOST_OS+decodeYaml _ _ = pure $ Aeson.object []+#else+decodeYaml ls doffset =+ case (Yaml.decodeEither' . TE.encodeUtf8 . T.intercalate "\n") ls of+ Left err' ->+ let (moffset, err) = splitYamlError err'+ in Left (maybe doffset (+ doffset) moffset, err)+ Right v -> Right v+ splitYamlError :: Yaml.ParseException -> (Maybe Int, String)@@ -1173,6 +1188,7 @@ ++ ", value: " ++ show value ) Yaml.CyclicIncludes -> (Nothing, "cyclic includes")+#endif emptyIspSpan :: Isp emptyIspSpan = IspSpan 0 ""
mmark.cabal view
@@ -1,7 +1,7 @@ name: mmark-version: 0.0.6.2+version: 0.0.7.0 cabal-version: 1.18-tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.3+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5 license: BSD3 license-file: LICENSE.md author: Mark Karpov <markkarpov92@gmail.com>@@ -47,13 +47,15 @@ , text >= 0.2 && < 1.3 , text-metrics >= 0.3 && < 0.4 , unordered-containers >= 0.2.5 && < 0.3- , yaml >= 0.8.10 && < 0.12+ if !impl(ghcjs)+ build-depends: yaml >= 0.8.10 && < 0.12 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* if !impl(ghc >= 7.10) build-depends: void == 0.7.* if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.*+ exposed-modules: Text.MMark , Text.MMark.Extension other-modules: Text.MMark.Parser@@ -73,6 +75,9 @@ -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances+ if impl(ghcjs)+ ghcjs-options: +RTS -K1G -RTS -Wall+ default-language: Haskell2010 test-suite tests@@ -90,7 +95,6 @@ , mmark , 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@@ -100,6 +104,10 @@ ghc-options: -O0 -Wall -Werror else ghc-options: -O2 -Wall++ if impl(ghcjs)+ ghcjs-options: -O0 +RTS -K1G -M5G -RTS -Wall -Wwarn=missing-home-modules+ default-language: Haskell2010 benchmark bench-speed@@ -114,6 +122,10 @@ ghc-options: -O2 -Wall -Werror else ghc-options: -O2 -Wall++ if impl(ghcjs)+ ghcjs-options: -O0 +RTS -K1G -M6G -RTS -Wall -Wwarn=missing-home-modules+ default-language: Haskell2010 benchmark bench-memory@@ -128,4 +140,8 @@ ghc-options: -O2 -Wall -Werror else ghc-options: -O2 -Wall++ if impl(ghcjs)+ ghcjs-options: -O0 +RTS -K1G -M6G -RTS -Wall -Wwarn=missing-home-modules+ default-language: Haskell2010
tests/Spec.hs view
@@ -1,1 +1,7 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+module Main (main) where++import Test.Hspec+import Text.MMarkSpec (spec)++main :: IO ()+main = hspec spec
tests/Text/MMark/TestUtils.hs view
@@ -8,10 +8,13 @@ , (~~->) , (~->) , (=->)- , (==->) )+ , (==->)+ , (##->)+ ) where import Control.Monad+import Data.Semigroup ((<>)) import Data.Text (Text) import Test.Hspec import Text.MMark (MMark, MMarkErr)@@ -117,3 +120,15 @@ input ==-> expected = do input =-> expected mappend input "\n" =-> expected++-- | Just like @('==->')@, but the expectation is set with a 'Lucid.Html'+-- instead. This is useful when there are multiple attributes in the+-- outputted HTML, which can cause GHCJs and GHC to output different strings+-- (as Lucid uses an unordered map underneath for the attributes and GHCJs+-- and GHC have different hashing functions).++(##->)+ :: Text -- ^ Input for MMark parser+ -> L.Html () -- ^ Lucid builder to match against+ -> Expectation+input ##-> expected = input ==-> (TL.toStrict (L.renderText expected) <> "\n")
tests/Text/MMarkSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -8,6 +9,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Monoid import Data.Text (Text)+import Lucid import Test.Hspec import Test.Hspec.Megaparsec import Text.MMark (MMarkErr (..))@@ -381,11 +383,10 @@ return () context "4.7 Link reference definitions" $ do it "CM159" $- "[foo]: /url \"title\"\n\n[foo]" ==->- "<p><a href=\"/url\" title=\"title\">foo</a></p>\n"+ "[foo]: /url \"title\"\n\n[foo]" ##-> p_ (a_ [href_ "/url", title_ "title"] "foo") it "CM160" $- " [foo]: \n /url \n 'the title' \n\n[foo]" ==->- "<p><a href=\"/url\" title=\"the title\">foo</a></p>\n"+ " [foo]: \n /url \n 'the title' \n\n[foo]" ##->+ p_ (a_ [href_ "/url", title_ "the title"] "foo") it "CM161" $ let s = "[Foo bar\\]]:my_(url) 'title (with parens)'\n\n[Foo bar\\]]" in s ~~->@@ -393,14 +394,14 @@ , 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"+ "[Foo bar]:\n<my%20url>\n'title'\n\n[Foo bar]" ##->+ p_ (a_ [href_ "my%20url", title_ "title"] "Foo bar") it "CM163" $- "[foo]: /url '\ntitle\nline1\nline2\n'\n\n[foo]" ==->- "<p><a href=\"/url\" title=\"\ntitle\nline1\nline2\n\">foo</a></p>\n"+ "[foo]: /url '\ntitle\nline1\nline2\n'\n\n[foo]" ##->+ p_ (a_ [href_ "/url", title_ "\ntitle\nline1\nline2\n"] "foo") it "CM164" $- "[foo]: /url 'title\n\nwith blank line'\n\n[foo]" ==->- "<p><a href=\"/url\" title=\"title\n\nwith blank line\">foo</a></p>\n"+ "[foo]: /url 'title\n\nwith blank line'\n\n[foo]" ##->+ p_ (a_ [href_ "/url", title_ "title\n\nwith blank line"] "foo") it "CM165" $ "[foo]:\n/url\n\n[foo]" ==-> "<p><a href=\"/url\">foo</a></p>\n"@@ -451,8 +452,13 @@ "# [Foo]\n[foo]: /url\n> bar" ==-> "<h1 id=\"foo\"><a href=\"/url\">Foo</a></h1>\n<blockquote>\n<p>bar</p>\n</blockquote>\n" it "CM180" $- "[foo]: /foo-url \"foo\"\n[bar]: /bar-url\n \"bar\"\n[baz]: /baz-url\n\n[foo],\n[bar],\n[baz]" ==->- "<p><a href=\"/foo-url\" title=\"foo\">foo</a>,\n<a href=\"/bar-url\" title=\"bar\">bar</a>,\n<a href=\"/baz-url\">baz</a></p>\n"+ "[foo]: /foo-url \"foo\"\n[bar]: /bar-url\n \"bar\"\n[baz]: /baz-url\n\n[foo],\n[bar],\n[baz]" ##->+ p_ (do+ a_ [href_ "/foo-url", title_ "foo"] "foo"+ ",\n"+ a_ [href_ "/bar-url", title_ "bar"] "bar"+ ",\n"+ a_ [href_ "/baz-url"] "baz") it "CM181" $ "[foo]\n\n> [foo]: /url" ==-> "<p><a href=\"/url\">foo</a></p>\n<blockquote>\n</blockquote>\n"@@ -868,11 +874,11 @@ "<a href=\"öö.html\">" ==-> "<p><a href="\246\246.html"></p>\n" it "CM309" $- "[foo](/föö \"föö\")" ==->- "<p><a href=\"/f&ouml;&ouml;\" title=\"f\246\246\">foo</a></p>\n"+ "[foo](/föö \"föö\")" ##->+ p_ (a_ [href_ "/föö",title_ "f\246\246"] "foo") it "CM310" $- "[foo]\n\n[foo]: /föö \"föö\"" ==->- "<p><a href=\"/f&ouml;&ouml;\" title=\"f\246\246\">foo</a></p>\n"+ "[foo]\n\n[foo]: /föö \"föö\"" ##->+ p_ (a_ [href_ "/föö",title_ "f\246\246"] "foo") it "CM311" $ "``` föö\nfoo\n```" ==-> "<pre><code class=\"language-f\246\246\">foo\n</code></pre>\n"@@ -1290,8 +1296,8 @@ in s ~-> err 25 (ueib <> etoks "__" <> eic) context "6.5 Links" $ do it "CM459" $- "[link](/uri \"title\")" ==->- "<p><a href=\"/uri\" title=\"title\">link</a></p>\n"+ "[link](/uri \"title\")" ##->+ p_ (a_ [href_ "/uri",title_ "title"] "link") it "CM460" $ "[link](/uri)" ==-> "<p><a href=\"/uri\">link</a></p>\n"@@ -1350,11 +1356,17 @@ etok '?' <> elabel "ASCII alpha character" <> euri <> elabel "path piece" <> ews) it "CM476" $- "[link](/url \"title\")\n[link](/url 'title')\n[link](/url (title))" ==->- "<p><a href=\"/url\" title=\"title\">link</a>\n<a href=\"/url\" title=\"title\">link</a>\n<a href=\"/url\" title=\"title\">link</a></p>\n"+ "[link](/url \"title\")\n[link](/url 'title')\n[link](/url (title))" ##->+ p_ (do+ a_ [href_ "/url",title_ "title"] "link"+ "\n"+ a_ [href_ "/url",title_ "title"] "link"+ "\n"+ a_ [href_ "/url",title_ "title"] "link"+ ) it "CM477" $- "[link](/url \"title \\\""\")\n" ==->- "<p><a href=\"/url\" title=\"title ""\">link</a></p>\n"+ "[link](/url \"title \\\""\")\n" ##->+ p_ (a_ [href_ "/url",title_ "title \"\""] "link") it "CM478" $ let s = "[link](/url \"title\")" in s ~-> err 11 (utok ' ' <> euric <> euri)@@ -1362,11 +1374,11 @@ let s = "[link](/url \"title \"and\" title\")\n" 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"+ "[link](/url 'title \"and\" title')" ##->+ p_ (a_ [href_ "/url",title_ "title \"and\" title"] "link") it "CM481" $- "[link]( /uri\n \"title\" )" ==->- "<p><a href=\"/uri\" title=\"title\">link</a></p>\n"+ "[link]( /uri\n \"title\" )" ##->+ p_ (a_ [href_ "/uri",title_ "title"] "link") it "CM482" $ let s = "[link] (/uri)\n" in s ~-> errFancy 1 (couldNotMatchRef "link" [])@@ -1416,8 +1428,8 @@ "[foo<http://example.com/?search=](uri)>" ==-> "<p><a href=\"uri\">foo<http://example.com/?search=</a>></p>\n" it "CM498" $- "[foo][bar]\n\n[bar]: /url \"title\"" ==->- "<p><a href=\"/url\" title=\"title\">foo</a></p>\n"+ "[foo][bar]\n\n[bar]: /url \"title\"" ##->+ p_ (a_ [href_ "/url",title_ "title"] "foo") it "CM499" $ let s = "[link [foo [bar]]][ref]\n\n[ref]: /uri" in s ~-> err 6 (utok '[' <> etok ']' <> eic)@@ -1452,8 +1464,8 @@ "[foo<http://example.com/?search=][ref]>\n\n[ref]: /uri" ==-> "<p><a href=\"/uri\">foo<http://example.com/?search=</a>></p>\n" it "CM510" $- "[foo][BaR]\n\n[bar]: /url \"title\"" ==->- "<p><a href=\"/url\" title=\"title\">foo</a></p>\n"+ "[foo][BaR]\n\n[bar]: /url \"title\"" ##->+ p_ (a_ [href_ "/url",title_ "title"] "foo") it "CM511" $ "[Толпой][Толпой] is a Russian word.\n\n[ТОЛПОЙ]: /url" ==-> "<p><a href=\"/url\">Толпой</a> is a Russian word.</p>\n"@@ -1506,20 +1518,20 @@ [ errFancy 1 (couldNotMatchRef "" []) , errFancy 7 (couldNotMatchRef "" []) ] it "CM524" $- "[foo][]\n\n[foo]: /url \"title\"" ==->- "<p><a href=\"/url\" title=\"title\">foo</a></p>\n"+ "[foo][]\n\n[foo]: /url \"title\"" ##->+ p_ (a_ [href_ "/url",title_ "title"] "foo") it "CM525" $ let s = "[*foo* bar][]\n\n[*foo* bar]: /url \"title\"" 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"+ "[Foo][]\n\n[foo]: /url \"title\"" ##->+ p_ (a_ [href_ "/url",title_ "title"] "Foo") it "CM527" $ let s = "[foo] \n[]\n\n[foo]: /url \"title\"" in s ~-> err 8 (utok ']' <> eic) it "CM528" $- "[foo]\n\n[foo]: /url \"title\"" ==->- "<p><a href=\"/url\" title=\"title\">foo</a></p>\n"+ "[foo]\n\n[foo]: /url \"title\"" ##->+ p_ (a_ [href_ "/url",title_ "title"] "foo") it "CM529" $ let s = "[*foo* bar]\n\n[*foo* bar]: /url \"title\"" in s ~-> errFancy 1 (couldNotMatchRef "foo bar" ["*foo* bar"])@@ -1530,8 +1542,8 @@ let s = "[[bar [foo]\n\n[foo]: /url" in s ~-> err 1 (utok '[' <> eic) it "CM532" $- "[Foo]\n\n[foo]: /url \"title\"" ==->- "<p><a href=\"/url\" title=\"title\">Foo</a></p>\n"+ "[Foo]\n\n[foo]: /url \"title\"" ##->+ p_ (a_ [href_ "/url", title_ "title"] "Foo") it "CM533" $ "[foo] bar\n\n[foo]: /url" ==-> "<p><a href=\"/url\">foo</a> bar</p>\n"@@ -1629,8 +1641,10 @@ "!\\[foo\\]\n\n[foo]: /url \"title\"" ==-> "<p>![foo]</p>\n" it "CM564" $- "\\![foo]\n\n[foo]: /url \"title\"" ==->- "<p>!<a href=\"/url\" title=\"title\">foo</a></p>\n"+ "\\![foo]\n\n[foo]: /url \"title\"" ##->+ p_ (do+ "!"+ a_ [href_ "/url",title_ "title"] "foo") context "6.7 Autolinks" $ do it "CM565" $ "<http://foo.bar.baz>" ==->@@ -1966,15 +1980,20 @@ MMark.projectYaml doc `shouldBe` Nothing context "when document contains a YAML section" $ do context "when it is valid" $ do+#ifdef ghcjs_HOST_OS+ let r = object []+#else let r = object [ "x" .= Number 100 , "y" .= Number 200 ]+#endif it "returns the YAML section (1)" $ do doc <- mkDoc "---\nx: 100\ny: 200\n---\nHere we go." MMark.projectYaml doc `shouldBe` Just r it "returns the YAML section (2)" $ do doc <- mkDoc "---\nx: 100\ny: 200\n---\n\n" MMark.projectYaml doc `shouldBe` Just r+#ifndef ghcjs_HOST_OS context "when it is invalid" $ do let mappingErr = fancy . ErrorCustom . YamlParseError $ "mapping values are not allowed in this context"@@ -1987,6 +2006,7 @@ [ errFancy 15 mappingErr , err 33 (ueib <> etok '*' <> eic) ]+#endif ---------------------------------------------------------------------------- -- Testing extensions