commonmark-wikilink 0.1.0.0 → 0.2.0.0
raw patch · 4 files changed
+116/−8 lines, 4 filesdep +commonmark-simpledep +commonmark-wikilinkdep +hspecdep ~basedep ~reludePVP ok
version bump matches the API change (PVP)
Dependencies added: commonmark-simple, commonmark-wikilink, hspec
Dependency ranges changed: base, relude
API changes (from Hackage documentation)
- Commonmark.Extensions.WikiLink: wikilinkSpec :: (Monad m, IsInline il, HasWikiLink il) => SyntaxSpec m il bl
+ Commonmark.Extensions.WikiLink: wikilinkSpec :: forall (m :: Type -> Type) il bl. (Monad m, IsInline il, HasWikiLink il) => SyntaxSpec m il bl
Files
- commonmark-wikilink.cabal +24/−3
- src/Commonmark/Extensions/WikiLink.hs +36/−5
- test/Commonmark/Extensions/WikiLinkSpec.hs +55/−0
- test/Spec.hs +1/−0
commonmark-wikilink.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: commonmark-wikilink-version: 0.1.0.0+version: 0.2.0.0 license: MIT copyright: 2022 Sridhar Ratnakumar maintainer: srid@srid.ca@@ -13,6 +13,10 @@ LICENSE README.md +flag ghcid+ default: False+ manual: True+ common shared ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns@@ -25,7 +29,6 @@ relude default-extensions:- NoStarIsType BangPatterns ConstraintKinds DataKinds@@ -51,6 +54,7 @@ LambdaCase MultiParamTypeClasses MultiWayIf+ NoStarIsType NumericUnderscores OverloadedStrings PolyKinds@@ -67,7 +71,7 @@ build-depends: , aeson- , base >=4.13.0.0 && <4.18.0.0.0+ , base >=4.13.0.0 && <5 , commonmark , commonmark-pandoc , megaparsec@@ -84,3 +88,20 @@ library import: shared exposed-modules: Commonmark.Extensions.WikiLink++test-suite test+ import: shared+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends:+ , commonmark-simple+ , hspec+ , relude++ if flag(ghcid)+ hs-source-dirs: src++ else+ build-depends: commonmark-wikilink+ other-modules: Commonmark.Extensions.WikiLinkSpec
src/Commonmark/Extensions/WikiLink.hs view
@@ -154,7 +154,7 @@ All possible combinations of Wikilink type use is automatically included. -}-allowedWikiLinks :: HasCallStack => NonEmpty Slug -> NonEmpty (WikiLinkType, WikiLink)+allowedWikiLinks :: (HasCallStack) => NonEmpty Slug -> NonEmpty (WikiLinkType, WikiLink) allowedWikiLinks slugs = let wls = WikiLink <$> tailsNE slugs typs :: NonEmpty WikiLinkType = NE.fromList universe@@ -248,7 +248,7 @@ replicateM_ 2 $ CT.symbol ']' return $ wikilink typ wl (fmap CM.str title) satisfyNoneOf toks =- CT.satisfyTok $ \t -> not $ or $ toks <&> \tok -> tok t+ CT.satisfyTok $ \t -> not $ any (\tok -> tok t) toks isAnchor = isSymbol '#' isPipe =@@ -263,12 +263,41 @@ TODO: extend on top of plainify from heist-extra -} plainify :: [B.Inline] -> Text-plainify = W.query $ \case+plainify = plainify' . W.walk (deleteConsequentSpaces True . concatMap preprocess)+ where+ preprocess :: B.Inline -> [B.Inline]+ preprocess = \case+ -- Remove footnotes+ B.Note {} -> []+ -- Expand quotes (W.query can't deal with them without repetition)+ B.Quoted qt x ->+ case qt of+ B.SingleQuote -> [B.Str "‘"] <> x <> [B.Str "’"]+ B.DoubleQuote -> [B.Str "“"] <> x <> [B.Str "”"]+ -- Erase strikeouts+ B.Strikeout _ -> []+ a -> one a+ -- The strikeout erasing can lead to subsequent B.Space's; remove them+ deleteConsequentSpaces :: Bool -> [B.Inline] -> [B.Inline]+ deleteConsequentSpaces keepFirst = \case+ B.Space : B.Space : xs ->+ let rest = deleteConsequentSpaces False xs+ in if keepFirst then B.Space : rest else rest+ x : xs -> x : deleteConsequentSpaces keepFirst xs+ [] -> []++plainify' :: [B.Inline] -> Text+plainify' = W.query $ \case B.Str x -> x B.Code _attr x -> x B.Space -> " " B.SoftBreak -> " " B.LineBreak -> " "+ B.Quoted qt x ->+ let s = plainify' x+ in case qt of+ B.SingleQuote -> "'" <> s <> "'"+ B.DoubleQuote -> "\"" <> s <> "\"" -- TODO: if fmt is html, we should strip the html tags B.RawInline _fmt s -> s -- Ignore "wrapper" inlines like span.@@ -279,8 +308,10 @@ -- human-readable representation) (mkWikiLinkFromInline -> Just (wl, customText)) -> if null customText- then show wl -- We will display raw wikilink; ideally, though, we want to display the title.- else plainify customText+ then -- We will display raw wikilink; ideally, though, we want to display the title.+ show wl+ else -- Because `W.query` will walk the child nodes once again, so we don't have to do anything.+ "" -- Ignore the rest of AST nodes, as they are recursively defined in terms of -- `Inline` which `W.query` will traverse again. _ -> ""
+ test/Commonmark/Extensions/WikiLinkSpec.hs view
@@ -0,0 +1,55 @@+module Commonmark.Extensions.WikiLinkSpec where++import Commonmark.Extensions.WikiLink+import Commonmark.Simple+import Test.Hspec+import Text.Pandoc.Definition++spec :: Spec+spec = do+ describe "commonmark-wikilink" $ do+ it "basic" $ do+ let res = snd <$> parseMarkdownWithFrontMatter @Text fullMarkdownSpec "<fp>" "Hello [[World]]."+ expected = Pandoc mempty [Para [Str "Hello", Space, Str "[[World]]."]]+ res `shouldBe` Right expected+ it "wikilink-parsing" $ do+ let res = snd <$> parseMarkdownWithFrontMatter @Text (fullMarkdownSpec <> wikilinkSpec) "<fp>" "Hello [[World]]."+ expected =+ Pandoc+ mempty+ [ Para+ [ Str "Hello"+ , Space+ , Link ("", [], [("data-wikilink-type", "WikiLinkNormal")]) [] ("World", "")+ , Str "."+ ]+ ]+ res `shouldBe` Right expected+ describe "plainify" $ do+ it "basic" $ do+ plainify <$> parseMdPara1 "Hello" `shouldBe` Right "Hello"+ it "with space" $ do+ plainify <$> parseMdPara1 "Hello World" `shouldBe` Right "Hello World"+ -- FIXME+ xit "with link" $ do+ plainify <$> parseMdPara1 "[Hello](https://example.com)" `shouldBe` Right "Hello"+ it "with wikilink" $ do+ plainify <$> parseMdPara1 "[[World]]" `shouldBe` Right "[[World]]"+ it "with footnote" $ do+ plainify <$> parseMdPara1 "Hello[^1] World.\n\n[^1]: Some footnote." `shouldBe` Right "Hello World."+ it "with quotes" $ do+ plainify <$> parseMdPara1 "Foo \"Bar\" - MySite" `shouldBe` Right "Foo “Bar” - MySite"+ it "with emoji" $ do+ plainify <$> parseMdPara1 "Emoji :writing_hand:" `shouldBe` Right "Emoji ✍️"+ it "erases strikethroughs" $ do+ plainify <$> parseMdPara1 "Hello ~~wonderful~~ world!" `shouldBe` Right "Hello world!"++-- | Parse Markdown with our wikilink parser enabled+parseMd :: Text -> Either Text Pandoc+parseMd = fmap snd . parseMarkdownWithFrontMatter @Text (fullMarkdownSpec <> wikilinkSpec) "<fp>"++-- | Like `parseMd` but get just the first paragraph+parseMdPara1 :: Text -> Either Text [Inline]+parseMdPara1 s = do+ Pandoc _ (Para inlines : _) <- parseMd s+ pure inlines
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}