packages feed

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 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 #-}