mmark-ext 0.0.1.2 → 0.1.0.0

raw patch · 20 files changed

+711/−336 lines, 20 filesdep +blaze-htmldep +skylightingdep −data-default-classdep ~basedep ~mmarkPVP ok

version bump matches the API change (PVP)

Dependencies added: blaze-html, skylighting

Dependencies removed: data-default-class

Dependency ranges changed: base, mmark

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• Text/MMark/Extension/Comment.hs +38/−0
• Text/MMark/Extension/Common.hs +20/−225
• Text/MMark/Extension/FontAwesome.hs +65/−0
• Text/MMark/Extension/Kbd.hs +46/−0
• Text/MMark/Extension/LinkTarget.hs +46/−0
• Text/MMark/Extension/ObfuscateEmail.hs +61/−0
• Text/MMark/Extension/PunctuationPrettifier.hs +69/−0
• Text/MMark/Extension/Skylighting.hs +48/−0
• Text/MMark/Extension/TableOfContents.hs +90/−0
• mmark-ext.cabal +29/−10
• tests/Text/MMark/Extension/CommentSpec.hs +21/−0
• tests/Text/MMark/Extension/CommonSpec.hs +0/−101
• tests/Text/MMark/Extension/FontAwesomeSpec.hs +24/−0
• tests/Text/MMark/Extension/KbdSpec.hs +14/−0
• tests/Text/MMark/Extension/LinkTargetSpec.hs +28/−0
• tests/Text/MMark/Extension/ObfuscateEmailSpec.hs +21/−0
• tests/Text/MMark/Extension/PunctuationPrettifierSpec.hs +36/−0
• tests/Text/MMark/Extension/TableOfContentsSpec.hs +25/−0
• tests/Text/MMark/Extension/TestUtils.hs +26/−0

@@ -1,3 +1,7 @@+## MMark Ext 0.1.0.0++* This version has little in common with previous versions.+ ## MMark Ext 0.0.1.2  * Compiles with `modern-uri-0.2.0.0` and later.

@@ -0,0 +1,38 @@+-- |+-- Module      :  Text.MMark.Extension.Comment+-- Copyright   :  © 2018 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Turn paragraphs into comments by prefixing them with a certain sequence+-- of characters.++module Text.MMark.Extension.Comment+  ( commentParagraph )+where++import Control.Monad+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text)+import Text.MMark.Extension (Extension, Block (..), Inline (..))+import qualified Data.Text            as T+import qualified Text.MMark.Extension as Ext++-- | This extension removes top-level paragraphs starting with the given+-- sequence of non-markup characters.++commentParagraph+  :: Text              -- ^ Sequence of characters that starts a comment+  -> Extension+commentParagraph commentPrefix = Ext.blockRender $ \old block ->+  case block of+    p@(Paragraph (ois, _)) ->+      case Ext.getOis ois of+        (Plain txt :| _) ->+          unless (commentPrefix `T.isPrefixOf` txt) $+            old p+        _ -> old p+    other -> old other

@@ -20,7 +20,7 @@ -- > -- > module Main (main) where -- >--- > import Data.Default.Class+-- > import Skylighting (defaultFormatOpts) -- > import qualified Data.Text.IO                as T -- > import qualified Data.Text.Lazy.IO           as TL -- > import qualified Lucid                       as L@@ -34,237 +34,32 @@ -- >   case MMark.parse input txt of -- >     Left errs -> putStrLn (MMark.parseErrorsPretty txt errs) -- >     Right r ->--- >       let toc = MMark.runScanner r (Ext.tocScanner 4)+-- >       let toc = MMark.runScanner r (Ext.tocScanner (> 1)) -- >       in TL.writeFile "output.html" -- >           . L.renderText -- >           . MMark.render -- >           . MMark.useExtensions -- >               [ Ext.toc "toc" toc--- >               , Ext.punctuationPrettifier def--- >               , Ext.obfuscateEmail "protected-email"--- >               , Ext.fontAwesome ]+-- >               , Ext.punctuationPrettifier+-- >               , Ext.skylighting defaultFormatOpts ] -- >           $ r -{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE LambdaCase         #-}-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE RecordWildCards    #-}- module Text.MMark.Extension.Common-  ( -- * Table of contents-    -- $table-of-contents-    Toc-  , tocScanner-  , toc-    -- * Punctuation prettifier-  , Punctuation (..)-  , punctuationPrettifier-    -- * Email address obfuscation-  , obfuscateEmail-    -- * Font Awesome icons-  , fontAwesome )+  ( module Text.MMark.Extension.Comment+  , module Text.MMark.Extension.FontAwesome+  , module Text.MMark.Extension.Kbd+  , module Text.MMark.Extension.LinkTarget+  , module Text.MMark.Extension.ObfuscateEmail+  , module Text.MMark.Extension.PunctuationPrettifier+  , module Text.MMark.Extension.Skylighting+  , module Text.MMark.Extension.TableOfContents ) where -import Data.Data (Data)-import Data.Default.Class-import Data.List.NonEmpty (NonEmpty (..))-import Data.Maybe (maybeToList, fromJust)-import Data.Monoid ((<>))-import Data.Text (Text)-import Data.Typeable (Typeable)-import GHC.Generics-import Lens.Micro ((^.))-import Lucid-import Text.MMark-import Text.MMark.Extension (Bni, Block (..), Inline (..))-import Text.URI.Lens (uriPath)-import qualified Control.Foldl        as L-import qualified Data.List.NonEmpty   as NE-import qualified Data.Text            as T-import qualified Text.MMark.Extension as Ext-import qualified Text.URI             as URI--------------------------------------------------------------------------------- Table of contents---- $table-of-contents------ Place this markup in markdown document where you want table of contents--- to be inserted:------ > ```toc--- > ```------ You may use something different than @\"toc\"@ as the info string of the--- code block.---- | An opaque type representing table of contents produced by the--- 'tocScanner' scanner.--newtype Toc = Toc [(Int, NonEmpty Inline)]---- | The scanner builds table of contents 'Toc' that can then be passed to--- 'toc' to obtain an extension that renders the table of contents in HTML.------ __Note__: Top level header (level 1) is never added to the table of--- contents. Open an issue if you think it's not a good behavior.--tocScanner-  :: Int -- ^ Up to which level (inclusive) to collect headers? Values from-         -- 2 to 6 make sense here.-  -> L.Fold Bni Toc-tocScanner cutoff = fmap (Toc . reverse) . Ext.scanner [] $ \xs block ->-  case block of-    Heading2 x -> f 2 x xs-    Heading3 x -> f 3 x xs-    Heading4 x -> f 4 x xs-    Heading5 x -> f 5 x xs-    Heading6 x -> f 6 x xs-    _          -> xs-  where-    f n a as =-      if n > cutoff-        then as-        else (n, a) : as---- | Create an extension that replaces a certain code block with previously--- constructed table of contents.--toc-  :: Text -- ^ Label of the code block to replace by the table of contents-  -> Toc  -- ^ Previously generated by 'tocScanner'-  -> Extension-toc label (Toc xs) = Ext.blockTrans $ \case-  old@(CodeBlock mlabel _) ->-    case NE.nonEmpty xs of-      Nothing -> old-      Just ns ->-        if mlabel == pure label-          then renderToc ns-          else old-  other -> other---- | Construct 'Bni' for a table of contents from given collection of--- headers. This is a non-public helper.--renderToc :: NonEmpty (Int, NonEmpty Inline) -> Bni-renderToc = UnorderedList . NE.unfoldr f-  where-    f ((n,x) :| xs) =-      let (sitems, fitems) = span ((> n) . fst) xs-          url = Ext.headerFragment (Ext.headerId x)-      in ( Naked (Link x url Nothing :| [])-           : maybeToList (renderToc <$> NE.nonEmpty sitems)-         , NE.nonEmpty fitems )--------------------------------------------------------------------------------- Punctuation prettifier---- | Settings for the punctuation-prettifying extension.--data Punctuation = Punctuation-  { punctEnDash :: !Bool-    -- ^ Whether to replace double hyphen @--@ by an en dash @–@ (default:-    -- 'True')-  , punctEmDash :: !Bool-    -- ^ Whether to replace triple hyphen @---@ by an em dash @—@ (default:-    -- 'True')-  } deriving (Eq, Ord, Show, Read, Data, Typeable, Generic)--instance Default Punctuation where-  def = Punctuation-    { punctEnDash = True-    , punctEmDash = True }---- | Prettify punctuation according to the settings in 'Punctuation'.--punctuationPrettifier :: Punctuation -> Extension-punctuationPrettifier Punctuation {..} = Ext.inlineTrans $ \case-  Plain txt -> Plain-    . f punctEnDash (T.replace "--"  "–")-    . f punctEmDash (T.replace "---" "—")-    $ txt-  other -> other-  where-    f b g = if b then g else id--------------------------------------------------------------------------------- Email address obfuscation---- | This extension makes email addresses in links be rendered as something--- like this:------ > <a class="protected-email"--- >    data-email="something@example.org"--- >    href="javascript:void(0)">Enable JavaScript to see the email</a>------ You'll also need to include jQuery and this bit of JS code for the magic--- to work:------ > $(document).ready(function () {--- >     $(".protected-email").each(function () {--- >         var item = $(this);--- >         var email = item.data('email');--- >         item.attr('href', 'mailto:' + email);--- >         item.html(email);--- >     });--- > });--obfuscateEmail-  :: Text-     -- ^ Name of class to assign to the links, e.g. @\"protected-email\"@-  -> Extension-obfuscateEmail class' = Ext.inlineRender $ \old inline ->-  case inline of-    l@(Link _ email mtitle) ->-      if URI.uriScheme email == URI.mkScheme "mailto"-        then let txt = Plain "Enable JavaScript to see the email" :| []-                 js  = fromJust (URI.mkURI "javascript:void(0)")-             in with (old (Link txt js mtitle))-                  [ class_ class'-                  , data_ "email"-                    (URI.render email { URI.uriScheme = Nothing }) ]-        else old l-    other -> old other--------------------------------------------------------------------------------- Font Awesome icons---- | Allow to insert @span@s with font awesome icons using autolinks like--- this:------ > <fa:user>------ This @user@ identifier is the name of icon you want to insert. You can--- also control the size of the icon like this:------ > <fa:user/fw> -- fixed width--- > <fa:user/lg> -- large--- > <fa:user/2x>--- > <fa:user/3x>--- > <fa:user/4x>--- > <fa:user/5x>------ In general, all path components in this URI that go after the name of--- icon will be prefixed with @\"fa-\"@ and added as classes, so you can do--- a lot of fancy stuff, see <http://fontawesome.io/examples/>:------ > <fa:quote-left/3x/pull-left/border>------ See also: <http://fontawesome.io>.--fontAwesome :: Extension-fontAwesome = Ext.inlineRender $ \old inline ->-  case inline of-    l@(Link _ fa _) ->-      if URI.uriScheme fa == URI.mkScheme "fa"-        then case fa ^. uriPath of-               [] -> old l-               xs ->-                 let g x = "fa-" <> URI.unRText x-                 in span_-                    [ (class_ . T.intercalate " ") ("fa" : fmap g xs) ]-                    ""-        else old l-    other -> old other+import Text.MMark.Extension.Comment+import Text.MMark.Extension.FontAwesome+import Text.MMark.Extension.Kbd+import Text.MMark.Extension.LinkTarget+import Text.MMark.Extension.ObfuscateEmail+import Text.MMark.Extension.PunctuationPrettifier+import Text.MMark.Extension.Skylighting+import Text.MMark.Extension.TableOfContents

@@ -0,0 +1,65 @@+-- |+-- Module      :  Text.MMark.Extension.FontAwesome+-- Copyright   :  © 2017–2018 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Turn links into Font Awesome icons.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}++module Text.MMark.Extension.FontAwesome+  ( fontAwesome )+where++import Data.Semigroup ((<>))+import Lens.Micro ((^.))+import Lucid+import Text.MMark.Extension (Extension, Inline (..))+import Text.URI.Lens (uriPath)+import Text.URI.QQ (scheme)+import qualified Data.Text            as T+import qualified Text.MMark.Extension as Ext+import qualified Text.URI             as URI++-- | Allow to insert @span@s with font awesome icons using autolinks like+-- this:+--+-- > <fa:user>+--+-- This @user@ identifier is the name of icon you want to insert. You can+-- also control the size of the icon like this:+--+-- > <fa:user/fw> -- fixed width+-- > <fa:user/lg> -- large+-- > <fa:user/2x>+-- > <fa:user/3x>+-- > <fa:user/4x>+-- > <fa:user/5x>+--+-- In general, all path components in this URI that go after the name of+-- icon will be prefixed with @\"fa-\"@ and added as classes, so you can do+-- a lot of fancy stuff, see <http://fontawesome.io/examples/>:+--+-- > <fa:quote-left/3x/pull-left/border>+--+-- See also: <http://fontawesome.io>.++fontAwesome :: Extension+fontAwesome = Ext.inlineRender $ \old inline ->+  case inline of+    l@(Link _ uri _) ->+      if URI.uriScheme uri == Just [scheme|fa|]+        then case uri ^. uriPath of+               [] -> old l+               xs ->+                 let g x = "fa-" <> URI.unRText x+                 in span_+                    [ (class_ . T.intercalate " ") ("fa" : fmap g xs) ]+                    ""+        else old l+    other -> old other

@@ -0,0 +1,46 @@+-- |+-- Module      :  Text.MMark.Extension.Kbd+-- Copyright   :  © 2018 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Introduce @kbd@ tags into resulting HTML document by wrapping content in+-- links with URL with @kbd@ scheme.++{-# LANGUAGE QuasiQuotes #-}++module Text.MMark.Extension.Kbd+  ( kbd )+where++import Lucid+import Text.MMark.Extension (Extension, Inline (..))+import Text.URI.QQ (scheme)+import qualified Text.MMark.Extension as Ext+import qualified Text.URI             as URI++-- | Introduce @kbd@ tags into resulting HTML document by wrapping content+-- in links with URL with @kbd@ scheme.+--+-- For example:+--+-- > To enable that mode press [Ctrl+A][kbd].+-- >+-- > [kbd]: kbd:+--+-- The use of reference-style links seems more aesthetically pleasant to the+-- author, but you can of course do somethnig like this instead:+--+-- > To enable that mode press [Ctrl+A](kbd:).++kbd :: Extension+kbd = Ext.inlineRender $ \old inline ->+  case inline of+    l@(Link inner uri _) ->+      if URI.uriScheme uri == Just [scheme|kbd|]+        then kbd_ (mapM_ old inner)+        else old l+    other -> old other

@@ -0,0 +1,46 @@+-- |+-- Module      :  Text.MMark.Extension.LinkTarget+-- Copyright   :  © 2018 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Specify the @target@ attribute of links in link titles. This allows, e.g.+-- make a link open in new tab.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections     #-}++module Text.MMark.Extension.LinkTarget+  ( linkTarget )+where++import Data.Foldable (asum)+import Data.Maybe (fromMaybe)+import Lucid+import Text.MMark.Extension (Extension, Inline (..))+import qualified Data.Text            as T+import qualified Text.MMark.Extension as Ext++-- | When title of a link starts with the word @\"_blank\"@, @\"_self\"@,+-- @\"_parent\"@, or @\"_top\"@, it's stripped from title (as well as all+-- whitespace after it) and added as the value of @target@ attribute of the+-- resulting link.+--+-- For example:+--+-- > This [link](/url '_blank My title') opens in new tab.++linkTarget :: Extension+linkTarget = Ext.inlineRender $ \old inline ->+  case inline of+    l@(Link txt url (Just title)) -> fromMaybe (old l) $ do+      let f prefix = (prefix,) . T.stripStart+            <$> T.stripPrefix prefix title+      (prefix, title') <- asum $+        f <$> ["_blank", "_self", "_parent", "_top"]+      let mtitle = if T.null title' then Nothing else Just title'+      return $ with (old (Link txt url mtitle)) [target_ prefix]+    other -> old other

@@ -0,0 +1,61 @@+-- |+-- Module      :  Text.MMark.Extension.ObfuscateEmail+-- Copyright   :  © 2018 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Obfuscate email addresses.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}++module Text.MMark.Extension.ObfuscateEmail+  ( obfuscateEmail )+where++import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text)+import Lucid+import Text.MMark.Extension (Extension, Inline (..))+import Text.URI.QQ (scheme, uri)+import qualified Text.MMark.Extension as Ext+import qualified Text.URI as URI++-- | This extension makes email addresses in autolinks be rendered as+-- something like this:+--+-- > <a class="protected-email"+-- >    data-email="something@example.org"+-- >    href="javascript:void(0)">Enable JavaScript to see this email</a>+--+-- You'll also need to include jQuery and this bit of JS code for the magic+-- to work:+--+-- > $(document).ready(function () {+-- >     $(".protected-email").each(function () {+-- >         var item = $(this);+-- >         var email = item.data('email');+-- >         item.attr('href', 'mailto:' + email);+-- >         item.html(email);+-- >     });+-- > });++obfuscateEmail+  :: Text+     -- ^ Name of class to assign to the links, e.g. @\"protected-email\"@+  -> Extension+obfuscateEmail class' = Ext.inlineRender $ \old inline ->+  case inline of+    l@(Link _ email mtitle) ->+      if URI.uriScheme email == Just [scheme|mailto|]+        then let txt = Plain "Enable JavaScript to see this email" :| []+                 js  = [uri|javascript:void(0)|]+             in with (old (Link txt js mtitle))+                  [ class_ class'+                  , data_ "email"+                    (URI.render email { URI.uriScheme = Nothing }) ]+        else old l+    other -> old other

@@ -0,0 +1,69 @@+-- |+-- Module      :  Text.MMark.Extension.PunctuationPrettifier+-- Copyright   :  © 2018 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Punctuation prettifier.++{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++module Text.MMark.Extension.PunctuationPrettifier+  ( punctuationPrettifier )+where++import Data.Char (isSpace)+import Data.Text (Text)+import Text.MMark.Extension (Extension, Inline (..))+import qualified Data.Text as T+import qualified Text.MMark.Extension as Ext++-- | Prettify punctuation (only affects plain text in inlines):+--+--     * Replace @...@ with ellipsis @…@+--     * Replace @---@ with em-dash @—@+--     * Replace @--@ with en-dash @–@+--     * Replace @\"@ with left double quote @“@ when previous character was+--       a space character, otherwise replace it with right double quote @”@+--     * Replace @'@ with left single quote @‘@ when previous character was+--       a space character, otherwise replace it with right single quote @’@+--       aka apostrophe++punctuationPrettifier :: Extension+punctuationPrettifier = Ext.inlineTrans $ \case+  Plain txt -> Plain (T.unfoldr gen (True, txt))+  other     -> other++gen+  :: (Bool, Text)+     -- ^ Whether the previous character was a space and remaining input+  -> Maybe (Char, (Bool, Text))+     -- ^ Next generated char and the state+gen (s, i) =+  case T.uncons i of+    Nothing -> Nothing+    Just ('.', i') ->+      case T.splitAt 2 i' of+        ("..", i'') -> Just ('…', (False, i''))+        _           -> Just ('.', (False, i'))+    Just ('-', i') ->+      case T.splitAt 2 i' of+        ("--", i'') -> Just ('—', (False, i''))+        _ ->+          case T.splitAt 1 i' of+            ("-", i'') -> Just ('–', (False, i''))+            _          -> Just ('-', (False, i'))+    Just ('\"', i') ->+      if s -- whether previous character was a space character+        then Just ('“', (False, i'))+        else Just ('”', (False, i'))+    Just ('\'', i') ->+      if s+        then Just ('‘', (False, i'))+        else Just ('’', (False, i'))+    Just (ch, i') ->+      Just (ch, (isSpace ch, i'))

@@ -0,0 +1,48 @@+-- |+-- Module      :  Text.MMark.Extension.Skylighting+-- Copyright   :  © 2018 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Use the Skylighting library to highlight code snippets.++{-# LANGUAGE OverloadedStrings #-}++module Text.MMark.Extension.Skylighting+  ( skylighting )+where++import Lucid (toHtmlRaw)+import Text.Blaze.Html.Renderer.Text+import Text.MMark.Extension (Extension, Block (..))+import qualified Data.Text            as T+import qualified Skylighting          as S+import qualified Text.MMark.Extension as Ext++-- | Use the @skylighting@ package to render code blocks with info strings+-- that result in a successful lookup from 'S.defaultSyntaxMap'.+--+-- The resulting markup is wrapped with spans as described in the docs for+-- 'S.formatHtmlInline'.++skylighting+  :: S.FormatOptions   -- ^ Skylighting formatting options+  -> Extension+skylighting fmtOpts = Ext.blockRender $ \old block ->+  case block of+    cb@(CodeBlock (Just infoString') txt) ->+      let tokenizerConfig = S.TokenizerConfig+            { S.syntaxMap   = S.defaultSyntaxMap+            , S.traceOutput = False }+          infoString = T.replace "-" " " infoString'+      in case S.lookupSyntax infoString S.defaultSyntaxMap of+           Nothing -> old cb+           Just syntax ->+             case S.tokenize tokenizerConfig syntax txt of+               Left _ -> old cb+               Right sourceLines -> toHtmlRaw . renderHtml $+                 S.formatHtmlBlock fmtOpts sourceLines+    other -> old other

@@ -0,0 +1,90 @@+-- |+-- Module      :  Text.MMark.Extension.TableOfContents+-- Copyright   :  © 2017–2018 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Place this markup in markdown document where you want table of contents+-- to be inserted:+--+-- > ```toc+-- > ```+--+-- You may use something different than @\"toc\"@ as the info string of the+-- code block.++{-# LANGUAGE LambdaCase #-}++module Text.MMark.Extension.TableOfContents+  ( Toc+  , tocScanner+  , toc )+where++import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (maybeToList)+import Data.Text (Text)+import Text.MMark.Extension (Extension, Block (..), Inline (..), Bni)+import qualified Control.Foldl        as L+import qualified Data.List.NonEmpty   as NE+import qualified Text.MMark.Extension as Ext++-- | An opaque type representing table of contents produced by the+-- 'tocScanner' scanner.++newtype Toc = Toc [(Int, NonEmpty Inline)]++-- | The scanner builds table of contents 'Toc' that can then be passed to+-- 'toc' to obtain an extension that renders the table of contents in HTML.++tocScanner+  :: (Int -> Bool)+     -- ^ Whether to include a header of this level (1–6)+  -> L.Fold Bni Toc+tocScanner p = fmap (Toc . ($ [])) . Ext.scanner id $ \xs block ->+  case block of+    Heading1 x -> f 1 x xs+    Heading2 x -> f 2 x xs+    Heading3 x -> f 3 x xs+    Heading4 x -> f 4 x xs+    Heading5 x -> f 5 x xs+    Heading6 x -> f 6 x xs+    _          -> xs+  where+    f n a as =+      if p n+        then as . ((n, a):)+        else as++-- | Create an extension that replaces a certain code block with previously+-- constructed table of contents.++toc+  :: Text -- ^ Label of the code block to replace by the table of contents+  -> Toc  -- ^ Previously generated by 'tocScanner'+  -> Extension+toc label (Toc xs) = Ext.blockTrans $ \case+  old@(CodeBlock mlabel _) ->+    case NE.nonEmpty xs of+      Nothing -> old+      Just ns ->+        if mlabel == pure label+          then renderToc ns+          else old+  other -> other++-- | Construct 'Bni' for a table of contents from given collection of+-- headers. This is a non-public helper.++renderToc :: NonEmpty (Int, NonEmpty Inline) -> Bni+renderToc = UnorderedList . NE.unfoldr f+  where+    f ((n,x) :| xs) =+      let (sitems, fitems) = span ((> n) . fst) xs+          url = Ext.headerFragment (Ext.headerId x)+      in ( Naked (Link x url Nothing :| [])+           : maybeToList (renderToc <$> NE.nonEmpty sitems)+         , NE.nonEmpty fitems )

@@ -1,7 +1,7 @@ name:                 mmark-ext-version:              0.0.1.2+version:              0.1.0.0 cabal-version:        >= 1.18-tested-with:          GHC==7.10.3, GHC==8.0.2, GHC==8.2.2+tested-with:          GHC==8.0.2, GHC==8.2.2 license:              BSD3 license-file:         LICENSE.md author:               Mark Karpov <markkarpov92@gmail.com>@@ -11,7 +11,11 @@ category:             Text synopsis:             Commonly useful extensions for MMark markdown processor build-type:           Simple-description:          Commonly useful extensions for MMark markdown processor.+description:++  Commonly useful extensions for MMark markdown processor.+  Click on "Text.MMark.Extension.Common" to get started.+ extra-doc-files:      CHANGELOG.md                     , README.md data-files:           data/*.md@@ -27,17 +31,26 @@   default:            False  library-  build-depends:      base             >= 4.8   && < 5.0-                    , data-default-class+  build-depends:      base             >= 4.9   && < 5.0+                    , blaze-html       >= 0.9   && < 0.10                     , foldl            >= 1.2   && < 1.4                     , lucid            >= 2.6   && < 3.0                     , microlens        >= 0.4   && < 0.5-                    , mmark            >= 0.0.2 && <= 0.1+                    , mmark            >= 0.0.4 && <= 0.1                     , modern-uri       >= 0.1.1 && < 0.3+                    , skylighting      >= 0.5   && < 0.6                     , text             >= 0.2   && < 1.3   if !impl(ghc >= 8.0)     build-depends:    semigroups       == 0.18.*   exposed-modules:    Text.MMark.Extension.Common+                    , Text.MMark.Extension.Comment+                    , Text.MMark.Extension.FontAwesome+                    , Text.MMark.Extension.Kbd+                    , Text.MMark.Extension.LinkTarget+                    , Text.MMark.Extension.ObfuscateEmail+                    , Text.MMark.Extension.PunctuationPrettifier+                    , Text.MMark.Extension.Skylighting+                    , Text.MMark.Extension.TableOfContents   if flag(dev)     ghc-options:      -O0 -Wall -Werror   else@@ -48,16 +61,22 @@   main-is:            Spec.hs   hs-source-dirs:     tests   type:               exitcode-stdio-1.0-  build-depends:      base             >= 4.8   && < 5.0-                    , data-default-class+  build-depends:      base             >= 4.9   && < 5.0                     , hspec            >= 2.0   && < 3.0                     , lucid            >= 2.6   && < 3.0-                    , mmark            >= 0.0.2 && <= 0.1+                    , mmark            >= 0.0.4 && <= 0.1                     , mmark-ext                     , text             >= 0.2   && < 1.3   if flag(dev)     ghc-options:      -O0 -Wall -Werror   else     ghc-options:      -O2 -Wall-  other-modules:      Text.MMark.Extension.CommonSpec+  other-modules:      Text.MMark.Extension.CommentSpec+                    , Text.MMark.Extension.FontAwesomeSpec+                    , Text.MMark.Extension.KbdSpec+                    , Text.MMark.Extension.LinkTargetSpec+                    , Text.MMark.Extension.ObfuscateEmailSpec+                    , Text.MMark.Extension.PunctuationPrettifierSpec+                    , Text.MMark.Extension.TableOfContentsSpec+                    , Text.MMark.Extension.TestUtils   default-language:   Haskell2010

@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.MMark.Extension.CommentSpec (spec) where++import Test.Hspec+import Text.MMark.Extension.Comment+import Text.MMark.Extension.TestUtils++spec :: Spec+spec =+  describe "commentParagraph" $ do+    let to = withExt (commentParagraph "$$$")+    context "when it is the only content in document" $+      it "is removed" $+        "$$$ Here we go." `to` ""+    context "when it is intermixed with other paragraphs" $+      it "is removed" $+        "First.\n\n$$$Second.\n\nThird.\n" `to` "<p>First.</p>\n<p>Third.</p>\n"+    context "when it is not in plain text" $+      it "has no special effect" $+        "[$$$ link](/url) foo." `to` "<p><a href=\"/url\">$$$ link</a> foo.</p>\n"

@@ -1,101 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Text.MMark.Extension.CommonSpec (spec) where--import Data.Default.Class-import Data.Text (Text)-import Test.Hspec-import qualified Data.Text.IO                as TIO-import qualified Data.Text.Lazy              as TL-import qualified Lucid                       as L-import qualified Text.MMark                  as MMark-import qualified Text.MMark.Extension.Common as Ext--spec :: Spec-spec = parallel $ do-  describe "toc" $-    it "works" $-      "data/toc.md" `withToc` "data/toc.html"-  describe "punctuationPrettifier" $ do-    let to = withExt (Ext.punctuationPrettifier def)-        ot = withExt $ Ext.punctuationPrettifier def-          { Ext.punctEnDash = False-          , Ext.punctEmDash = False }-    context "on plain inlines" $ do-      context "when enabeled" $ do-        it "replaces -- with en dash" $-          "Here we go -- at last." `to` "<p>Here we go – at last.</p>\n"-        it "replaces --- with em dash" $-          "Here we go---at last." `to` "<p>Here we go—at last.</p>\n"-      context "when disabled" $ do-        it "does not replace -- with en dash" $-          "Here we go -- at last." `ot` "<p>Here we go -- at last.</p>\n"-        it "does not replace --- with em dash" $-          "Here we go---at last." `ot` "<p>Here we go---at last.</p>\n"-    context "on other inlines" $-      it "has no effect" $-        "`code -- span`" `to` "<p><code>code -- span</code></p>\n"-  describe "obfuscateEmail" $ do-    let to = withExt (Ext.obfuscateEmail "foo")-    context "when URI has the mailto scheme" $-      it "produces the correct HTML" $-        "<mailto:me@example.org>" `to` "<p><a href=\"javascript:void(0)\" class=\"foo\" data-email=\"me@example.org\">Enable JavaScript to see the email</a></p>\n"-    context "when URI has some other scheme" $-      it "produces the correct HTML" $-        "<https:example.org>" `to` "<p><a href=\"https:example.org\">https:example.org</a></p>\n"-    context "other elements" $-      it "not affected" $-        "Something." `to` "<p>Something.</p>\n"-  describe "fontAwesome" $ do-    let to = withExt Ext.fontAwesome-    context "when URI has the fa scheme" $-      it "produces the correct HTML" $ do-        "<fa:>" `to` "<p><a href=\"fa:\">fa:</a></p>\n"-        "<fa:user>" `to` "<p><span class=\"fa fa-user\"></span></p>\n"-        "<fa:user/lg>" `to` "<p><span class=\"fa fa-user fa-lg\"></span></p>\n"-        "<fa:quote-left/3x/pull-left/border>" `to` "<p><span class=\"fa fa-quote-left fa-3x fa-pull-left fa-border\"></span></p>\n"-    context "when URI has some other scheme" $-      it "produces the correct HTML" $-        "<https://example.org>" `to` "<p><a href=\"https://example.org/\">https://example.org/</a></p>\n"-    context "other elements" $-      it "not affected" $-        "Something." `to` "<p>Something.</p>\n"--------------------------------------------------------------------------------- Helpers---- | Feed input into MMark parser, apply an extension, render the parsed--- document and demand that it matches the given example.--withExt-  :: MMark.Extension   -- ^ MMark extension to use-  -> Text              -- ^ Input for the parser-  -> Text              -- ^ Expected output of the render-  -> Expectation-withExt ext input expected = do-  let Right doc = MMark.parse "" input-      actual = TL.toStrict-        . L.renderText-        . MMark.render-        . MMark.useExtension ext-        $ doc--  actual `shouldBe` expected--- | Similar to 'withExt' but specialized to test the 'Ext.toc' extension--- and loads input and expected output from files.--withToc-  :: FilePath          -- ^ File containing input for the parser-  -> FilePath          -- ^ File containing expected output of the render-  -> Expectation-withToc ipath opath = do-  input    <- TIO.readFile ipath-  expected <- TIO.readFile opath-  let Right doc = MMark.parse "" input-      toc       = MMark.runScanner doc (Ext.tocScanner 6)-      actual = TL.toStrict-        . L.renderText-        . MMark.render-        . MMark.useExtension (Ext.toc "toc" toc)-        $ doc-  actual `shouldBe` expected

@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.MMark.Extension.FontAwesomeSpec (spec) where++import Test.Hspec+import Text.MMark.Extension.FontAwesome+import Text.MMark.Extension.TestUtils++spec :: Spec+spec =+  describe "fontAwesome" $ do+    let to = withExt fontAwesome+    context "when URI has the fa scheme" $+      it "produces the correct HTML" $ do+        "<fa:>" `to` "<p><a href=\"fa:\">fa:</a></p>\n"+        "<fa:user>" `to` "<p><span class=\"fa fa-user\"></span></p>\n"+        "<fa:user/lg>" `to` "<p><span class=\"fa fa-user fa-lg\"></span></p>\n"+        "<fa:quote-left/3x/pull-left/border>" `to` "<p><span class=\"fa fa-quote-left fa-3x fa-pull-left fa-border\"></span></p>\n"+    context "when URI has some other scheme" $+      it "produces the correct HTML" $+        "<https://example.org>" `to` "<p><a href=\"https://example.org/\">https://example.org/</a></p>\n"+    context "other elements" $+      it "not affected" $+        "Something." `to` "<p>Something.</p>\n"

@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.MMark.Extension.KbdSpec (spec) where++import Test.Hspec+import Text.MMark.Extension.Kbd+import Text.MMark.Extension.TestUtils++spec :: Spec+spec =+  describe "kbd" $ do+    let to = withExt kbd+    it "works" $+      "Press [Ctrl+A](kbd:)" `to` "<p>Press <kbd>Ctrl+A</kbd></p>\n"

@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.MMark.Extension.LinkTargetSpec (spec) where++import Test.Hspec+import Text.MMark.Extension.LinkTarget+import Text.MMark.Extension.TestUtils++spec :: Spec+spec =+  describe "linkTarget" $ do+    let to = withExt linkTarget+    context "when no link title provided" $+      it "has no effect" $+        "[link](/url)" `to` "<p><a href=\"/url\">link</a></p>\n"+    context "when link title does not start with a target" $+      it "has no effect" $+        "[link](/url 'something _blank')" `to`+          "<p><a href=\"/url\" title=\"something _blank\">link</a></p>\n"+    context "when link title starts with a target" $ do+      context "when there is nothing but the target in title" $+        it "works as intended, no title attribute produced" $+          "[link](/url '_blank')" `to`+            "<p><a href=\"/url\" target=\"_blank\">link</a></p>\n"+      context "when there is also a title" $+        it "works as intended, target is stripped from the title" $+          "[link](/url '_blank something')" `to`+            "<p><a href=\"/url\" title=\"something\" target=\"_blank\">link</a></p>\n"

@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.MMark.Extension.ObfuscateEmailSpec (spec) where++import Test.Hspec+import Text.MMark.Extension.ObfuscateEmail+import Text.MMark.Extension.TestUtils++spec :: Spec+spec =+  describe "obfuscateEmail" $ do+    let to = withExt (obfuscateEmail "foo")+    context "when URI has the mailto scheme" $+      it "produces the correct HTML" $+        "<mailto:me@example.org>" `to` "<p><a href=\"javascript:void(0)\" class=\"foo\" data-email=\"me@example.org\">Enable JavaScript to see this email</a></p>\n"+    context "when URI has some other scheme" $+      it "produces the correct HTML" $+        "<https:example.org>" `to` "<p><a href=\"https:example.org\">https:example.org</a></p>\n"+    context "other elements" $+      it "not affected" $+        "Something." `to` "<p>Something.</p>\n"

@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.MMark.Extension.PunctuationPrettifierSpec (spec) where++import Test.Hspec+import Text.MMark.Extension.PunctuationPrettifier+import Text.MMark.Extension.TestUtils++spec :: Spec+spec =+  describe "punctuationPrettifier" $ do+    let to = withExt punctuationPrettifier+    context "on plain inlines" $ do+        it "replaces ... with ellipsis" $+          "He forgot where he came from..." `to` "<p>He forgot where he came from…</p>\n"+        it "replaces --- with em dash" $+          "Here we go---at last." `to` "<p>Here we go—at last.</p>\n"+        it "replaces -- with en dash" $+          "Here we go -- at last." `to` "<p>Here we go – at last.</p>\n"+        it "replaces double quotes intelligently" $+          "\"Something\"" `to` "<p>“Something”</p>\n"+        it "replaces double quotes intelligently (empty)" $+          "\"\"" `to` "<p>“”</p>\n"+        it "replaces single quotes intelligently" $ do+          "'Something'" `to` "<p>‘Something’</p>\n"+          "I'm doin' well, 'cause I care 'bout 'Big Jim'."+            `to` "<p>I’m doin’ well, ‘cause I care ‘bout ‘Big Jim’.</p>\n"+        it "replaces single quotes intelligently (empty)" $+          "''" `to` "<p>‘’</p>\n"+        it "a tricky test 1" $+          "Something-\"foo\"." `to` "<p>Something-”foo”.</p>\n"+        it "a tricky test 2" $+          "Something.--" `to` "<p>Something.–</p>\n"+    context "on other inlines" $+      it "has no effect" $+        "`code -- span`" `to` "<p><code>code -- span</code></p>\n"

@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.MMark.Extension.TableOfContentsSpec (spec) where++import Test.Hspec+import Text.MMark.Extension.TableOfContents+import qualified Data.Text.IO   as TIO+import qualified Data.Text.Lazy as TL+import qualified Lucid          as L+import qualified Text.MMark     as MMark++spec :: Spec+spec =+  describe "toc" $+    it "works" $ do+      input    <- TIO.readFile "data/toc.md"+      expected <- TIO.readFile "data/toc.html"+      let Right doc = MMark.parse "" input+          headings  = MMark.runScanner doc (tocScanner (> 1))+          actual    = TL.toStrict+            . L.renderText+            . MMark.render+            . MMark.useExtension (toc "toc" headings)+            $ doc+      actual `shouldBe` expected

@@ -0,0 +1,26 @@+module Text.MMark.Extension.TestUtils+  ( withExt )+where++import Data.Text (Text)+import Test.Hspec+import qualified Data.Text.Lazy as TL+import qualified Lucid          as L+import qualified Text.MMark     as MMark++-- | Feed input into MMark parser, apply an extension, render the parsed+-- document and demand that it matches the given example.++withExt+  :: MMark.Extension   -- ^ MMark extension to use+  -> Text              -- ^ Input for the parser+  -> Text              -- ^ Expected output of the render+  -> Expectation+withExt ext input expected = do+  let Right doc = MMark.parse "" input+      actual = TL.toStrict+        . L.renderText+        . MMark.render+        . MMark.useExtension ext+        $ doc+  actual `shouldBe` expected