commonmark-extensions 0.2.0.4 → 0.2.1

raw patch · 14 files changed

+359/−29 lines, 14 filesdep +filepathdep +network-uridep +tasty-benchdep −QuickCheckdep −bytestringdep −criteriondep ~commonmarkPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath, network-uri, tasty-bench

Dependencies removed: QuickCheck, bytestring, criterion, tasty-quickcheck

Dependency ranges changed: commonmark

API changes (from Hackage documentation)

Files

• README.md +4/−0
• benchmark/benchmark.hs +2/−2
• changelog.md +8/−0
• commonmark-extensions.cabal +20/−13
• src/Commonmark/Extensions.hs +4/−0
• src/Commonmark/Extensions/ImplicitHeadingReferences.hs +2/−1
• src/Commonmark/Extensions/RebaseRelativePaths.hs +135/−0
• src/Commonmark/Extensions/Wikilinks.hs +65/−0
• test/attributes.md +10/−10
• test/bracketed_spans.md +1/−1
• test/rebase_relative_paths.md +13/−0
• test/test-commonmark-extensions.hs +29/−2
• test/wikilinks_title_after_pipe.md +33/−0
• test/wikilinks_title_before_pipe.md +33/−0

@@ -25,6 +25,8 @@ - [`auto_identifiers`] (automatic generation of identifiers for headings) - [`auto_identifiers_ascii`] (automatic generation of ASCII identifiers for headings) - [`implicit_heading_references`] (headings implicitly define link references)+- [`wikilinks_title_before_pipe`] and+  [`wikilinks_title_after_pipe`] (wikilink syntax)  [`pipe_tables`]: test/pipe_tables.md [`hard_line_breaks`]: test/hard_line_breaks.md@@ -46,4 +48,6 @@ [`auto_identifiers`]: test/auto_identifiers.md [`auto_identifiers_ascii`]: test/auto_identifiers_ascii.md [`implicit_heading_references`]: test/implicit_heading_references.md+[`wikilinks_title_before_pipe`]: test/wikilinks_title_before_pipe.md+[`wikilinks_title_after_pipe`]: test/wikilinks_title_before_pipe.md 

@@ -1,7 +1,7 @@ {-# LANGUAGE CPP                 #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}-import Criterion.Main+import Test.Tasty.Bench import Data.Text (Text) import Data.Functor.Identity  -- base >= 4.8 import Commonmark@@ -15,7 +15,7 @@ main :: IO () main = do   sample <- T.replicate 10 <$> TIO.readFile "benchmark/sample.md"-  defaultMainWith defaultConfig+  defaultMain     [ benchCommonmark (smartPunctuationSpec <> defaultSyntaxSpec)         ("commonmark +smart", sample)     , benchCommonmark (autolinkSpec <> defaultSyntaxSpec)

@@ -1,5 +1,13 @@ # Changelog for commonmark-extensions +## 0.2.1++- Add `rebase_relative_paths` extension.+  New exported module Commonmark.Extensions.RebaseRelativePaths [API change].+- Add `wikilinks_title_before_pipe` and `wikilinks_title_after_pipe`+  extensions (#69).+  New exported module Commonmark.Extensions.Wikilinks [API change].+ ## 0.2.0.4  - Add a test for autolinks (#66).

@@ -1,5 +1,5 @@ name:           commonmark-extensions-version:        0.2.0.4+version:        0.2.1 synopsis:       Pure Haskell commonmark parser. description:    This library provides some useful extensions to core commonmark@@ -11,7 +11,7 @@ bug-reports:    https://github.com/jgm/commonmark-hs/issues author:         John MacFarlane maintainer:     jgm@berkeley.edu-copyright:      2018-2020 John MacFarlane+copyright:      2018-2021 John MacFarlane license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -28,6 +28,8 @@     test/implicit_heading_references.md     test/pipe_tables.md     test/attributes.md+    test/wikilinks_title_before_pipe.md+    test/wikilinks_title_after_pipe.md     test/raw_attribute.md     test/fenced_divs.md     test/bracketed_spans.md@@ -35,6 +37,7 @@     test/math.md     test/emoji.md     test/smart.md+    test/rebase_relative_paths.md     test/strikethrough.md     test/superscript.md     test/subscript.md@@ -51,11 +54,12 @@   build-depends:       base >= 4.9 && <5     , text-    , bytestring+    , parsec     , containers     , transformers-    , parsec-    , commonmark >= 0.1.1.2 && < 0.2+    , filepath+    , network-uri+    , commonmark >= 0.2 && < 0.3     -- for extensions:     , emojis >= 0.1 && < 0.2   exposed-modules:@@ -76,7 +80,11 @@       Commonmark.Extensions.FancyList       Commonmark.Extensions.TaskList       Commonmark.Extensions.ImplicitHeadingReferences+      Commonmark.Extensions.RebaseRelativePaths+      Commonmark.Extensions.Wikilinks   ghc-options: -Wall -fno-warn-unused-do-bind -funbox-small-strict-fields+  if impl(ghc >= 8.10)+    ghc-options:      -Wunused-packages   if impl(ghc >= 8.8)     ghc-options:  -fwrite-ide-info -hiedir=.hie   default-language: Haskell2010@@ -86,16 +94,16 @@   main-is: test-commonmark-extensions.hs   hs-source-dirs:       test+  if impl(ghc >= 8.10)+    ghc-options:      -Wunused-packages   ghc-options: -threaded -rtsopts -with-rtsopts=-K40K   build-depends:       base >= 4.9 && <5-    , commonmark+    , commonmark >= 0.2 && < 0.3     , commonmark-extensions     , text     , tasty-    , tasty-quickcheck     , tasty-hunit-    , QuickCheck     , parsec   default-language: Haskell2010 @@ -104,13 +112,12 @@   main-is:         benchmark.hs   hs-source-dirs:  benchmark   build-depends:-       commonmark >= 0.1.1.2 && < 0.2+       commonmark >= 0.2 && < 0.3      , commonmark-extensions      , base >= 4.9 && < 5      , text-     , transformers-     , containers-     , bytestring-     , criterion >= 1.0 && < 1.6+     , tasty-bench+  if impl(ghc >= 8.10)+    ghc-options:      -Wunused-packages   ghc-options: -threaded -rtsopts -with-rtsopts=-K10K   default-language: Haskell2010

@@ -39,6 +39,8 @@     , module Commonmark.Extensions.FancyList     , module Commonmark.Extensions.TaskList     , module Commonmark.Extensions.ImplicitHeadingReferences+    , module Commonmark.Extensions.Wikilinks+    , module Commonmark.Extensions.RebaseRelativePaths     , gfmExtensions     ) where @@ -58,6 +60,8 @@ import           Commonmark.Extensions.FancyList import           Commonmark.Extensions.TaskList import           Commonmark.Extensions.ImplicitHeadingReferences+import           Commonmark.Extensions.Wikilinks+import           Commonmark.Extensions.RebaseRelativePaths import           Commonmark #if !MIN_VERSION_base(4,11,0) import           Data.Monoid ((<>))

@@ -51,6 +51,7 @@           referenceMap = insertReference lab             LinkInfo{ linkDestination = "#" <> ident                     , linkTitle = mempty-                    , linkAttributes = mempty }+                    , linkAttributes = mempty+                    , linkPos = Nothing }             (referenceMap s) }   | otherwise = return ()

@@ -0,0 +1,135 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.RebaseRelativePaths+  ( rebaseRelativePathsSpec )+where+import Commonmark.Types+import Commonmark.Syntax+import Commonmark.Inlines+import Data.Text (Text)+import qualified Data.Text as T+import Data.Maybe (fromMaybe)+import Text.Parsec (getPosition)+import Text.Parsec.Pos (sourceName)+import System.FilePath+import Network.URI (URI (uriScheme), parseURI)+import qualified Data.Set as Set+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup(..))+#endif++rebaseRelativePathsSpec+  :: forall m bl il . (Monad m , IsInline il , IsBlock il bl)+  => SyntaxSpec m il bl+rebaseRelativePathsSpec =+  defaultSyntaxSpec {+     syntaxBracketedSpecs = [rebasedImageSpec, rebasedLinkSpec] }++ where++  rebasedImageSpec :: BracketedSpec il+  rebasedImageSpec =BracketedSpec+            { bracketedName = "Image"+            , bracketedNests = True+            , bracketedPrefix = Just '!'+            , bracketedSuffixEnd = Just ')'+            , bracketedSuffix = newImageSuffix+            }++  rebasedLinkSpec :: BracketedSpec il+  rebasedLinkSpec = BracketedSpec+           { bracketedName = "Link"+           , bracketedNests = False  -- links don't nest inside links+           , bracketedPrefix = Nothing+           , bracketedSuffixEnd = Just ')'+           , bracketedSuffix = newLinkSuffix+           }++  newImageSuffix rm key = do+    pos <- getPosition+    LinkInfo target title attrs mbpos <- pLink rm key+    let pos' = fromMaybe pos mbpos+    return $! addAttributes attrs . image (rebasePath pos' target) title++  newLinkSuffix rm key = do+    pos <- getPosition+    LinkInfo target title attrs mbpos <- pLink rm key+    let pos' = fromMaybe pos mbpos+    return $! addAttributes attrs . link (rebasePath pos' target) title++-- | Rebase a relative path, by adding the (relative) directory+-- of the containing source position.  Absolute links and URLs+-- are untouched.+rebasePath :: SourcePos -> Text -> Text+rebasePath pos path = do+  let fp = sourceName pos+      isFragment = T.take 1 path == "#"+   in if T.null path || isFragment || isAbsolute (T.unpack path) || isURI path+         then path+         else+           case takeDirectory fp of+             ""  -> path+             "." -> path+             d   -> T.pack d <> "/" <> path++-- | Schemes from http://www.iana.org/assignments/uri-schemes.html plus+-- the unofficial schemes doi, javascript, isbn, pmid.+schemes :: Set.Set T.Text+schemes = Set.fromList+  -- Official IANA schemes+  [ "aaa", "aaas", "about", "acap", "acct", "acr", "adiumxtra", "afp", "afs"+  , "aim", "appdata", "apt", "attachment", "aw", "barion", "beshare", "bitcoin"+  , "blob", "bolo", "browserext", "callto", "cap", "chrome", "chrome-extension"+  , "cid", "coap", "coaps", "com-eventbrite-attendee", "content", "crid", "cvs"+  , "data", "dav", "dict", "dis", "dlna-playcontainer", "dlna-playsingle"+  , "dns", "dntp", "dtn", "dvb", "ed2k", "example", "facetime", "fax", "feed"+  , "feedready", "file", "filesystem", "finger", "fish", "ftp", "geo", "gg"+  , "git", "gizmoproject", "go", "gopher", "graph", "gtalk", "h323", "ham"+  , "hcp", "http", "https", "hxxp", "hxxps", "hydrazone", "iax", "icap", "icon"+  , "im", "imap", "info", "iotdisco", "ipn", "ipp", "ipps", "irc", "irc6"+  , "ircs", "iris", "iris.beep", "iris.lwz", "iris.xpc", "iris.xpcs"+  , "isostore", "itms", "jabber", "jar", "jms", "keyparc", "lastfm", "ldap"+  , "ldaps", "lvlt", "magnet", "mailserver", "mailto", "maps", "market"+  , "message", "mid", "mms", "modem", "mongodb", "moz", "ms-access"+  , "ms-browser-extension", "ms-drive-to", "ms-enrollment", "ms-excel"+  , "ms-gamebarservices", "ms-getoffice", "ms-help", "ms-infopath"+  , "ms-media-stream-id", "ms-officeapp", "ms-project", "ms-powerpoint"+  , "ms-publisher", "ms-search-repair", "ms-secondary-screen-controller"+  , "ms-secondary-screen-setup", "ms-settings", "ms-settings-airplanemode"+  , "ms-settings-bluetooth", "ms-settings-camera", "ms-settings-cellular"+  , "ms-settings-cloudstorage", "ms-settings-connectabledevices"+  , "ms-settings-displays-topology", "ms-settings-emailandaccounts"+  , "ms-settings-language", "ms-settings-location", "ms-settings-lock"+  , "ms-settings-nfctransactions", "ms-settings-notifications"+  , "ms-settings-power", "ms-settings-privacy", "ms-settings-proximity"+  , "ms-settings-screenrotation", "ms-settings-wifi", "ms-settings-workplace"+  , "ms-spd", "ms-sttoverlay", "ms-transit-to", "ms-virtualtouchpad"+  , "ms-visio", "ms-walk-to", "ms-whiteboard", "ms-whiteboard-cmd", "ms-word"+  , "msnim", "msrp", "msrps", "mtqp", "mumble", "mupdate", "mvn", "news", "nfs"+  , "ni", "nih", "nntp", "notes", "ocf", "oid", "onenote", "onenote-cmd"+  , "opaquelocktoken", "pack", "palm", "paparazzi", "pkcs11", "platform", "pop"+  , "pres", "prospero", "proxy", "pwid", "psyc", "qb", "query", "redis"+  , "rediss", "reload", "res", "resource", "rmi", "rsync", "rtmfp", "rtmp"+  , "rtsp", "rtsps", "rtspu", "secondlife", "service", "session", "sftp", "sgn"+  , "shttp", "sieve", "sip", "sips", "skype", "smb", "sms", "smtp", "snews"+  , "snmp", "soap.beep", "soap.beeps", "soldat", "spotify", "ssh", "steam"+  , "stun", "stuns", "submit", "svn", "tag", "teamspeak", "tel", "teliaeid"+  , "telnet", "tftp", "things", "thismessage", "tip", "tn3270", "tool", "turn"+  , "turns", "tv", "udp", "unreal", "urn", "ut2004", "v-event", "vemmi"+  , "ventrilo", "videotex", "vnc", "view-source", "wais", "webcal", "wpid"+  , "ws", "wss", "wtai", "wyciwyg", "xcon", "xcon-userid", "xfire"+  , "xmlrpc.beep", "xmlrpc.beeps", "xmpp", "xri", "ymsgr", "z39.50", "z39.50r"+  , "z39.50s"+  -- Unofficial schemes+  , "doi", "isbn", "javascript", "pmid"+  ]++-- | Check if the string is a valid URL with a IANA or frequently used but+-- unofficial scheme (see @schemes@).+isURI :: T.Text -> Bool+isURI = maybe False hasKnownScheme . parseURI . T.unpack+  where+    hasKnownScheme = (`Set.member` schemes) . T.toLower .+                     T.filter (/= ':') . T.pack . uriScheme

@@ -0,0 +1,65 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Commonmark.Extensions.Wikilinks+  ( wikilinksSpec+  , TitlePosition(..)+  , HasWikilinks(..)+  )+where+import Commonmark.Types+import Commonmark.Tokens+import Commonmark.Syntax+import Commonmark.SourceMap+import Commonmark.TokParsers+import Commonmark.Html+import Text.Parsec+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup hiding (option)+#endif+import Data.Text (Text, strip)++class HasWikilinks il where+  wikilink :: Text -> il -> il++instance Rangeable (Html a) => HasWikilinks (Html a) where+  wikilink url il = link url "wikilink" il++instance (HasWikilinks il, Semigroup il, Monoid il)+        => HasWikilinks (WithSourceMap il) where+  wikilink url il = (wikilink url <$> il) <* addName "wikilink"++-- | Determines whether @[[foo|bar]]@ is a link to page @bar@+-- with title (description) @foo@ ('TitleBeforePipe'), as in+-- GitHub wikis, or a link to page @foo@ with title @bar@+-- ('TitleAfterPipe'), as in Obsidian and Foam.+data TitlePosition = TitleBeforePipe | TitleAfterPipe+  deriving (Show, Eq)++wikilinksSpec :: (Monad m, IsInline il, HasWikilinks il)+              => TitlePosition+              -> SyntaxSpec m il bl+wikilinksSpec titlepos = mempty+  { syntaxInlineParsers = [ pWikilink ]+  }+  where+   pWikilink = do+     symbol '['+     symbol '['+     notFollowedBy (symbol '[')+     toks <- many (satisfyTok (not . hasType (Symbol ']')))+     let isPipe (Tok (Symbol '|') _ _) = True+         isPipe _ = False+     let (title, url) =+           case break isPipe toks of+              (xs, [])   -> (untokenize xs, untokenize xs)+              (xs, _:ys) ->+                case titlepos of+                  TitleBeforePipe -> (untokenize xs, untokenize ys)+                  TitleAfterPipe  -> (untokenize ys, untokenize xs)+     symbol ']'+     symbol ']'+     return $ wikilink (strip url) (str (strip title))

@@ -19,14 +19,14 @@ ```````````````````````````````` example # Heading {#ident .class key="value value" key2=value2} .-<h1 id="ident" class="class" key="value value" key2="value2">Heading</h1>+<h1 id="ident" class="class" data-key="value value" data-key2="value2">Heading</h1> ````````````````````````````````  ```````````````````````````````` example Heading {#ident .class key="value"} ===== .-<h1 id="ident" class="class" key="value">Heading</h1>+<h1 id="ident" class="class" data-key="value">Heading</h1> ````````````````````````````````  Whitespace is tolerated around the delimiters:@@ -34,7 +34,7 @@ ```````````````````````````````` example # Heading {  #ident  .class key="value" } .-<h1 id="ident" class="class" key="value">Heading</h1>+<h1 id="ident" class="class" data-key="value">Heading</h1> ````````````````````````````````  Multiple class attributes are combined:@@ -82,7 +82,7 @@ xyz ``` .-<pre id="ident" class="class" key="value value" key2="value2"><code>xyz+<pre id="ident" class="class" data-key="value value" data-key2="value2"><code>xyz </code></pre> ```````````````````````````````` @@ -127,13 +127,13 @@ ```````````````````````````````` example `hi`{#ident .class key=value} .-<p><code id="ident" class="class" key="value">hi</code></p>+<p><code id="ident" class="class" data-key="value">hi</code></p> ````````````````````````````````  ```````````````````````````````` example `hi` {#ident .class key=value} .-<p><code>hi</code><span id="ident" class="class" key="value"> </span></p>+<p><code>hi</code><span id="ident" class="class" data-key="value"> </span></p> ````````````````````````````````  The attributes can wrap:@@ -142,7 +142,7 @@ `hi`{#ident .class key=value} .-<p><code id="ident" class="class" key="value">hi</code></p>+<p><code id="ident" class="class" data-key="value">hi</code></p> ````````````````````````````````  **Attributes that occur immediately before a block@@ -195,7 +195,7 @@ {.class2 .class3 k=2} # Heading {.class4} .-<h1 class="class1 class2 class3 class4" k="2">Heading</h1>+<h1 class="class1 class2 class3 class4" data-k="2">Heading</h1> ````````````````````````````````  @@ -217,7 +217,7 @@ ```````````````````````````````` example [foo](bar){#ident .class key="value value" key2=value2} .-<p><a id="ident" class="class" key="value value" key2="value2" href="bar">foo</a></p>+<p><a id="ident" class="class" data-key="value value" data-key2="value2" href="bar">foo</a></p> ````````````````````````````````  ```````````````````````````````` example@@ -262,5 +262,5 @@ ```````````````````````````````` example # Heading {key="v&#97;lue" } .-<h1 key="value">Heading</h1>+<h1 data-key="value">Heading</h1> ````````````````````````````````

@@ -4,7 +4,7 @@ ```````````````````````````````` example [foo]{#ident .class key="value value" key2=value2} .-<p><span id="ident" class="class" key="value value" key2="value2">foo</span></p>+<p><span id="ident" class="class" data-key="value value" data-key2="value2">foo</span></p> ````````````````````````````````  ```````````````````````````````` example

@@ -0,0 +1,13 @@+## Rebase relative paths++This extension causes relative paths in images and links to be+rebased to the (relative) directory of the containing file.+For example, if the source file is `foo/test.md` and contains+an image `![image](img.jpg)`, the image path will be rewritten+to `foo/img.jpg`.  Absolute paths, absolute URLs, empty paths,+and paths that are purely fragments (i.e., start with `#`) are+left unchanged.++This feature facilitates converting documents that are split+into multiple files in different directories.+

@@ -50,8 +50,10 @@              , ("test/auto_identifiers.md", autoIdentifiersSpec <> attributesSpec)              , ("test/implicit_heading_references.md",                  autoIdentifiersSpec <> attributesSpec <> implicitHeadingReferencesSpec)+             , ("test/wikilinks_title_before_pipe.md", wikilinksSpec TitleBeforePipe)+             , ("test/wikilinks_title_after_pipe.md", wikilinksSpec TitleAfterPipe)              ]-  defaultMain $ testGroup "Tests" tests+  defaultMain $ testGroup "Tests" (tests ++ [rebaseRelativePathTests])  getSpecTestTree :: FilePath                 -> SyntaxSpec Identity (Html ()) (Html ())@@ -144,4 +146,29 @@   when ("#" `T.isPrefixOf` t) $ updateState $ \(_secname, exampnum) ->            (T.strip $ T.dropWhile (=='#') t, exampnum) ----+rebaseRelativePathTests :: TestTree+rebaseRelativePathTests = do+  let parser = runIdentity . parseCommonmarkWith+                   (rebaseRelativePathsSpec <> defaultSyntaxSpec)+  let md = T.unlines+            [ "![image](foo.jpg)"+            , "[link](http://example.com/foo.jpg)"+            , "![image]()"+            , "[link](#foobar)"+            , "![image][ref]"+            , ""+            ]+  let mdref = "[ref]: baz.png"+  let toks = tokenize "chap1/text.md" md ++ tokenize "extra/refs.md" mdref+  let actual = normalizeHtml .  TL.toStrict . renderHtml .+                  fromRight mempty $ (parser toks+                       :: Either ParseError (Html ()))+  let expected = T.unlines+                 [ "<p><img src=\"chap1/foo.jpg\" alt=\"image\" />"+                 , "<a href=\"http://example.com/foo.jpg\">link</a>"+                 , "<img src=\"\" alt=\"image\" />"+                 , "<a href=\"#foobar\">link</a>"+                 , "<img src=\"extra/baz.png\" alt=\"image\" /></p>"+                 ]+  testCase "rebase_relative_paths" (actual @?= expected)+

@@ -0,0 +1,33 @@+Wikilinks can have one of the following forms:++    [[https://example.org]]+    [[https://example.org|title]]+    [[name of page]]+    [[name of page|title]]++With this version of wikilinks, the title comes after the pipe.++```````````````````````````````` example+[[https://example.org]]+.+<p><a href="https://example.org" title="wikilink">https://example.org</a></p>+````````````````````````````````++```````````````````````````````` example+[[https://example.org|title]]+.+<p><a href="https://example.org" title="wikilink">title</a></p>+````````````````````````````````++```````````````````````````````` example+[[Name of page]]+.+<p><a href="Name%20of%20page" title="wikilink">Name of page</a></p>+````````````````````````````````++```````````````````````````````` example+[[Name of page|Title]]+.+<p><a href="Name%20of%20page" title="wikilink">Title</a></p>+````````````````````````````````+

@@ -0,0 +1,33 @@+Wikilinks can have one of the following forms:++    [[https://example.org]]+    [[title|https://example.org]]+    [[name of page]]+    [[title|name of page]]++With this version of wikilinks, the title comes before the pipe.++```````````````````````````````` example+[[https://example.org]]+.+<p><a href="https://example.org" title="wikilink">https://example.org</a></p>+````````````````````````````````++```````````````````````````````` example+[[title|https://example.org]]+.+<p><a href="https://example.org" title="wikilink">title</a></p>+````````````````````````````````++```````````````````````````````` example+[[Name of page]]+.+<p><a href="Name%20of%20page" title="wikilink">Name of page</a></p>+````````````````````````````````++```````````````````````````````` example+[[Title|Name of page]]+.+<p><a href="Name%20of%20page" title="wikilink">Title</a></p>+````````````````````````````````+