diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,25 @@ +## MMark Ext 0.3.0.0 + +* The package now requires `mmark-0.1` or later. + +* Added the following modules: + + * `Text.MMark.Extension.Emoji` + * `Text.MMark.Extension.Heading` + * `Text.MMark.Extension.Icons` + * `Text.MMark.Extension.Image` + * `Text.MMark.Extension.LineHighlight` + * `Text.MMark.Extension.Link` + * `Text.MMark.Extension.Mermaid` + * `Text.MMark.Extension.Metadata` + * `Text.MMark.Extension.Permalinks` + +* Removed the following modules: + + * `Text.MMark.Extension.FontAwesome` + * `Text.MMark.Extension.LinkTarget` + * `Text.MMark.Extension.ObfuscateEmail` + ## MMark Ext 0.2.1.5 * The test suite now passes with `modern-uri-0.3.4.4`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ [![Hackage](https://img.shields.io/hackage/v/mmark-ext.svg?style=flat)](https://hackage.haskell.org/package/mmark-ext) [![Stackage Nightly](http://stackage.org/package/mmark-ext/badge/nightly)](http://stackage.org/nightly/package/mmark-ext) [![Stackage LTS](http://stackage.org/package/mmark-ext/badge/lts)](http://stackage.org/lts/package/mmark-ext) -![CI](https://github.com/mmark-md/mmark-ext/workflows/CI/badge.svg?branch=master) +[![CI](https://github.com/mmark-md/mmark-ext/actions/workflows/ci.yaml/badge.svg)](https://github.com/mmark-md/mmark-ext/actions/workflows/ci.yaml) Commonly useful extensions for the [MMark](https://hackage.haskell.org/package/mmark) markdown processor. @@ -20,4 +20,4 @@ Copyright © 2017–present Mark Karpov -Distributed under BSD 3 clause license. +Distributed under the BSD 3-clause license. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Main (main) where - -import Distribution.Simple - -main :: IO () -main = defaultMain diff --git a/Text/MMark/Extension/Comment.hs b/Text/MMark/Extension/Comment.hs --- a/Text/MMark/Extension/Comment.hs +++ b/Text/MMark/Extension/Comment.hs @@ -17,21 +17,21 @@ import Control.Monad import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) -import qualified Data.Text as T -import Text.MMark.Extension (Block (..), Extension, Inline (..)) -import qualified Text.MMark.Extension as Ext +import Data.Text qualified as T +import Text.MMark.Render (Block (..), Inline (..), RenderExtension) +import Text.MMark.Render qualified as Ext -- | This extension removes top-level paragraphs starting with the given -- sequence of non-markup characters. commentParagraph :: -- | Sequence of characters that starts a comment Text -> - Extension + RenderExtension commentParagraph commentPrefix = Ext.blockRender $ \old block -> case block of - p@(Paragraph (ois, _)) -> + p@(Paragraph _ (ois, _)) -> case Ext.getOis ois of - (Plain txt :| _) -> + (Plain _ txt :| _) -> unless (commentPrefix `T.isPrefixOf` txt) $ old p _ -> old p diff --git a/Text/MMark/Extension/Common.hs b/Text/MMark/Extension/Common.hs --- a/Text/MMark/Extension/Common.hs +++ b/Text/MMark/Extension/Common.hs @@ -14,12 +14,13 @@ -- > import qualified Text.MMark.Extension.Common as Ext -- -- Here is an example that uses several extensions from this module at the --- same time, it should give you an idea where to start: +-- same time; it should give you an idea where to start: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > -- > module Main (main) where -- > +-- > import Control.Monad ((>=>)) -- > import qualified Data.Text.IO as T -- > import qualified Data.Text.Lazy.IO as TL -- > import qualified Lucid as L @@ -33,25 +34,36 @@ -- > txt <- T.readFile input -- > case MMark.parse input txt of -- > Left bundle -> putStrLn (M.errorBundlePretty bundle) --- > Right r -> --- > 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 --- > , Ext.skylighting ] --- > $ r +-- > Right r -> do +-- > let toc = MMark.runScanner (Ext.tocScanner (> 1)) r +-- > fns = MMark.runScanner Ext.footnoteScanner r +-- > trans = Ext.toc "toc" toc >=> Ext.punctuationPrettifier +-- > renderExts = Ext.skylighting <> Ext.footnotes +-- > case MMark.runCheck (Ext.validateFootnotes fns) r of +-- > Left errs -> putStrLn (M.errorBundlePretty errs) +-- > Right () -> return () +-- > case MMark.runTrans trans r of +-- > Left errs -> putStrLn (M.errorBundlePretty errs) +-- > Right r' -> +-- > TL.writeFile "output.html" +-- > . L.renderText +-- > . MMark.render renderExts +-- > $ r' module Text.MMark.Extension.Common ( module Text.MMark.Extension.Comment, - module Text.MMark.Extension.FontAwesome, + module Text.MMark.Extension.Emoji, module Text.MMark.Extension.Footnotes, module Text.MMark.Extension.GhcSyntaxHighlighter, + module Text.MMark.Extension.Heading, + module Text.MMark.Extension.Icons, + module Text.MMark.Extension.Image, module Text.MMark.Extension.Kbd, - module Text.MMark.Extension.LinkTarget, + module Text.MMark.Extension.LineHighlight, + module Text.MMark.Extension.Link, module Text.MMark.Extension.MathJax, - module Text.MMark.Extension.ObfuscateEmail, + module Text.MMark.Extension.Mermaid, + module Text.MMark.Extension.Metadata, + module Text.MMark.Extension.Permalinks, module Text.MMark.Extension.PunctuationPrettifier, module Text.MMark.Extension.Skylighting, module Text.MMark.Extension.TableOfContents, @@ -59,13 +71,19 @@ where import Text.MMark.Extension.Comment -import Text.MMark.Extension.FontAwesome +import Text.MMark.Extension.Emoji import Text.MMark.Extension.Footnotes import Text.MMark.Extension.GhcSyntaxHighlighter +import Text.MMark.Extension.Heading +import Text.MMark.Extension.Icons +import Text.MMark.Extension.Image import Text.MMark.Extension.Kbd -import Text.MMark.Extension.LinkTarget +import Text.MMark.Extension.LineHighlight +import Text.MMark.Extension.Link import Text.MMark.Extension.MathJax -import Text.MMark.Extension.ObfuscateEmail +import Text.MMark.Extension.Mermaid +import Text.MMark.Extension.Metadata +import Text.MMark.Extension.Permalinks import Text.MMark.Extension.PunctuationPrettifier import Text.MMark.Extension.Skylighting import Text.MMark.Extension.TableOfContents diff --git a/Text/MMark/Extension/Emoji.hs b/Text/MMark/Extension/Emoji.hs new file mode 100644 --- /dev/null +++ b/Text/MMark/Extension/Emoji.hs @@ -0,0 +1,317 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Text.MMark.Extension.Emoji +-- Copyright : © 2026–present Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Replace @:shortcode:@ with the emoji it names. +-- +-- @since 0.3.0.0 +module Text.MMark.Extension.Emoji + ( emoji, + emojiWith, + defaultEmoji, + ) +where + +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as M +import Data.Text (Text) +import Data.Text qualified as T +import Text.MMark.Trans (Bni, Inline (..), Trans) +import Text.MMark.Trans qualified as Trans + +-- | Replace every @:shortcode:@ of 'defaultEmoji' with the emoji it names, +-- and report every @:shortcode:@ that is not one of them. A name that is +-- not recognized is far more likely to be a typo than something the writer +-- meant to keep. +emoji :: Bni -> Trans Bni +emoji = emojiWith defaultEmoji + +-- | Like 'emoji', but you supply the table. +emojiWith :: Map Text Text -> Bni -> Trans Bni +emojiWith table = Trans.bottomUpInlines $ \case + Plain spn txt -> Plain spn <$> replace spn txt + other -> return other + where + replace spn = fmap T.concat . mapM (piece spn) . chunks + piece spn = \case + Left t -> return t + Right name -> case M.lookup name table of + Just e -> return e + Nothing -> do + Trans.report spn ("there is no emoji called \"" <> name <> "\"") + return (":" <> name <> ":") + +-- | Split text into literal pieces and the shortcodes between them. A +-- shortcode is a run of letters, digits, @_@, @+@, and @-@ between colons. +chunks :: Text -> [Either Text Text] +chunks t = + case T.breakOn ":" t of + (before, rest) + | T.null rest -> [Left before | not (T.null before)] + | otherwise -> + let (name, rest') = T.breakOn ":" (T.drop 1 rest) + in if T.null rest' || T.null name || not (T.all nameChar name) + then case chunks (T.drop 1 rest) of + cs -> Left (before <> ":") : cs + else Left before : Right name : chunks (T.drop 1 rest') + where + nameChar c = c `elem` ("_+-" :: String) || c `elem` ['a' .. 'z'] || c `elem` ['0' .. '9'] + +-- | The table 'emoji' uses: a couple of hundred of the shortcodes that come +-- up most often, grouped below by what they are about. The names are the +-- familiar ones, so @:tada:@, @:+1:@, and @:warning:@ mean what you expect. +defaultEmoji :: Map Text Text +defaultEmoji = + M.fromList + [ -- Faces and emotions + ("smile", "\128578"), + ("grin", "\128512"), + ("grinning", "\128512"), + ("laughing", "\128514"), + ("joy", "\128514"), + ("sweat_smile", "\128517"), + ("rofl", "\129315"), + ("wink", "\128521"), + ("blush", "\128522"), + ("heart_eyes", "\128525"), + ("star_struck", "\129321"), + ("sunglasses", "\128526"), + ("smirk", "\128527"), + ("stuck_out_tongue", "\128539"), + ("nerd_face", "\129299"), + ("thinking", "\129300"), + ("zipper_mouth_face", "\129296"), + ("face_with_monocle", "\129488"), + ("neutral_face", "\128528"), + ("confused", "\128533"), + ("upside_down_face", "\128579"), + ("worried", "\128543"), + ("cry", "\128546"), + ("sob", "\128557"), + ("tired_face", "\128555"), + ("scream", "\128561"), + ("angry", "\128544"), + ("rage", "\128545"), + ("sleeping", "\128564"), + ("yawning_face", "\129393"), + ("exploding_head", "\129327"), + ("partying_face", "\129395"), + ("shrug", "\129335"), + ("facepalm", "\129318"), + -- Hands + ("thumbsup", "\128077"), + ("thumbsdown", "\128078"), + ("+1", "\128077"), + ("-1", "\128078"), + ("ok_hand", "\128076"), + ("v", "\9996\65039"), + ("point_up", "\9757\65039"), + ("point_right", "\128073"), + ("point_left", "\128072"), + ("wave", "\128075"), + ("clap", "\128079"), + ("raised_hands", "\128588"), + ("pray", "\128591"), + ("handshake", "\129309"), + ("muscle", "\128170"), + ("writing_hand", "\9997\65039"), + ("eyes", "\128064"), + -- Hearts + ("heart", "\10084\65039"), + ("broken_heart", "\128148"), + ("sparkling_heart", "\128150"), + ("blue_heart", "\128153"), + ("green_heart", "\128154"), + ("yellow_heart", "\128155"), + ("orange_heart", "\129505"), + ("purple_heart", "\128156"), + ("black_heart", "\128420"), + -- Nature and weather + ("sunny", "\9728\65039"), + ("crescent_moon", "\127769"), + ("star", "\11088"), + ("sparkles", "\10024"), + ("cloud", "\9729\65039"), + ("zap", "\9889"), + ("snowflake", "\10052\65039"), + ("rainbow", "\127752"), + ("droplet", "\128167"), + ("ocean", "\127754"), + ("earth_americas", "\127758"), + ("mountain", "\9968\65039"), + ("seedling", "\127793"), + ("herb", "\127807"), + ("four_leaf_clover", "\127808"), + ("maple_leaf", "\127809"), + ("cactus", "\127797"), + ("palm_tree", "\127796"), + ("fire", "\128293"), + -- Animals + ("snail", "\128012"), + ("turtle", "\128034"), + ("rabbit", "\128007"), + ("cat", "\128049"), + ("dog", "\128054"), + ("mouse", "\128045"), + ("horse", "\128052"), + ("pig", "\128055"), + ("bear", "\128059"), + ("panda_face", "\128060"), + ("fox_face", "\129418"), + ("monkey", "\128018"), + ("elephant", "\128024"), + ("camel", "\128043"), + ("unicorn", "\129412"), + ("dragon", "\128009"), + ("snake", "\128013"), + ("bird", "\128038"), + ("owl", "\129417"), + ("penguin", "\128039"), + ("fish", "\128031"), + ("whale", "\128051"), + ("octopus", "\128025"), + ("crab", "\129408"), + ("bug", "\128027"), + ("bee", "\128029"), + ("ant", "\128028"), + ("butterfly", "\129419"), + -- Food and drink + ("coffee", "\9749"), + ("tea", "\127861"), + ("beer", "\127866"), + ("wine_glass", "\127863"), + ("cocktail", "\127864"), + ("champagne", "\127870"), + ("clinking_glasses", "\129346"), + ("pizza", "\127829"), + ("hamburger", "\127828"), + ("taco", "\127790"), + ("sushi", "\127843"), + ("popcorn", "\127871"), + ("cake", "\127856"), + ("birthday", "\127874"), + ("cookie", "\127850"), + ("doughnut", "\127849"), + ("ice_cream", "\127848"), + ("chocolate_bar", "\127851"), + ("apple", "\127822"), + ("banana", "\127820"), + ("avocado", "\129361"), + -- Tools and objects + ("bulb", "\128161"), + ("wrench", "\128295"), + ("hammer", "\128296"), + ("hammer_and_wrench", "\128736\65039"), + ("nut_and_bolt", "\128297"), + ("gear", "\9881\65039"), + ("toolbox", "\129520"), + ("microscope", "\128300"), + ("telescope", "\128301"), + ("mag", "\128269"), + ("computer", "\128187"), + ("keyboard", "\9000\65039"), + ("floppy_disk", "\128190"), + ("package", "\128230"), + ("battery", "\128267"), + ("electric_plug", "\128268"), + ("camera", "\128247"), + ("movie_camera", "\127909"), + ("tv", "\128250"), + ("bell", "\128276"), + ("mega", "\128227"), + ("loudspeaker", "\128226"), + ("speech_balloon", "\128172"), + ("thought_balloon", "\128173"), + ("envelope", "\9993\65039"), + ("inbox_tray", "\128229"), + ("outbox_tray", "\128228"), + ("flashlight", "\128294"), + ("candle", "\128367\65039"), + ("broom", "\129529"), + ("wastebasket", "\128465\65039"), + ("crystal_ball", "\128302"), + ("gem", "\128142"), + ("crown", "\128081"), + ("trophy", "\127942"), + ("dart", "\127919"), + ("game_die", "\127922"), + ("art", "\127912"), + ("musical_note", "\127925"), + ("rocket", "\128640"), + ("airplane", "\9992\65039"), + ("hourglass", "\8987"), + ("alarm_clock", "\9200"), + ("stopwatch", "\9201\65039"), + ("calendar", "\128197"), + ("balance_scale", "\9878\65039"), + ("chart_with_upwards_trend", "\128200"), + ("bar_chart", "\128202"), + -- Paper and files + ("book", "\128214"), + ("books", "\128218"), + ("memo", "\128221"), + ("pencil2", "\9999\65039"), + ("scroll", "\128220"), + ("page_facing_up", "\128196"), + ("newspaper", "\128240"), + ("clipboard", "\128203"), + ("file_folder", "\128193"), + ("open_file_folder", "\128194"), + ("paperclip", "\128206"), + ("pushpin", "\128204"), + ("bookmark", "\128278"), + ("label", "\127991\65039"), + ("link", "\128279"), + ("lock", "\128274"), + ("unlock", "\128275"), + ("closed_lock_with_key", "\128272"), + ("key", "\128273"), + ("shield", "\128737\65039"), + -- Marks and signs + ("white_check_mark", "\9989"), + ("heavy_check_mark", "\10004\65039"), + ("ballot_box_with_check", "\9745\65039"), + ("x", "\10060"), + ("question", "\10067"), + ("exclamation", "\10071"), + ("warning", "\9888\65039"), + ("boom", "\128165"), + ("100", "\128175"), + ("tada", "\127881"), + ("checkered_flag", "\127937"), + ("triangular_flag_on_post", "\128681"), + ("construction", "\128679"), + ("rotating_light", "\128680"), + ("no_entry", "\9940"), + ("recycle", "\9851\65039"), + ("infinity", "\9854\65039"), + ("heavy_plus_sign", "\10133"), + ("heavy_minus_sign", "\10134"), + ("arrow_right", "\10145\65039"), + ("arrow_left", "\11013\65039"), + ("arrow_up", "\11014\65039"), + ("arrow_down", "\11015\65039"), + ("arrows_counterclockwise", "\128260"), + ("red_circle", "\128308"), + ("large_blue_circle", "\128309"), + ("green_circle", "\128994"), + ("yellow_circle", "\128993"), + ("orange_circle", "\128992"), + ("purple_circle", "\128995"), + ("white_circle", "\9898"), + ("black_circle", "\9899"), + -- Other + ("ghost", "\128123"), + ("alien", "\128125"), + ("robot", "\129302"), + ("skull", "\128128"), + ("zzz", "\128164") + ] diff --git a/Text/MMark/Extension/FontAwesome.hs b/Text/MMark/Extension/FontAwesome.hs deleted file mode 100644 --- a/Text/MMark/Extension/FontAwesome.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} - --- | --- Module : Text.MMark.Extension.FontAwesome --- Copyright : © 2017–present Mark Karpov --- License : BSD 3 clause --- --- Maintainer : Mark Karpov --- Stability : experimental --- Portability : portable --- --- Turn links into Font Awesome icons. -module Text.MMark.Extension.FontAwesome - ( fontAwesome, - ) -where - -import qualified Data.Text as T -import Lens.Micro ((^.)) -import Lucid -import Text.MMark.Extension (Extension, Inline (..)) -import qualified Text.MMark.Extension as Ext -import qualified Text.URI as URI -import Text.URI.Lens (uriPath) -import Text.URI.QQ (scheme) - --- | Insert @span@s with font awesome icons using autolinks like this: --- --- > --- --- This @user@ identifier is the name of the icon you want to insert. You --- can also control the size of the icon like this: --- --- > -- fixed width --- > -- large --- > --- > --- > --- > --- --- In general, all path components that go after the name of the icon will --- be prefixed with @\"fa-\"@ and added as classes, so you can do a lot of --- fancy stuff, see : --- --- > --- --- See also: . -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 diff --git a/Text/MMark/Extension/Footnotes.hs b/Text/MMark/Extension/Footnotes.hs --- a/Text/MMark/Extension/Footnotes.hs +++ b/Text/MMark/Extension/Footnotes.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} -- | -- Module : Text.MMark.Extension.Footnotes @@ -14,24 +16,40 @@ -- -- @since 0.1.1.0 module Text.MMark.Extension.Footnotes - ( footnotes, + ( -- * Rendering + footnotes, + + -- * Validation + Footnotes, + footnoteScanner, + validateFootnotes, ) where +import Control.Foldl qualified as L import Control.Monad import Data.Char (isDigit) +import Data.List (sort) import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty qualified as NE +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as M import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Lens.Micro ((^.)) import Lucid -import Text.MMark.Extension (Block (..), Extension, Inline (..), getOis) -import qualified Text.MMark.Extension as Ext -import qualified Text.URI as URI +import Text.MMark qualified as MMark +import Text.MMark.Render (RenderExtension, getOis) +import Text.MMark.Render qualified as Render +import Text.MMark.Trans (Block (..), Bni, Inline (..), Span (..), Trans) +import Text.MMark.Trans qualified as Trans +import Text.URI qualified as URI import Text.URI.Lens (uriPath) import Text.URI.QQ (scheme) +---------------------------------------------------------------------------- +-- Rendering + -- | The extension performs two transformations: -- -- * It turns links with URIs with @footnote@ scheme and single path @@ -42,46 +60,35 @@ -- > Here goes some text [1](footnote:1). -- > -- > > footnotes --- > --- > 1. Here we have the footnote. +-- > > +-- > > 1. Here we have the footnote. -- --- The extension is not fully safe though in the sense that we can't check --- that a footnote reference refers to an existing footnote and that --- footnotes have the corresponding references, or that they are present in --- the document in the right order. -footnotes :: Extension +-- This extension only renders footnotes, it does not check that they make +-- sense. Pair it with 'validateFootnotes', which does. +footnotes :: RenderExtension footnotes = footnoteRefs <> footnoteSection -- | Create footnote references. -footnoteRefs :: Extension -footnoteRefs = Ext.inlineRender $ \old inline -> +footnoteRefs :: RenderExtension +footnoteRefs = Render.inlineRender $ \old inline -> case inline of - l@(Link _ uri _) -> - if URI.uriScheme uri == Just [scheme|footnote|] - then case uri ^. uriPath of - [x'] -> - let x = URI.unRText x' - in if T.all isDigit x - then - a_ - [ fragmentHref (footnoteId x), - id_ (referenceId x) - ] - $ sup_ (toHtml x) - else old l - _ -> old l - else old l + l@(Link _ _ uri _) -> + case footnoteRef uri of + Just n -> + let x = renderIx n + in a_ [fragmentHref (footnoteId x), id_ (referenceId x)] $ + sup_ (toHtml x) + Nothing -> old l other -> old other -- | Create a footnote section. -footnoteSection :: Extension -footnoteSection = Ext.blockRender $ \old block -> +footnoteSection :: RenderExtension +footnoteSection = Render.blockRender $ \old block -> case block of - b@(Blockquote [Paragraph (pOis, _), OrderedList i items]) -> - if getOis pOis == Plain "footnotes" :| [] + b@(Blockquote _ [Paragraph _ (pOis, _), OrderedList _ i items]) -> + if Render.asPlainText (getOis pOis) == footnoteLabel then do let startIndex = [start_ (renderIx i) | i /= 1] - renderIx = T.pack . show ol_ startIndex $ do newline forM_ (NE.zip (NE.iterate (+ 1) i) items) $ \(j, x) -> do @@ -97,8 +104,131 @@ where newline = "\n" +---------------------------------------------------------------------------- +-- Validation + +-- | The footnotes of a document as collected by 'footnoteScanner'. +data Footnotes = Footnotes + { -- | Span of every footnote section that was found, in order + fnSections :: [Span], + -- | Span of every footnote, by the number it is given + fnDefined :: Map Word Span, + -- | Span of every reference, by the number it refers to + fnReferenced :: Map Word [Span], + -- | Span of every reference we could not make sense of + fnMalformed :: [Span] + } + +instance Semigroup Footnotes where + x <> y = + Footnotes + { fnSections = fnSections x <> fnSections y, + fnDefined = fnDefined x <> fnDefined y, + fnReferenced = M.unionWith (<>) (fnReferenced x) (fnReferenced y), + fnMalformed = fnMalformed x <> fnMalformed y + } + +instance Monoid Footnotes where + mempty = Footnotes [] M.empty M.empty [] + +-- | Collect the footnotes of a document and the references to them, so that +-- 'validateFootnotes' can check that the two agree. +footnoteScanner :: L.Fold Bni Footnotes +footnoteScanner = MMark.scanner mempty $ \acc block -> + acc <> scanSection block <> foldMap scanInlines block + +-- | A check that reports every footnote that does not make sense. Every +-- problem is reported where it can be seen: a reference that leads nowhere +-- at the reference, a footnote that nothing refers to at the footnote. +-- +-- > let fns = MMark.runScanner footnoteScanner doc +-- > case MMark.runCheck (validateFootnotes fns) doc of +-- > Left errs -> putStrLn (errorBundlePretty errs) +-- > Right () -> … +validateFootnotes :: Footnotes -> Trans () +validateFootnotes Footnotes {..} = do + forM_ (drop 1 fnSections) $ \spn -> + Trans.report spn "there is more than one footnote section" + forM_ fnMalformed $ \spn -> + Trans.report + spn + "a footnote reference must have a single number as its path" + forM_ (M.toAscList fnReferenced) $ \(n, spns) -> + if M.member n fnDefined + then forM_ (drop 1 (sort spns)) $ \spn -> + Trans.report + spn + ( "footnote " + <> renderIx n + <> " is referred to more than once, which would give the" + <> " references the same id" + ) + else forM_ spns $ \spn -> + Trans.report spn ("there is no footnote " <> renderIx n) + forM_ (M.toAscList fnDefined) $ \(n, spn) -> + unless (M.member n fnReferenced) $ + Trans.report spn ("nothing refers to footnote " <> renderIx n) + +-- | Collect a footnote section, if this block is one. +scanSection :: Bni -> Footnotes +scanSection = \case + Blockquote spn [Paragraph _ pInlines, OrderedList _ i items] + | Trans.asPlainText pInlines == footnoteLabel -> + mempty + { fnSections = [spn], + fnDefined = M.fromList (zip [i ..] (itemSpan <$> NE.toList items)) + } + _ -> mempty + where + itemSpan = \case + [] -> Span 0 0 + xs -> foldr1 Trans.spanUnion (Trans.blockSpan <$> xs) + +-- | Collect the footnote references of a collection of inlines. +scanInlines :: NonEmpty Inline -> Footnotes +scanInlines = foldMap go + where + go = \case + l@(Link spn inner uri _) + | URI.uriScheme uri == Just [scheme|footnote|] -> + case footnoteRef uri of + Just n -> mempty {fnReferenced = M.singleton n [spn]} + Nothing -> mempty {fnMalformed = [Trans.inlineSpan l]} + | otherwise -> foldMap go inner + Emphasis _ xs -> foldMap go xs + Strong _ xs -> foldMap go xs + Strikeout _ xs -> foldMap go xs + Subscript _ xs -> foldMap go xs + Superscript _ xs -> foldMap go xs + Image _ xs _ _ -> foldMap go xs + _ -> mempty + +---------------------------------------------------------------------------- +-- Helpers + +-- | The number a footnote URI refers to, if it is a well-formed footnote +-- reference. +footnoteRef :: URI.URI -> Maybe Word +footnoteRef uri = + if URI.uriScheme uri == Just [scheme|footnote|] + then case uri ^. uriPath of + [x'] -> + let x = URI.unRText x' + in if not (T.null x) && T.all isDigit x + then Just (read (T.unpack x)) + else Nothing + _ -> Nothing + else Nothing + +-- | The label that marks a block quote as the footnote section. +footnoteLabel :: Text +footnoteLabel = "footnotes" + +renderIx :: Word -> Text +renderIx = T.pack . show + fragmentHref :: Text -> Attribute -fragmentHref = href_ . URI.render . Ext.headerFragment +fragmentHref = href_ . URI.render . Render.headerFragment footnoteId :: Text -> Text footnoteId x = "fn" <> x diff --git a/Text/MMark/Extension/GhcSyntaxHighlighter.hs b/Text/MMark/Extension/GhcSyntaxHighlighter.hs --- a/Text/MMark/Extension/GhcSyntaxHighlighter.hs +++ b/Text/MMark/Extension/GhcSyntaxHighlighter.hs @@ -18,12 +18,14 @@ ) where +import Control.Monad (forM_) import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import GHC.SyntaxHighlighter import Lucid -import Text.MMark.Extension (Block (..), Extension) -import qualified Text.MMark.Extension as Ext +import Text.MMark.Extension.Internal (infoStringParts, withLineHighlight) +import Text.MMark.Render (Block (..), RenderExtension) +import Text.MMark.Render qualified as Ext -- | Use the @ghc-syntax-highlighter@ package to highlight Haskell code. The -- extension is applied only to code blocks with the info string @@ -49,26 +51,56 @@ -- To use with 'Text.MMark.Extension.Skylighting.skylighting' the extension -- should be applied /after/ the -- 'Text.MMark.Extension.Skylighting.skylighting' extension so it can --- overwrite its logic for code block with @\"haskell\"@ info string. So --- place it on the left hand side of @('<>')@ or above +-- overwrite its logic for a code block with the @\"haskell\"@ info string. +-- So place it on the left hand side of @('<>')@ or above -- 'Text.MMark.Extension.Skylighting.skylighting' in the list passed to -- 'Text.MMark.useExtensions'. -ghcSyntaxHighlighter :: Extension +-- +-- The info string may end with a line specification, as in @haskell {2,4-6}@ +-- (see 'Text.MMark.Extension.LineHighlight.lineHighlight'). It does not stop +-- the block from being recognized as Haskell, and the lines it names are +-- given the class @\"highlighted-line\"@ around the tokens of the line. +ghcSyntaxHighlighter :: RenderExtension ghcSyntaxHighlighter = Ext.blockRender $ \old block -> case block of - cb@(CodeBlock (Just "haskell") txt) -> - case tokenizeHaskell txt of - Nothing -> old cb - Just toks -> do - div_ [class_ "source-code"] - . pre_ - . code_ [class_ "language-haskell"] - $ mapM_ tokenToHtml toks - newline + cb@(CodeBlock _ (Just infoString) txt) + | (Just "haskell", highlighted) <- infoStringParts infoString -> + case tokenizeHaskell txt of + Nothing -> old cb + Just toks -> do + div_ [class_ "source-code"] + . pre_ + . code_ [class_ "language-haskell"] + $ if null highlighted + then mapM_ tokenToHtml toks + else forM_ (zip [1 ..] (tokenLines toks)) $ \(n, l) -> + withLineHighlight highlighted n $ do + mapM_ tokenToHtml l + newline + newline other -> old other where newline :: Html () newline = "\n" + +-- | Split a token stream into the tokens of each line. +tokenLines :: [(Token, Text)] -> [[(Token, Text)]] +tokenLines = dropFinalEmpty . go [] + where + dropFinalEmpty ls = case ls of + (_ : _) | null (last ls) -> init ls + _ -> ls + go acc [] = [reverse acc] + go acc ((tt, txt) : rest) = + case T.splitOn "\n" txt of + [] -> go acc rest + [only] -> go (push tt only acc) rest + (first : more) -> + reverse (push tt first acc) + : fmap (\m -> push tt m []) (init more) + <> go (push tt (last more) []) rest + -- an empty piece is not a token, it is where a newline was + push tt t acc = if T.null t then acc else (tt, t) : acc -- | Render a single 'Token'. tokenToHtml :: (Token, Text) -> Html () diff --git a/Text/MMark/Extension/Heading.hs b/Text/MMark/Extension/Heading.hs new file mode 100644 --- /dev/null +++ b/Text/MMark/Extension/Heading.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Text.MMark.Extension.Heading +-- Copyright : © 2026–present Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Checks on the headings of a document, which a parser cannot make on its +-- own because they concern the document as a whole: the outline the +-- headings form, and the ids they are given. +-- +-- Scan the document first, then check what the scan collected: +-- +-- > let hs = MMark.runScanner headingScanner doc +-- > MMark.runCheck (checkHeadings hs) doc +-- +-- @since 0.3.0.0 +module Text.MMark.Extension.Heading + ( Headings, + headingScanner, + checkHeadings, + headingProblems, + ) +where + +import Control.Foldl qualified as L +import Data.List (sortOn) +import Data.Map.Strict qualified as M +import Data.Text (Text) +import Data.Text qualified as T +import Text.MMark qualified as MMark +import Text.MMark.Trans (Block (..), Bni, Span, Trans) +import Text.MMark.Trans qualified as Trans + +-- | The headings of a document as collected by 'headingScanner'. +newtype Headings = Headings [(Span, Int, Text)] + +instance Semigroup Headings where + Headings x <> Headings y = Headings (x <> y) + +instance Monoid Headings where + mempty = Headings [] + +-- | Collect the headings of a document in the order they appear, with the +-- id each of them is given. +headingScanner :: L.Fold Bni Headings +headingScanner = MMark.scanner mempty $ \acc block -> + acc <> heading block + where + heading b = case b of + Heading1 spn x -> one spn 1 x + Heading2 spn x -> one spn 2 x + Heading3 spn x -> one spn 3 x + Heading4 spn x -> one spn 4 x + Heading5 spn x -> one spn 5 x + Heading6 spn x -> one spn 6 x + _ -> mempty + one spn n x = Headings [(spn, n, Trans.headerId x)] + +-- | A check that reports the problems 'headingProblems' finds. +checkHeadings :: Headings -> Trans () +checkHeadings = mapM_ (uncurry Trans.report) . headingProblems + +-- | The problems with the headings of a document: +-- +-- * a heading that skips a level, such as a level 3 heading that +-- follows a level 1 one, which leaves a hole in the outline that +-- assistive technology relies on; +-- * a second level 1 heading, since a document has one title; +-- * two headings that MMark gives the same id, in which case every +-- link to one of them leads to the first. +headingProblems :: Headings -> [(Span, Text)] +headingProblems (Headings hs) = + sortOn fst (skips <> extraTitles <> collisions) + where + skips = + [ (spn, skipMessage prev n) + | ((_, prev, _), (spn, n, _)) <- zip hs (drop 1 hs), + n > prev + 1 + ] + skipMessage prev n = + "this heading is of level " + <> tshow n + <> ", but the one before it is of level " + <> tshow prev + <> ", so the outline of the document skips a level" + extraTitles = + [ (spn, "there is more than one level 1 heading in this document") + | (spn, _, _) <- drop 1 [h | h@(_, 1, _) <- hs] + ] + collisions = + [ (spn, "another heading is already given the id \"" <> i <> "\"") + | (spn, _, i) <- hs, + M.lookup i firstWithId /= Just spn + ] + firstWithId = M.fromListWith (\_ old -> old) [(i, spn) | (spn, _, i) <- hs] + tshow :: Int -> Text + tshow = T.pack . show diff --git a/Text/MMark/Extension/Icons.hs b/Text/MMark/Extension/Icons.hs new file mode 100644 --- /dev/null +++ b/Text/MMark/Extension/Icons.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +-- | +-- Module : Text.MMark.Extension.Icons +-- Copyright : © 2026–present Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Put an icon in a document by naming it: @\@. +-- +-- The icons are yours. You give 'icons' a table that says what each name +-- draws, and the SVG it finds there goes into the page: +-- +-- > myIcons :: Map Text (Html ()) +-- > myIcons = toHtmlRaw <$> M.fromList +-- > [ ("github", "…") +-- > , ("envelope", "…") +-- > ] +-- +-- Nothing else about the icons is this extension's business, so any SVG +-- will do, whoever drew it. The sets people usually take them from, with +-- the licence each one puts on its artwork: +-- +-- * Font Awesome Free (CC BY 4.0), the largest of them +-- * Lucide (ISC) and Feather (MIT), which it forked from, both drawn as +-- strokes on a 24×24 grid +-- * Bootstrap Icons (MIT), Heroicons (MIT), Tabler Icons (MIT), and +-- Phosphor (MIT) +-- * Octicons (MIT), the ones GitHub uses +-- * Material Symbols (Apache 2.0) +-- * Simple Icons (CC0), for the logos of companies and projects, which +-- the general-purpose sets mostly do not carry +-- +-- Or draw your own, export one from a design tool, or build it with the +-- Lucid combinators instead of pasting the markup: the table holds +-- @'Html' ()@, so it does not care where the SVG came from. +-- +-- This package ships no icons of its own, because bundling artwork would +-- put someone else's licence and attribution on top of its own. Whichever +-- set you take from, check what its licence asks of you; the CC BY ones +-- want to be credited somewhere in your page. +-- +-- @since 0.3.0.0 +module Text.MMark.Extension.Icons + ( -- * Rendering + icons, + iconsWith, + + -- * Checking + checkIcons, + checkIconsWith, + ) +where + +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as M +import Data.Text (Text) +import Data.Text qualified as T +import Lucid +import Lucid.Base (makeAttribute) +import Text.MMark.Extension.Internal (inlinesOf) +import Text.MMark.Render (Inline (..), RenderExtension) +import Text.MMark.Render qualified as Render +import Text.MMark.Trans (Bni, Trans) +import Text.MMark.Trans qualified as Trans +import Text.URI (RText, RTextLabel (..), URI) +import Text.URI qualified as URI +import Text.URI.QQ (scheme) + +-- | Put the SVG of an icon in place of every link with the @icon@ scheme +-- that names one: +-- +-- > +-- +-- becomes, given an @icon-github@ table entry: +-- +-- > +-- +-- An icon written as an autolink is decorative: it is hidden from a screen +-- reader, which is what you want next to text that already says what the +-- link is. Give the link text instead to label it: +-- +-- > [GitHub](icon:github) +-- +-- > …the SVG… +-- +-- Path components after the name become classes too, so an icon can be +-- given a size or a position by a style sheet of yours: +-- +-- > +-- +-- > +-- +-- A link that names an icon you do not have is left as it is, so that it is +-- visible in the output rather than missing from it. 'checkIcons' turns it +-- into an error instead. +icons :: + -- | The icons you have, by name + Map Text (Html ()) -> + RenderExtension +icons = iconsWith [scheme|icon|] "icon" + +-- | Like 'icons', but you choose the scheme that marks an icon and the +-- prefix of the classes. Documents written for the @fontAwesome@ extension +-- keep working with +-- +-- > iconsWith [scheme|fa|] "icon" myIcons +iconsWith :: + -- | Scheme that marks a link as an icon + RText 'Scheme -> + -- | Prefix of the classes to give the icon + Text -> + -- | The icons you have, by name + Map Text (Html ()) -> + RenderExtension +iconsWith scm prefix table = Render.inlineRender $ \old inline -> + case inline of + Link _ inner uri _ + | hasScheme scm uri, + Just (name, mods) <- iconPath uri, + Just svg <- M.lookup name table -> + span_ (class_ (classes name mods) : how inner uri) svg + other -> old other + where + classes name mods = T.unwords (prefix : fmap dashed (name : mods)) + dashed x = prefix <> "-" <> x + -- An autolink is a link whose text is its own URI, and it is the way to + -- ask for an icon that says nothing. + how inner uri = + let label = Render.asPlainText inner + in if label == URI.render uri + then [makeAttribute "aria-hidden" "true"] + else [makeAttribute "role" "img", makeAttribute "aria-label" label] + +-- | Report every link with the @icon@ scheme that does not name one of the +-- icons you have. 'icons' cannot do this itself: it runs while the document +-- is rendered, and by then there is nothing left to report against. +-- +-- > MMark.runTrans (checkIcons myIcons) doc +-- +-- Only the names matter here, so the table you render with will do. +checkIcons :: + -- | The icons you have, by name + Map Text a -> + Bni -> + Trans Bni +checkIcons = checkIconsWith [scheme|icon|] + +-- | Like 'checkIcons', but you choose the scheme, as in 'iconsWith'. +checkIconsWith :: + -- | Scheme that marks a link as an icon + RText 'Scheme -> + -- | The icons you have, by name + Map Text a -> + Bni -> + Trans Bni +checkIconsWith scm table block = do + mapM_ check (iconLinks block) + return block + where + iconLinks = foldMap ofInline . inlinesOf + ofInline = \case + Link spn _ uri _ | hasScheme scm uri -> [(spn, uri)] + _ -> [] + check (spn, uri) = case iconPath uri of + Nothing -> Trans.report spn "this link names no icon" + Just (name, _) + | M.member name table -> return () + | otherwise -> + Trans.report spn ("there is no icon called \"" <> name <> "\"") + +---------------------------------------------------------------------------- +-- Helpers + +-- | Whether a URI is written in the given scheme. +hasScheme :: RText 'Scheme -> URI -> Bool +hasScheme scm uri = URI.uriScheme uri == Just scm + +-- | The icon a URI names and the modifiers that follow it. +iconPath :: URI -> Maybe (Text, [Text]) +iconPath uri = case URI.uriPath uri of + Just (_, name :| mods) -> Just (URI.unRText name, URI.unRText <$> mods) + Nothing -> Nothing diff --git a/Text/MMark/Extension/Image.hs b/Text/MMark/Extension/Image.hs new file mode 100644 --- /dev/null +++ b/Text/MMark/Extension/Image.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Text.MMark.Extension.Image +-- Copyright : © 2026–present Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Tell the browser how large an image is before it has been fetched, let it +-- decide when to fetch it, and say when an image describes itself to nobody. +-- +-- An @\@ without @width@ and @height@ makes the page move under the +-- reader while the image loads, which is the layout shift every measure of +-- page quality penalizes. +-- +-- 'lazyImages' and 'checkAltText' need nothing but the document. The width +-- and height have to be measured first, which 'imageScanner', +-- 'imageSizeOf', and 'imageDimensions' do between them. +-- +-- @since 0.3.0.0 +module Text.MMark.Extension.Image + ( lazyImages, + checkAltText, + imageScanner, + imageDimensions, + imageSizeOf, + ) +where + +import Control.Exception (IOException, try) +import Control.Foldl qualified as L +import Data.Bits (shiftL, (.|.)) +import Data.ByteString qualified as B +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as M +import Data.Text qualified as T +import Data.Word (Word8) +import Lucid +import Lucid.Base (makeAttribute) +import System.IO (IOMode (..), withBinaryFile) +import Text.MMark qualified as MMark +import Text.MMark.Extension.Internal (inlinesOf) +import Text.MMark.Render (Bni, Inline (..), RenderExtension, Span) +import Text.MMark.Render qualified as Render +import Text.MMark.Trans (Trans) +import Text.MMark.Trans qualified as Trans +import Text.URI (URI) + +-- | Give every image @loading=\"lazy\"@ and @decoding=\"async\"@, so that +-- an image far down the page does not hold up the ones the reader can see. +lazyImages :: RenderExtension +lazyImages = Render.inlineRender $ \old inline -> + case inline of + i@Image {} -> + with + (old i) + [ makeAttribute "loading" "lazy", + makeAttribute "decoding" "async" + ] + other -> old other + +-- | Report every image whose description is empty. A reader who cannot see +-- the image is told nothing about it, and a search engine cannot index it. +-- +-- Note that MMark renders such an image as @\@ without +-- complaining, so nothing else in the pipeline will tell you. +checkAltText :: Bni -> Trans Bni +checkAltText block = do + mapM_ check (inlinesOf block) + return block + where + check = \case + Image spn desc _ _ + | Trans.asPlainText desc == "" -> + Trans.report spn "this image has no description for the alt attribute" + _ -> return () + +-- | Collect the URI of every image of a document, by the span of the image +-- it belongs to. +-- +-- > let imgs = MMark.runScanner imageScanner doc +-- > sizes <- traverse (imageSizeOf . toPath) imgs +-- > TL.putStr (renderText (MMark.render (imageDimensions sizes) doc)) +imageScanner :: L.Fold Bni (Map Span URI) +imageScanner = MMark.scanner M.empty $ \acc block -> + foldr insert acc (inlinesOf block) + where + insert = \case + Image spn _ uri _ -> M.insert spn uri + _ -> id + +-- | Give each image the width and height it was measured to have. An image +-- with no measurement, or one that could not be measured, is left alone. +imageDimensions :: Map Span (Maybe (Int, Int)) -> RenderExtension +imageDimensions sizes = Render.inlineRender $ \old inline -> + case inline of + i@(Image spn _ _ _) -> + case M.lookup spn sizes of + Just (Just (w, h)) -> + with (old i) [width_ (tshow w), height_ (tshow h)] + _ -> old i + other -> old other + where + tshow = T.pack . show + +-- | Measure a PNG, GIF, or JPEG file without decoding it, by reading the +-- header that states its size. Anything else gives 'Nothing'. +imageSizeOf :: FilePath -> IO (Maybe (Int, Int)) +imageSizeOf path = do + r <- try (withBinaryFile path ReadMode (`B.hGet` headerLimit)) + return $ case r of + Left (_ :: IOException) -> Nothing + Right bs -> sizeOfPng bs `orElse` sizeOfGif bs `orElse` sizeOfJpeg bs + where + orElse (Just x) _ = Just x + orElse Nothing y = y + +-- | How much of a file 'imageSizeOf' reads looking for the header that +-- states its size. +headerLimit :: Int +headerLimit = 256 * 1024 + +-- | @IHDR@ holds the size in the first two big-endian words of its data. +sizeOfPng :: B.ByteString -> Maybe (Int, Int) +sizeOfPng bs + | B.take 8 bs == B.pack [137, 80, 78, 71, 13, 10, 26, 10], + B.length bs >= 24 = + Just (be32 (B.drop 16 bs), be32 (B.drop 20 bs)) + | otherwise = Nothing + +-- | The logical screen descriptor holds the size in little-endian shorts. +sizeOfGif :: B.ByteString -> Maybe (Int, Int) +sizeOfGif bs + | B.take 3 bs == "GIF", + B.length bs >= 10 = + Just (le16 (B.drop 6 bs), le16 (B.drop 8 bs)) + | otherwise = Nothing + +-- | Walk the segments of a JPEG until one of the frame headers, which +-- carries the size after a byte of precision. +sizeOfJpeg :: B.ByteString -> Maybe (Int, Int) +sizeOfJpeg bs + | B.take 2 bs == B.pack [0xFF, 0xD8] = go (B.drop 2 bs) + | otherwise = Nothing + where + go s = do + (marker, rest) <- segment s + if isFrame marker + then + if B.length rest >= 7 + then Just (be16 (B.drop 5 rest), be16 (B.drop 3 rest)) + else Nothing + else + if isStandalone marker + then if marker == 0xD9 then Nothing else go rest + else + if B.length rest >= 2 + then go (B.drop (be16 rest) rest) + else Nothing + segment s = + let s' = B.dropWhile (== 0xFF) s + in if B.null s' then Nothing else Just (B.head s', B.drop 1 s') + -- SOF0 through SOF15, less the four markers that are not frames + isFrame m = + m >= 0xC0 && m <= 0xCF && m /= 0xC4 && m /= 0xC8 && m /= 0xCC + +-- | Whether a JPEG marker carries no payload, in which case the two bytes +-- that follow it are not a length: TEM, the eight restart markers, SOI, and +-- EOI. +isStandalone :: Word8 -> Bool +isStandalone m = m == 0x01 || (m >= 0xD0 && m <= 0xD9) + +be32 :: B.ByteString -> Int +be32 b = + (fromIntegral (B.index b 0) `shiftL` 24) + .|. (fromIntegral (B.index b 1) `shiftL` 16) + .|. (fromIntegral (B.index b 2) `shiftL` 8) + .|. fromIntegral (B.index b 3) + +be16 :: B.ByteString -> Int +be16 b = (fromIntegral (B.index b 0) `shiftL` 8) .|. fromIntegral (B.index b 1) + +le16 :: B.ByteString -> Int +le16 b = (fromIntegral (B.index b 1) `shiftL` 8) .|. fromIntegral (B.index b 0) diff --git a/Text/MMark/Extension/Internal.hs b/Text/MMark/Extension/Internal.hs new file mode 100644 --- /dev/null +++ b/Text/MMark/Extension/Internal.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Text.MMark.Extension.Internal +-- Copyright : © 2026–present Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Helpers shared by the extensions of this package. +module Text.MMark.Extension.Internal + ( inlinesOf, + lineSpec, + infoStringParts, + withLineHighlight, + ) +where + +import Data.Char (isDigit) +import Data.List.NonEmpty qualified as NE +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Text qualified as T +import Lucid +import Text.MMark.Trans (Bni, Inline (..)) + +-- | Every inline of a block, including the ones nested inside other +-- inlines and inside the blocks the block contains. +inlinesOf :: Bni -> [Inline] +inlinesOf = foldMap (concatMap go . NE.toList) + where + go i = + i : case i of + Emphasis _ xs -> nested xs + Strong _ xs -> nested xs + Strikeout _ xs -> nested xs + Subscript _ xs -> nested xs + Superscript _ xs -> nested xs + Link _ xs _ _ -> nested xs + Image _ xs _ _ -> nested xs + _ -> [] + nested = concatMap go . NE.toList + +-- | Split the info string of a code block into the language it names and +-- the lines it points at, as in @haskell {2,4-6}@. +-- +-- Gives 'Nothing' when there is no line specification, so that a code block +-- written the usual way is left to whatever renders it. +lineSpec :: Text -> Maybe (Maybe Text, [Int]) +lineSpec info = do + let (before, rest) = T.breakOn "{" info + spec <- T.stripSuffix "}" =<< T.stripPrefix "{" rest + ns <- traverse range (T.splitOn "," (T.filter (/= ' ') spec)) + return (language before, concat ns) + where + range t = case T.splitOn "-" t of + [a] -> (: []) <$> number a + [a, b] -> do + x <- number a + y <- number b + if x <= y then Just [x .. y] else Nothing + _ -> Nothing + number t = + if not (T.null t) && T.all isDigit t + then Just (read (T.unpack t)) + else Nothing + +-- | Like 'lineSpec', but for an info string that need not carry a line +-- specification at all: one that does not simply points at no lines. +-- +-- Every extension that renders a code block goes through this, so that a +-- language followed by a line specification is still recognized as that +-- language. Without it @haskell {2}@ looks like the name of a language +-- nobody has, and the block loses its syntax highlighting. +infoStringParts :: Text -> (Maybe Text, [Int]) +infoStringParts info = fromMaybe (language info, []) (lineSpec info) + +-- | Wrap the rendering of one line of a code block when the line is among +-- the ones pointed at. +withLineHighlight :: + -- | The lines pointed at + [Int] -> + -- | The line being rendered, counting from one + Int -> + Html () -> + Html () +withLineHighlight ns n + | n `elem` ns = span_ [class_ "highlighted-line"] + | otherwise = id + +-- | The language an info string names, if it names one. +language :: Text -> Maybe Text +language t = + let l = T.strip t + in if T.null l then Nothing else Just l diff --git a/Text/MMark/Extension/Kbd.hs b/Text/MMark/Extension/Kbd.hs --- a/Text/MMark/Extension/Kbd.hs +++ b/Text/MMark/Extension/Kbd.hs @@ -16,9 +16,9 @@ where import Lucid -import Text.MMark.Extension (Extension, Inline (..)) -import qualified Text.MMark.Extension as Ext -import qualified Text.URI as URI +import Text.MMark.Render (Inline (..), RenderExtension) +import Text.MMark.Render qualified as Ext +import Text.URI qualified as URI import Text.URI.QQ (scheme) -- | Introduce @kbd@ tags by wrapping content in links with @kbd@ scheme. @@ -30,13 +30,13 @@ -- > [kbd]: kbd: -- -- The use of reference-style links seems more aesthetically pleasant to me, --- but you can of course do somethnig like this instead: +-- but you can of course do something like this instead: -- -- > To enable that mode press [Ctrl+A](kbd:). -kbd :: Extension +kbd :: RenderExtension kbd = Ext.inlineRender $ \old inline -> case inline of - l@(Link inner uri _) -> + l@(Link _ inner uri _) -> if URI.uriScheme uri == Just [scheme|kbd|] then kbd_ (mapM_ old inner) else old l diff --git a/Text/MMark/Extension/LineHighlight.hs b/Text/MMark/Extension/LineHighlight.hs new file mode 100644 --- /dev/null +++ b/Text/MMark/Extension/LineHighlight.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Text.MMark.Extension.LineHighlight +-- Copyright : © 2026–present Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Point at the lines of a code block that the prose is about. +-- +-- Write the lines to point at after the language in the info string: +-- +-- > ```haskell {2,4-6} +-- > … +-- > ``` +-- +-- 'Text.MMark.Extension.Skylighting.skylighting' and +-- 'Text.MMark.Extension.GhcSyntaxHighlighter.ghcSyntaxHighlighter' read the +-- same specification and point at the lines themselves, around the tokens +-- they have coloured. Put either of them before this extension and it takes +-- the blocks whose language it knows; this one renders the rest, without +-- colouring but with the lines still pointed at. +-- +-- @since 0.3.0.0 +module Text.MMark.Extension.LineHighlight + ( lineHighlight, + parseLineSpec, + ) +where + +import Data.Text (Text) +import Data.Text qualified as T +import Lucid +import Text.MMark.Extension.Internal (lineSpec, withLineHighlight) +import Text.MMark.Render (Block (..), RenderExtension) +import Text.MMark.Render qualified as Render + +-- | Render a code block whose info string ends with a line specification, +-- giving the lines it names the class @\"highlighted-line\"@. +-- +-- The language, if there is one, still becomes the @language-@ class of the +-- @\@ element, so this composes with a style sheet written for the +-- usual output. +lineHighlight :: RenderExtension +lineHighlight = Render.blockRender $ \old block -> + case block of + b@(CodeBlock _ (Just info) txt) -> + case parseLineSpec info of + Nothing -> old b + Just (lang, ns) -> do + pre_ + $ code_ (langAttr lang) + $ mapM_ (line ns) (zip [1 :: Int ..] (T.lines txt)) + "\n" + other -> old other + where + langAttr = \case + Just l | not (T.null l) -> [class_ ("language-" <> l)] + _ -> [] + line ns (n, t) = withLineHighlight ns n (toHtml (t <> "\n")) + +-- | Split an info string into the language and the lines to point at. +-- Gives 'Nothing' when there is no line specification, so that an ordinary +-- code block is left to whatever renders it. +-- +-- > parseLineSpec "haskell {2,4-6}" == Just (Just "haskell", [2,4,5,6]) +parseLineSpec :: Text -> Maybe (Maybe Text, [Int]) +parseLineSpec = lineSpec diff --git a/Text/MMark/Extension/Link.hs b/Text/MMark/Extension/Link.hs new file mode 100644 --- /dev/null +++ b/Text/MMark/Extension/Link.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +-- | +-- Module : Text.MMark.Extension.Link +-- Copyright : © 2018–present Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Say where a link opens, and find the links that lead nowhere. +-- +-- 'linkTarget' is the only render extension here; the rest are checks. The +-- three checks cost increasingly more, so they are separate: checking +-- fragments needs nothing but the document, checking local files needs the +-- file system, and checking the rest needs whatever you are willing to do +-- to find out. +-- +-- @since 0.3.0.0 +module Text.MMark.Extension.Link + ( linkTarget, + headerIdScanner, + checkFragments, + checkLocalFiles, + checkExternal, + ) +where + +import Control.Foldl qualified as L +import Control.Monad.IO.Class (liftIO) +import Data.Foldable (asum) +import Data.Maybe (fromMaybe) +import Data.Set (Set) +import Data.Set qualified as S +import Data.Text qualified as T +import Lucid +import System.Directory (doesDirectoryExist, doesFileExist) +import System.FilePath (()) +import Text.MMark qualified as MMark +import Text.MMark.Extension.Internal (inlinesOf) +import Text.MMark.Render (RenderExtension) +import Text.MMark.Render qualified as Render +import Text.MMark.Trans (Block (..), Bni, Inline (..), Trans, TransT) +import Text.MMark.Trans qualified as Trans +import Text.URI (URI (..)) +import Text.URI qualified as URI + +-- | When the title of a link starts with the word @\"_blank\"@, +-- @\"_self\"@, @\"_parent\"@, or @\"_top\"@, it's stripped from the title (as +-- well as all whitespace after it) and added as the value of the @target@ +-- attribute of the resulting link. +-- +-- For example: +-- +-- > This [link](/url '_blank My title') opens in new tab. +-- +-- A link that opens in a new browsing context also gets +-- @rel=\"noopener noreferrer\"@. Without it the page that is opened can +-- reach back to the page that opened it through @window.opener@, and the +-- referrer is disclosed to it. +linkTarget :: RenderExtension +linkTarget = Render.inlineRender $ \old inline -> + case inline of + l@(Link spn 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' + -- Only a new browsing context can reach back through + -- window.opener, so the other targets do not need protecting. + relAttrs = + [rel_ "noopener noreferrer" | prefix == "_blank"] + return $ + with (old (Link spn txt url mtitle)) (target_ prefix : relAttrs) + other -> old other + +-- | Collect the ids MMark gives to the headings of a document, so that +-- 'checkFragments' can tell whether a link into the document leads +-- anywhere. +headerIdScanner :: L.Fold Bni (Set T.Text) +headerIdScanner = MMark.scanner S.empty $ \acc block -> + case block of + Heading1 _ x -> add x acc + Heading2 _ x -> add x acc + Heading3 _ x -> add x acc + Heading4 _ x -> add x acc + Heading5 _ x -> add x acc + Heading6 _ x -> add x acc + _ -> acc + where + add x = S.insert (Trans.headerId x) + +-- | Report every link of the form @#section@ whose fragment no heading of +-- the document defines. +-- +-- > let ids = MMark.runScanner headerIdScanner doc +-- > MMark.runTrans (checkFragments ids) doc +checkFragments :: Set T.Text -> Bni -> Trans Bni +checkFragments ids block = do + mapM_ check (links block) + return block + where + check (spn, uri) = case internalFragment uri of + Just f + | not (f `S.member` ids) -> + Trans.report + spn + ("no heading of this document has the id \"" <> f <> "\"") + _ -> return () + +-- | Report every link to a path that does not exist, relative to the given +-- directory. Links with a scheme or an authority are left to +-- 'checkExternal'. +checkLocalFiles :: FilePath -> Bni -> TransT IO Bni +checkLocalFiles base block = do + mapM_ check (links block) + return block + where + check (spn, uri) = case localPath uri of + Nothing -> return () + Just p -> do + let path = base T.unpack p + there <- liftIO $ (||) <$> doesFileExist path <*> doesDirectoryExist path + if there + then return () + else Trans.report spn ("there is nothing at " <> T.pack path) + +-- | Report every link the given action says is unreachable. The action is +-- yours to write, so that this package needs no HTTP client of its own and +-- so that you can cache, rate limit, or skip whatever you like. +-- +-- > checkExternal (\uri -> (== 200) . statusCode <$> headRequest uri) +checkExternal :: (URI -> IO Bool) -> Bni -> TransT IO Bni +checkExternal reachable block = do + mapM_ check (links block) + return block + where + check (spn, uri) = + case (URI.uriScheme uri, localPath uri, internalFragment uri) of + (Nothing, _, _) -> return () + (_, Just _, _) -> return () + (_, _, Just _) -> return () + _ -> do + ok <- liftIO (reachable uri) + if ok + then return () + else Trans.report spn ("cannot reach " <> URI.render uri) + +---------------------------------------------------------------------------- +-- Helpers + +-- | The links and images of a block, with the span to report against. +links :: Bni -> [(Trans.Span, URI)] +links = foldMap ofInline . inlinesOf + where + ofInline = \case + Link spn _ uri _ -> [(spn, uri)] + Image spn _ uri _ -> [(spn, uri)] + _ -> [] + +-- | The fragment of a URI that points into the document it appears in. +internalFragment :: URI -> Maybe T.Text +internalFragment uri = + case (uriScheme uri, uriAuthority uri, uriPath uri, uriFragment uri) of + (Nothing, Left False, Nothing, Just f) -> Just (URI.unRText f) + _ -> Nothing + +-- | The path of a URI that points at a file next to the document. +localPath :: URI -> Maybe T.Text +localPath uri = + case (uriScheme uri, uriAuthority uri, uriPath uri) of + (Nothing, Left False, Just (_, ps)) -> + Just (T.intercalate "/" (URI.unRText <$> foldr (:) [] ps)) + _ -> Nothing diff --git a/Text/MMark/Extension/LinkTarget.hs b/Text/MMark/Extension/LinkTarget.hs deleted file mode 100644 --- a/Text/MMark/Extension/LinkTarget.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} - --- | --- Module : Text.MMark.Extension.LinkTarget --- Copyright : © 2018–present Mark Karpov --- License : BSD 3 clause --- --- Maintainer : Mark Karpov --- Stability : experimental --- Portability : portable --- --- Specify the @target@ attribute of links in link titles. This allows us --- to, e.g. make a link open in a new tab. -module Text.MMark.Extension.LinkTarget - ( linkTarget, - ) -where - -import Data.Foldable (asum) -import Data.Maybe (fromMaybe) -import qualified Data.Text as T -import Lucid -import Text.MMark.Extension (Extension, Inline (..)) -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 diff --git a/Text/MMark/Extension/MathJax.hs b/Text/MMark/Extension/MathJax.hs --- a/Text/MMark/Extension/MathJax.hs +++ b/Text/MMark/Extension/MathJax.hs @@ -19,10 +19,10 @@ import Control.Monad import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Lucid -import Text.MMark.Extension (Block (..), Extension, Inline (..)) -import qualified Text.MMark.Extension as Ext +import Text.MMark.Render (Block (..), Inline (..), RenderExtension) +import Text.MMark.Render qualified as Ext -- | The extension allows us to transform inline code spans into MathJax -- inline spans and code blocks with the info string @\"mathjax\"@ @@ -37,16 +37,16 @@ mathJax :: -- | Starting\/ending character in MathJax inline spans Maybe Char -> - Extension + RenderExtension mathJax mch = mathJaxSpan mch <> mathJaxBlock -- | Turn code spans that start and end with a given character into MathJax -- inline spans. If 'Nothing' is provided instead of a char, apply the -- transformation to all code spans. -mathJaxSpan :: Maybe Char -> Extension +mathJaxSpan :: Maybe Char -> RenderExtension mathJaxSpan mch = Ext.inlineRender $ \old inline -> case inline of - s@(CodeSpan txt) -> + s@(CodeSpan _ txt) -> case mch of Nothing -> spn txt Just ch -> @@ -62,10 +62,10 @@ -- | Turn code blocks with info string @\"mathjax\"@ into MathJax display -- spans. -mathJaxBlock :: Extension +mathJaxBlock :: RenderExtension mathJaxBlock = Ext.blockRender $ \old block -> case block of - b@(CodeBlock mlabel txt) -> + b@(CodeBlock _ mlabel txt) -> if mlabel == Just "mathjax" then do p_ . forM_ (T.lines txt) $ \x -> diff --git a/Text/MMark/Extension/Mermaid.hs b/Text/MMark/Extension/Mermaid.hs new file mode 100644 --- /dev/null +++ b/Text/MMark/Extension/Mermaid.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Text.MMark.Extension.Mermaid +-- Copyright : © 2026–present Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Turn code blocks with the @mermaid@ info string into diagrams, either in +-- the browser or ahead of time. +-- +-- @since 0.3.0.0 +module Text.MMark.Extension.Mermaid + ( -- * In the browser + mermaid, + + -- * Ahead of time + mermaidScanner, + mermaidSvg, + ) +where + +import Control.Foldl qualified as L +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as M +import Data.Text (Text) +import Lucid +import Text.MMark qualified as MMark +import Text.MMark.Render (Block (..), Bni, RenderExtension, Span) +import Text.MMark.Render qualified as Render + +-- | Render a @mermaid@ code block as @\
@, which is
+-- what the mermaid script in the page looks for.
+mermaid :: RenderExtension
+mermaid = Render.blockRender $ \old block ->
+  case block of
+    b@(CodeBlock _ mlabel txt) ->
+      if mlabel == Just label
+        then pre_ [class_ label] (toHtml txt) >> "\n"
+        else old b
+    other -> old other
+
+-- | Collect the source of every @mermaid@ code block, by the span of the
+-- block it came from.
+--
+-- Hand the result to whatever turns a diagram into an SVG, then give the
+-- SVGs to 'mermaidSvg':
+--
+-- > srcs <- pure (MMark.runScanner mermaidScanner doc)
+-- > svgs <- traverse mermaidCli srcs
+-- > TL.putStr (renderText (MMark.render (mermaidSvg svgs) doc))
+--
+-- The span is the key because it is what tells two diagrams apart, even
+-- two that contain exactly the same source.
+mermaidScanner :: L.Fold Bni (Map Span Text)
+mermaidScanner = MMark.scanner M.empty $ \acc block ->
+  case block of
+    CodeBlock spn (Just l) txt | l == label -> M.insert spn txt acc
+    _ -> acc
+
+-- | Put the given SVG in place of the @mermaid@ code block it was made
+-- from. A block with no SVG is left as it is, so that a diagram that could
+-- not be rendered is still visible as its source.
+mermaidSvg :: Map Span Text -> RenderExtension
+mermaidSvg svgs = Render.blockRender $ \old block ->
+  case block of
+    b@(CodeBlock spn (Just l) _)
+      | l == label ->
+          case M.lookup spn svgs of
+            Just svg -> figure_ [class_ label] (toHtmlRaw svg) >> "\n"
+            Nothing -> old b
+    other -> old other
+
+label :: Text
+label = "mermaid"
diff --git a/Text/MMark/Extension/Metadata.hs b/Text/MMark/Extension/Metadata.hs
new file mode 100644
--- /dev/null
+++ b/Text/MMark/Extension/Metadata.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- |
+-- Module      :  Text.MMark.Extension.Metadata
+-- Copyright   :  © 2026–present Mark Karpov
+-- License     :  BSD 3 clause
+--
+-- Maintainer  :  Mark Karpov 
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- What a blog wants to know about a post: how long it is, how long it
+-- takes to read, and what to put on the card that appears when it is
+-- shared.
+--
+-- @since 0.3.0.0
+module Text.MMark.Extension.Metadata
+  ( Metadata (..),
+    metadataScanner,
+    readingTime,
+  )
+where
+
+import Control.Foldl qualified as L
+import Data.Text (Text)
+import Data.Text qualified as T
+import Text.MMark qualified as MMark
+import Text.MMark.Extension.Internal (inlinesOf)
+import Text.MMark.Trans (Block (..), Bni, Inline (..))
+import Text.MMark.Trans qualified as Trans
+import Text.URI (URI)
+
+-- | What 'metadataScanner' finds out about a document.
+data Metadata = Metadata
+  { -- | Number of words in the prose of the document
+    metaWords :: !Int,
+    -- | Text of the first paragraph, for the description of a card
+    metaLead :: Maybe Text,
+    -- | URI of the first image, for the picture on a card
+    metaImage :: Maybe URI,
+    -- | Text of the first level 1 heading, for the title
+    metaTitle :: Maybe Text
+  }
+  deriving (Eq, Show)
+
+instance Semigroup Metadata where
+  x <> y =
+    Metadata
+      { metaWords = metaWords x + metaWords y,
+        metaLead = firstOf metaLead,
+        metaImage = firstOf metaImage,
+        metaTitle = firstOf metaTitle
+      }
+    where
+      firstOf f = maybe (f y) Just (f x)
+
+instance Monoid Metadata where
+  mempty = Metadata 0 Nothing Nothing Nothing
+
+-- | Scan a document for its 'Metadata'.
+--
+-- > let meta = MMark.runScanner metadataScanner doc
+-- > putStrLn (show (readingTime 200 meta) <> " minute read")
+metadataScanner :: L.Fold Bni Metadata
+metadataScanner = MMark.scanner mempty $ \acc block ->
+  acc <> ofBlock block
+  where
+    ofBlock block =
+      mempty
+        { metaWords = wordsIn block,
+          metaLead = leadOf block,
+          metaImage = imageOf block,
+          metaTitle = titleOf block
+        }
+    wordsIn = length . T.words . T.unwords . fmap plainOf . inlinesOf
+    plainOf = \case
+      Plain _ t -> t
+      CodeSpan _ t -> t
+      _ -> ""
+    leadOf = \case
+      Paragraph _ xs -> Just (Trans.asPlainText xs)
+      _ -> Nothing
+    titleOf = \case
+      Heading1 _ xs -> Just (Trans.asPlainText xs)
+      _ -> Nothing
+    imageOf block = case [uri | Image _ _ uri _ <- inlinesOf block] of
+      (uri : _) -> Just uri
+      [] -> Nothing
+
+-- | How many minutes the document takes to read at the given number of
+-- words per minute, rounded up, and never less than one.
+readingTime ::
+  -- | Words per minute, 200 to 250 for most readers
+  Int ->
+  -- | Collected metadata
+  Metadata ->
+  Int
+readingTime wpm Metadata {..} =
+  max 1 ((metaWords + wpm - 1) `div` wpm)
diff --git a/Text/MMark/Extension/ObfuscateEmail.hs b/Text/MMark/Extension/ObfuscateEmail.hs
deleted file mode 100644
--- a/Text/MMark/Extension/ObfuscateEmail.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-
--- |
--- Module      :  Text.MMark.Extension.ObfuscateEmail
--- Copyright   :  © 2018–present Mark Karpov
--- License     :  BSD 3 clause
---
--- Maintainer  :  Mark Karpov 
--- Stability   :  experimental
--- Portability :  portable
---
--- Obfuscate email addresses.
-module Text.MMark.Extension.ObfuscateEmail
-  ( obfuscateEmail,
-  )
-where
-
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.Text (Text)
-import qualified Data.Text as T
-import Lucid
-import Text.MMark.Extension (Extension, Inline (..))
-import qualified Text.MMark.Extension as Ext
-import qualified Text.URI as URI
-import Text.URI.QQ (scheme, uri)
-
--- | This extension makes email addresses in autolinks be rendered as
--- something like this:
---
--- >     data-email="something@example.org"
--- >    href="javascript:void(0)">Enable JavaScript to see this email
---
--- 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 ::
-  -- | Name of class to assign to the links, e.g. @\"protected-email\"@
-  Text ->
-  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"
-                    (T.drop 7 (URI.render email))
-                ]
-        else old l
-    other -> old other
diff --git a/Text/MMark/Extension/Permalinks.hs b/Text/MMark/Extension/Permalinks.hs
new file mode 100644
--- /dev/null
+++ b/Text/MMark/Extension/Permalinks.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module      :  Text.MMark.Extension.Permalinks
+-- Copyright   :  © 2026–present Mark Karpov
+-- License     :  BSD 3 clause
+--
+-- Maintainer  :  Mark Karpov 
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Give every heading a link to itself, so that a reader can get a URL that
+-- points at the section they are looking at.
+--
+-- @since 0.3.0.0
+module Text.MMark.Extension.Permalinks
+  ( permalinks,
+    permalinksWith,
+  )
+where
+
+import Data.Text (Text)
+import Lucid
+import Lucid.Base (makeAttribute)
+import Text.MMark.Render (Block (..), Ois, RenderExtension, getOis)
+import Text.MMark.Render qualified as Render
+import Text.URI qualified as URI
+
+-- | Append to every heading a link to the id MMark gives that heading. The
+-- link is labelled @\"#\"@ and given the class @\"permalink\"@, so that a
+-- style sheet can show it only when the heading is hovered.
+permalinks :: RenderExtension
+permalinks = permalinksWith (const True) "permalink" Nothing "#"
+
+-- | Like 'permalinks', but you choose which headings get a link, the class
+-- it is given, what a screen reader makes of it, and what the reader sees.
+--
+-- The last of these is @'Html' ()@, so the link can be labelled with an
+-- icon rather than a character:
+--
+-- > permalinksWith (\n -> n >= 2 && n <= 4) "anchor" Nothing linkIcon
+--
+-- A link nothing is to be said about is hidden from a screen reader, and
+-- taken out of the order the keyboard walks: a link that is announced to
+-- nobody is of no use to someone who has landed on it. Say what it is
+-- instead to keep it in:
+--
+-- > permalinksWith (const True) "anchor" (Just "Link to this section") "#"
+permalinksWith ::
+  -- | Whether to give a heading of this level (1–6) a link
+  (Int -> Bool) ->
+  -- | Class to give the link
+  Text ->
+  -- | What a screen reader should say, if anything
+  Maybe Text ->
+  -- | What the reader sees
+  Html () ->
+  RenderExtension
+permalinksWith p klass spoken shown = Render.blockRender $ \old block ->
+  case block of
+    Heading1 spn x | p 1 -> old (Heading1 spn (anchor x))
+    Heading2 spn x | p 2 -> old (Heading2 spn (anchor x))
+    Heading3 spn x | p 3 -> old (Heading3 spn (anchor x))
+    Heading4 spn x | p 4 -> old (Heading4 spn (anchor x))
+    Heading5 spn x | p 5 -> old (Heading5 spn (anchor x))
+    Heading6 spn x | p 6 -> old (Heading6 spn (anchor x))
+    other -> old other
+  where
+    anchor (ois, html) = (ois, html <> link ois)
+    link :: Ois -> Html ()
+    link ois =
+      a_
+        ( href_ (URI.render (Render.headerFragment (Render.headerId (getOis ois))))
+            : class_ klass
+            : how
+        )
+        shown
+    how = case spoken of
+      Just t -> [makeAttribute "aria-label" t]
+      Nothing ->
+        [ makeAttribute "aria-hidden" "true",
+          makeAttribute "tabindex" "-1"
+        ]
diff --git a/Text/MMark/Extension/PunctuationPrettifier.hs b/Text/MMark/Extension/PunctuationPrettifier.hs
--- a/Text/MMark/Extension/PunctuationPrettifier.hs
+++ b/Text/MMark/Extension/PunctuationPrettifier.hs
@@ -18,9 +18,9 @@
 
 import Data.Char (isSpace)
 import Data.Text (Text)
-import qualified Data.Text as T
-import Text.MMark.Extension (Extension, Inline (..))
-import qualified Text.MMark.Extension as Ext
+import Data.Text qualified as T
+import Text.MMark.Trans (Bni, Inline (..), Trans)
+import Text.MMark.Trans qualified as Trans
 
 -- | Prettify punctuation (only affects plain text in inlines):
 --
@@ -32,10 +32,10 @@
 --     * 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
+punctuationPrettifier :: Bni -> Trans Bni
+punctuationPrettifier = Trans.bottomUpInlines $ \case
+  Plain spn txt -> return (Plain spn (T.unfoldr gen (True, txt)))
+  other -> return other
 
 gen ::
   -- | Whether the previous character was a space and remaining input
diff --git a/Text/MMark/Extension/Skylighting.hs b/Text/MMark/Extension/Skylighting.hs
--- a/Text/MMark/Extension/Skylighting.hs
+++ b/Text/MMark/Extension/Skylighting.hs
@@ -18,12 +18,13 @@
 
 import Control.Monad
 import Data.Text (Text)
-import qualified Data.Text as T
+import Data.Text qualified as T
 import Lucid
 import Skylighting (Token, TokenType (..))
-import qualified Skylighting as S
-import Text.MMark.Extension (Block (..), Extension)
-import qualified Text.MMark.Extension as Ext
+import Skylighting qualified as S
+import Text.MMark.Extension.Internal (infoStringParts, withLineHighlight)
+import Text.MMark.Render (Block (..), RenderExtension)
+import Text.MMark.Render qualified as Ext
 
 -- | Use the @skylighting@ package to render code blocks with info strings
 -- that result in a successful lookup from 'S.defaultSyntaxMap'.
@@ -61,16 +62,22 @@
 --     * 'VariableTok'       = @\"va\"@
 --     * 'VerbatimStringTok' = @\"vs\"@
 --     * 'WarningTok'        = @\"wa\"@
-skylighting :: Extension
+--
+-- The info string may end with a line specification, as in @haskell {2,4-6}@
+-- (see 'Text.MMark.Extension.LineHighlight.lineHighlight'). It does not stop
+-- the language from being recognized, and the lines it names are given the
+-- class @\"highlighted-line\"@ around the tokens of the line.
+skylighting :: RenderExtension
 skylighting = Ext.blockRender $ \old block ->
   case block of
-    cb@(CodeBlock (Just infoString') txt) ->
+    cb@(CodeBlock _ (Just infoString') txt) ->
       let tokenizerConfig =
             S.TokenizerConfig
               { S.syntaxMap = S.defaultSyntaxMap,
                 S.traceOutput = False
               }
-          infoString = T.replace "-" " " infoString'
+          (lang, highlighted) = infoStringParts infoString'
+          infoString = maybe "" (T.replace "-" " ") lang
        in case S.lookupSyntax infoString S.defaultSyntaxMap of
             Nothing -> old cb
             Just syntax ->
@@ -80,10 +87,11 @@
                   div_ [class_ "source-code"]
                     . pre_
                     . code_ [class_ ("language-" <> infoString)]
-                    . forM_ ls
-                    $ \l -> do
-                      mapM_ tokenToHtml l
-                      newline
+                    . forM_ (zip [1 ..] ls)
+                    $ \(n, l) ->
+                      withLineHighlight highlighted n $ do
+                        mapM_ tokenToHtml l
+                        newline
                   newline
     other -> old other
   where
diff --git a/Text/MMark/Extension/TableOfContents.hs b/Text/MMark/Extension/TableOfContents.hs
--- a/Text/MMark/Extension/TableOfContents.hs
+++ b/Text/MMark/Extension/TableOfContents.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 -- |
 -- Module      :  Text.MMark.Extension.TableOfContents
@@ -9,8 +10,8 @@
 -- Stability   :  experimental
 -- Portability :  portable
 --
--- Place this markup in markdown document where you want table of contents
--- to be inserted:
+-- Place this markup in a markdown document where you want a table of
+-- contents to be inserted:
 --
 -- > ```toc
 -- > ```
@@ -24,32 +25,33 @@
   )
 where
 
-import qualified Control.Foldl as L
+import Control.Foldl qualified as L
 import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty qualified as NE
 import Data.Maybe (maybeToList)
 import Data.Text (Text)
-import Text.MMark.Extension (Block (..), Bni, Extension, Inline (..))
-import qualified Text.MMark.Extension as Ext
+import Text.MMark qualified as MMark
+import Text.MMark.Trans (Block (..), Bni, Inline (..), Span, Trans)
+import Text.MMark.Trans qualified as Trans
 
--- | An opaque type representing table of contents produced by the
+-- | An opaque type representing a 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
+-- | The scanner builds a table of contents 'Toc' that can then be passed to
 -- 'toc' to obtain an extension that renders the table of contents in HTML.
 tocScanner ::
   -- | Whether to include a header of this level (1–6)
   (Int -> Bool) ->
   L.Fold Bni Toc
-tocScanner p = fmap (Toc . ($ [])) . Ext.scanner id $ \xs block ->
+tocScanner p = fmap (Toc . ($ [])) . MMark.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
+    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 =
@@ -59,31 +61,39 @@
 
 -- | Create an extension that replaces a certain code block with the
 -- previously constructed table of contents.
+--
+-- A document that asks for a table of contents but has no headings to put
+-- in one is reported at the code block that asks, because there is nothing
+-- to put in its place and leaving the block alone would render the marker
+-- into the page as an empty code block.
 toc ::
   -- | Label of the code block to replace by the table of contents
   Text ->
   -- | Previously generated by 'tocScanner'
   Toc ->
-  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
+  Bni ->
+  Trans Bni
+toc label (Toc xs) = Trans.bottomUpBlocks $ \case
+  old@(CodeBlock spn mlabel _)
+    | mlabel == pure label ->
+        case NE.nonEmpty xs of
+          Nothing -> do
+            Trans.report
+              spn
+              "there are no headings to put in the table of contents"
+            return old
+          Just ns -> return (renderToc spn ns)
+  other -> return other
 
--- | Construct 'Bni' for a table of contents from given collection of
+-- | Construct 'Bni' for a table of contents from a given collection of
 -- headers. This is a non-public helper.
-renderToc :: NonEmpty (Int, NonEmpty Inline) -> Bni
-renderToc = UnorderedList . NE.unfoldr f
+renderToc :: Span -> NonEmpty (Int, NonEmpty Inline) -> Bni
+renderToc spn = UnorderedList spn . 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),
+          url = Trans.headerFragment (Trans.headerId x)
+       in ( Naked spn (Link spn x url Nothing :| [])
+              : maybeToList (renderToc spn <$> NE.nonEmpty sitems),
             NE.nonEmpty fitems
           )
diff --git a/mmark-ext.cabal b/mmark-ext.cabal
--- a/mmark-ext.cabal
+++ b/mmark-ext.cabal
@@ -1,11 +1,11 @@
 cabal-version:   2.4
 name:            mmark-ext
-version:         0.2.1.5
+version:         0.3.0.0
 license:         BSD-3-Clause
 license-file:    LICENSE.md
 maintainer:      Mark Karpov 
 author:          Mark Karpov 
-tested-with:     ghc ==8.10.7 ghc ==9.0.2 ghc ==9.2.1
+tested-with:     ghc ==9.10.3 ghc ==9.12.4 ghc ==9.14.1
 homepage:        https://github.com/mmark-md/mmark-ext
 bug-reports:     https://github.com/mmark-md/mmark-ext/issues
 synopsis:        Commonly useful extensions for the MMark markdown processor
@@ -35,34 +35,45 @@
 library
     exposed-modules:
         Text.MMark.Extension.Common
+        Text.MMark.Extension.Emoji
+        Text.MMark.Extension.Heading
+        Text.MMark.Extension.Icons
+        Text.MMark.Extension.Image
+        Text.MMark.Extension.LineHighlight
+        Text.MMark.Extension.Link
+        Text.MMark.Extension.Mermaid
+        Text.MMark.Extension.Metadata
+        Text.MMark.Extension.Permalinks
         Text.MMark.Extension.Comment
-        Text.MMark.Extension.FontAwesome
         Text.MMark.Extension.Footnotes
         Text.MMark.Extension.GhcSyntaxHighlighter
         Text.MMark.Extension.Kbd
-        Text.MMark.Extension.LinkTarget
         Text.MMark.Extension.MathJax
-        Text.MMark.Extension.ObfuscateEmail
         Text.MMark.Extension.PunctuationPrettifier
         Text.MMark.Extension.Skylighting
         Text.MMark.Extension.TableOfContents
 
-    default-language: Haskell2010
+    other-modules:    Text.MMark.Extension.Internal
+    default-language: GHC2021
     build-depends:
-        base >=4.13 && <5.0,
+        base >=4.16 && <5,
+        bytestring >=0.10 && <0.13,
+        containers >=0.5 && <0.9,
+        directory >=1.2 && <1.4,
+        filepath >=1.4 && <1.6,
         foldl >=1.2 && <1.5,
         ghc-syntax-highlighter >=0.0.1 && <0.1,
-        lucid >=2.9.13 && <3.0,
-        microlens >=0.4 && <0.5,
-        mmark >=0.0.4 && <=0.1,
+        lucid >=2.9.13 && <3,
+        microlens >=0.4 && <0.6,
+        mmark >=0.1 && <0.2,
         modern-uri >=0.3.4.4 && <0.4,
-        skylighting >=0.7.6 && <0.13,
-        text >=0.2 && <1.3
+        skylighting >=0.7.6 && <0.15,
+        text >=0.2 && <2.2
 
     if flag(dev)
         ghc-options:
-            -O0 -Wall -Werror -Wcompat -Wincomplete-record-updates
-            -Wincomplete-uni-patterns -Wnoncanonical-monad-instances
+            -Wall -Werror -Wredundant-constraints -Wpartial-fields
+            -Wunused-packages -haddock -Winvalid-haddock
 
     else
         ghc-options: -O2 -Wall
@@ -74,30 +85,43 @@
     hs-source-dirs:     tests
     other-modules:
         Text.MMark.Extension.CommentSpec
-        Text.MMark.Extension.FontAwesomeSpec
+        Text.MMark.Extension.EmojiSpec
+        Text.MMark.Extension.HeadingSpec
+        Text.MMark.Extension.IconsSpec
+        Text.MMark.Extension.ImageSpec
+        Text.MMark.Extension.LineHighlightSpec
+        Text.MMark.Extension.LinkSpec
+        Text.MMark.Extension.MermaidSpec
+        Text.MMark.Extension.MetadataSpec
+        Text.MMark.Extension.PermalinksSpec
         Text.MMark.Extension.FootnotesSpec
         Text.MMark.Extension.GhcSyntaxHighlighterSpec
         Text.MMark.Extension.KbdSpec
-        Text.MMark.Extension.LinkTargetSpec
         Text.MMark.Extension.MathJaxSpec
-        Text.MMark.Extension.ObfuscateEmailSpec
         Text.MMark.Extension.PunctuationPrettifierSpec
         Text.MMark.Extension.SkylightingSpec
         Text.MMark.Extension.TableOfContentsSpec
         Text.MMark.Extension.TestUtils
 
-    default-language:   Haskell2010
+    default-language:   GHC2021
     build-depends:
-        base >=4.13 && <5.0,
-        hspec >=2.0 && <3.0,
-        lucid >=2.9.13 && <3.0,
-        mmark >=0.0.4 && <=0.1,
+        base >=4.16 && <5,
+        bytestring >=0.10 && <0.13,
+        containers >=0.5 && <0.9,
+        directory >=1.2 && <1.4,
+        filepath >=1.4 && <1.6,
+        hspec >=2 && <3,
+        lucid >=2.9.13 && <3,
+        megaparsec >=8 && <10,
+        mmark >=0.1 && <0.2,
         mmark-ext,
-        skylighting >=0.7.6 && <0.13,
-        text >=0.2 && <1.3
+        modern-uri >=0.3.4.4 && <0.4,
+        text >=0.2 && <2.2
 
     if flag(dev)
-        ghc-options: -O0 -Wall -Werror
+        ghc-options:
+            -Wall -Werror -Wredundant-constraints -Wpartial-fields
+            -Wunused-packages -haddock -Winvalid-haddock
 
     else
         ghc-options: -O2 -Wall
diff --git a/tests/Text/MMark/Extension/CommentSpec.hs b/tests/Text/MMark/Extension/CommentSpec.hs
--- a/tests/Text/MMark/Extension/CommentSpec.hs
+++ b/tests/Text/MMark/Extension/CommentSpec.hs
@@ -10,12 +10,12 @@
 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` "
First.
\n
Third.
\n"
-    context "when it is not in plain text" $
-      it "has no special effect" $
-        "[$$$ link](/url) foo." `to` "
$$$ link foo.
\n"
+    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` "
First.
\n
Third.
\n"
+    context "when it is not in plain text"
+      $ it "has no special effect"
+      $ "[$$$ link](/url) foo." `to` "
$$$ link foo.
\n"
diff --git a/tests/Text/MMark/Extension/EmojiSpec.hs b/tests/Text/MMark/Extension/EmojiSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMark/Extension/EmojiSpec.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.MMark.Extension.EmojiSpec (spec) where
+
+import Data.Map.Strict qualified as M
+import Test.Hspec
+import Text.MMark.Extension.Emoji
+import Text.MMark.Extension.TestUtils
+
+spec :: Spec
+spec = do
+  emojiSpec
+  emojiWithSpec
+
+emojiSpec :: Spec
+emojiSpec = describe "emoji" $ do
+  it "replaces a shortcode it knows" $
+    withTrans emoji "Hi :smile: there" "
Hi \128578 there
\n"
+  it "replaces several in one go" $
+    withTrans emoji ":fire: :rocket:" "
\128293 \128640
\n"
+  it "replaces one that is more than one code point" $
+    withTrans emoji ":warning:" "
\9888\65039
\n"
+  it "replaces a shortcode that is an alias of another" $
+    withTrans emoji ":joy: :laughing:" "
\128514 \128514
\n"
+  it "replaces one whose name is not letters" $
+    withTrans emoji ":+1: :100:" "
\128077 \128175
\n"
+  it "reports a shortcode it does not know" $
+    transErrors emoji "Hi :nosuch: there"
+      `shouldReturn` ["1:1: there is no emoji called \"nosuch\""]
+  it "leaves a lone colon alone" $
+    withTrans emoji "at 12:30 sharp" "
at 12:30 sharp
\n"
+  it "leaves text with no colons alone" $
+    withTrans emoji "nothing here" "
nothing here
\n"
+  it "leaves a shortcode in a code span alone" $
+    withTrans emoji "`:smile:`" "
:smile:
\n"
+  it "replaces a shortcode nested in other markup" $
+    withTrans emoji "**:fire:**" "
\128293
\n"
+  it "reports every unknown shortcode, not just the first" $
+    transErrors emoji ":nosuch: and :neither:"
+      `shouldReturn` [ "1:1: there is no emoji called \"nosuch\"",
+                       "1:1: there is no emoji called \"neither\""
+                     ]
+
+emojiWithSpec :: Spec
+emojiWithSpec = describe "emojiWith" $ do
+  it "uses the table it is given" $
+    withTrans (emojiWith table) "look :cat:" "
look \128049
\n"
+  it "reports a shortcode the table does not have" $
+    transErrors (emojiWith table) ":smile:"
+      `shouldReturn` ["1:1: there is no emoji called \"smile\""]
+  it "reports nothing for a table that has everything" $
+    transErrors (emojiWith table) ":cat: :dog:" `shouldReturn` []
+  it "reports every unknown shortcode of a paragraph" $
+    transErrors (emojiWith table) ":nope: and :also:"
+      `shouldReturn` [ "1:1: there is no emoji called \"nope\"",
+                       "1:1: there is no emoji called \"also\""
+                     ]
+  it "replaces nothing when the table is empty" $
+    withTrans (emojiWith mempty) "no colons here" "
no colons here
\n"
+  where
+    table = M.fromList [("cat", "\128049"), ("dog", "\128054")]
diff --git a/tests/Text/MMark/Extension/FontAwesomeSpec.hs b/tests/Text/MMark/Extension/FontAwesomeSpec.hs
deleted file mode 100644
--- a/tests/Text/MMark/Extension/FontAwesomeSpec.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# 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
-        "" `to` "
fa:
\n"
-        "" `to` "
\n"
-        "" `to` "
\n"
-        "" `to` "
\n"
-    context "when URI has some other scheme" $
-      it "produces the correct HTML" $
-        "" `to` "
https://example.org
\n"
-    context "other elements" $
-      it "not affected" $
-        "Something." `to` "
Something.
\n"
diff --git a/tests/Text/MMark/Extension/FootnotesSpec.hs b/tests/Text/MMark/Extension/FootnotesSpec.hs
--- a/tests/Text/MMark/Extension/FootnotesSpec.hs
+++ b/tests/Text/MMark/Extension/FootnotesSpec.hs
@@ -2,7 +2,9 @@
 
 module Text.MMark.Extension.FootnotesSpec (spec) where
 
+import Data.Text (Text)
 import Test.Hspec
+import Text.MMark qualified as MMark
 import Text.MMark.Extension.Footnotes
 import Text.MMark.Extension.TestUtils
 
@@ -10,23 +12,63 @@
 spec =
   describe "footnotes" $ do
     let to = withExt footnotes
-    context "when link has no scheme" $
-      it "has no effect" $
-        "Link [link](1)."
-          `to` "
Link link.
\n"
-    context "when link has not \"footnote\" scheme" $
-      it "has no effect" $
-        "Link [link](https:1)"
-          `to` "
Link link
\n"
-    context "when link has \"footnote\" scheme" $
-      it "transforms the link correctly" $
-        "Link [link](footnote:1)"
-          `to` "
Link 1
\n"
-    context "when block quotes are not formatted correctly" $
-      it "has no effect" $
-        "> blah"
-          `to` "
\n
blah
\n
\n"
-    context "when block quotes are formatted correctly" $
-      it "transforms them into footnotes" $
-        "> footnotes\n\n  1. Something.\n"
-          `to` "
    \n
  1. \nSomething.\n↩
    2. \n
\n"
+    context "when link has no scheme"
+      $ it "has no effect"
+      $ "Link [link](1)."
+        `to` "
Link link.
\n"
+    context "when link has not \"footnote\" scheme"
+      $ it "has no effect"
+      $ "Link [link](https:1)"
+        `to` "
Link link
\n"
+    context "when link has \"footnote\" scheme"
+      $ it "transforms the link correctly"
+      $ "Link [link](footnote:1)"
+        `to` "
Link 1
\n"
+    context "when block quotes are not formatted correctly"
+      $ it "has no effect"
+      $ "> blah"
+        `to` "
\n
blah
\n
\n"
+    context "when block quotes are formatted correctly"
+      $ it "transforms them into footnotes"
+      $ "> footnotes\n>\n> 1. Something.\n"
+        `to` "
    \n
  1. \nSomething.\n↩
    2. \n
\n"
+    context "validation" $ do
+      it "accepts a document whose footnotes all line up" $
+        check "Text [1](footnote:1).\n\n> footnotes\n>\n> 1. The note.\n"
+          `shouldReturn` []
+      it "reports a reference to a footnote that does not exist" $
+        check "Text [2](footnote:2).\n\n> footnotes\n>\n> 1. The note.\n"
+          `shouldReturn` ["1:6: there is no footnote 2", "5:6: nothing refers to footnote 1"]
+      it "reports a footnote nothing refers to" $
+        check "Text.\n\n> footnotes\n>\n> 1. Orphan.\n"
+          `shouldReturn` ["5:6: nothing refers to footnote 1"]
+      it "reports a footnote that is referred to more than once" $
+        check "A [1](footnote:1) and B [1](footnote:1).\n\n> footnotes\n>\n> 1. N.\n"
+          `shouldReturn` [ "1:25: footnote 1 is referred to more than once, which would give the references the same id"
+                         ]
+      it "reports a reference whose path is not a number" $
+        check "Text [x](footnote:abc).\n\n> footnotes\n>\n> 1. N.\n"
+          `shouldReturn` [ "1:6: a footnote reference must have a single number as its path",
+                           "5:6: nothing refers to footnote 1"
+                         ]
+      it "reaches references nested inside other inlines" $
+        check "T [1](footnote:1) *and [2](footnote:2)*.\n\n> footnotes\n>\n> 1. A.\n> 2. B.\n"
+          `shouldReturn` []
+      it "reports every problem exactly once" $
+        check "[9](footnote:9)\n\nSome text.\n\nMore text.\n"
+          `shouldReturn` ["1:1: there is no footnote 9"]
+      -- The footnotes of the second section are the same numbers as those
+      -- of the first, so they are not counted twice; the document is
+      -- already reported as having more than one section.
+      it "reports a second footnote section" $
+        check "> footnotes\n>\n> 1. A.\n\n> footnotes\n>\n> 1. B.\n"
+          `shouldReturn` [ "3:6: nothing refers to footnote 1",
+                           "5:1: there is more than one footnote section"
+                         ]
+
+-- | Validate the footnotes of a document, returning one @line:col: message@
+-- string per reported problem.
+check :: Text -> IO [Text]
+check input = do
+  Right doc <- pure (MMark.parse "" input)
+  checkErrors (validateFootnotes (MMark.runScanner footnoteScanner doc)) input
diff --git a/tests/Text/MMark/Extension/GhcSyntaxHighlighterSpec.hs b/tests/Text/MMark/Extension/GhcSyntaxHighlighterSpec.hs
--- a/tests/Text/MMark/Extension/GhcSyntaxHighlighterSpec.hs
+++ b/tests/Text/MMark/Extension/GhcSyntaxHighlighterSpec.hs
@@ -2,6 +2,7 @@
 
 module Text.MMark.Extension.GhcSyntaxHighlighterSpec (spec) where
 
+import Data.Text qualified as T
 import Test.Hspec
 import Text.MMark.Extension.GhcSyntaxHighlighter
 import Text.MMark.Extension.TestUtils
@@ -10,7 +11,42 @@
 spec =
   describe "ghcSyntaxHighlighter" $ do
     let to = withExt ghcSyntaxHighlighter
-    context "with info string is \"haskell\"" $
-      it "renders it correctly" $
-        "```haskell\nmain :: IO ()\nmain = return ()\n```\n"
-          `to` "
main :: IO ()\nmain = return ()\n
\n"
+    context "with info string is \"haskell\""
+      $ it "renders it correctly"
+      $ "```haskell\nmain :: IO ()\nmain = return ()\n```\n"
+        `to` "
main :: IO ()\nmain = return ()\n
\n"
+    context "when the info string ends with a line specification" $ do
+      it "still recognizes the language, and points at the line" $
+        "```haskell {2}\nmain :: IO ()\nmain = return ()\n```\n"
+          `to` T.concat
+            [ "
",
+              "main :: IO ()\n",
+              "",
+              "main = return ()\n",
+              "",
+              "
\n"
+            ]
+      it "does not take a specification that names no line for one" $
+        -- there is no such thing as pointing at nothing, so this is a
+        -- malformed info string and the whole of it names the language
+        "```haskell {}\nmain :: IO ()\nmain = return ()\n```\n"
+          `to` "
main :: IO ()\nmain = return ()\n
\n"
+      it "counts the lines the way Data.Text.lines does" $
+        -- a trailing newline ends the last line, it does not start another,
+        -- so there is no line 3 here to point at
+        "```haskell {3}\nmain :: IO ()\nmain = return ()\n```\n"
+          `to` "
main :: IO ()\nmain = return ()\n
\n"
+      it "cuts a token that runs across lines at the newline" $
+        -- the comment is one token spanning two lines; pointing at the
+        -- second of them must not swallow the first
+        "```haskell {2}\nx = 1\n{- a\nb -}\n```\n"
+          `to` T.concat
+            [ "
",
+              "x = 1\n",
+              "{- a\n",
+              "b -}\n",
+              "
\n"
+            ]
+      it "leaves a block of another language alone" $
+        "```rust {1}\nfn main() {}\n```\n"
+          `to` "
fn main() {}\n
\n"
diff --git a/tests/Text/MMark/Extension/HeadingSpec.hs b/tests/Text/MMark/Extension/HeadingSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMark/Extension/HeadingSpec.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.MMark.Extension.HeadingSpec (spec) where
+
+import Data.Text (Text)
+import Data.Text qualified as T
+import Test.Hspec
+import Text.MMark qualified as MMark
+import Text.MMark.Extension.Heading
+import Text.MMark.Extension.TestUtils
+
+spec :: Spec
+spec = do
+  describe "checkHeadings" $ do
+    it "reports a heading that skips a level" $
+      headingErrors "# A\n\n### B"
+        `shouldReturn` [ "3:1: this heading is of level 3, but the one before it is of level 1, so the outline of the document skips a level"
+                       ]
+    it "reports a second level 1 heading" $
+      headingErrors "# A\n\n# B"
+        `shouldReturn` ["3:1: there is more than one level 1 heading in this document"]
+    it "reports two headings that get the same id" $
+      headingErrors "# A\n\n## A"
+        `shouldReturn` ["3:1: another heading is already given the id \"a\""]
+    it "accepts a well formed outline" $
+      headingErrors "# A\n\n## B\n\n### C\n\n## D" `shouldReturn` []
+    it "reports each problem exactly once" $
+      headingErrors "# A\n\nSome text.\n\nMore text.\n\n### B"
+        `shouldReturn` [ "7:1: this heading is of level 3, but the one before it is of level 1, so the outline of the document skips a level"
+                       ]
+
+  describe "headingProblems" $ do
+    it "finds nothing in a document with no headings" $
+      problems "just some text" `shouldBe` []
+    it "finds nothing in a well formed outline" $
+      problems "# A\n\n## B\n\n### C\n\n## D" `shouldBe` []
+    it "accepts an outline that comes back up several levels at once" $
+      problems "# A\n\n## B\n\n### C\n\n## D\n\n# E" `shouldBe` ["title"]
+    it "accepts a document that starts below level 1" $
+      problems "## A\n\n### B" `shouldBe` []
+    it "names the level a heading skips to and from" $
+      problems "## A\n\n##### B" `shouldBe` ["skip"]
+    it "finds a problem of each kind at once" $
+      problems "# A\n\n### B\n\n# A" `shouldBe` ["skip", "title", "collision"]
+    it "reports the problems in the order they appear" $
+      problems "# A\n\n# B\n\n### C"
+        `shouldBe` ["title", "skip"]
+    it "finds a collision between headings of different levels" $
+      problems "# Same\n\n## Same" `shouldBe` ["collision"]
+    it "reports every heading after the first that shares an id" $
+      problems "## A\n\n## A\n\n## A" `shouldBe` ["collision", "collision"]
+    it "sees headings inside a block quote as part of the outline" $
+      problems "# A\n\n> ### B" `shouldBe` []
+
+-- | Scan a document for its headings and check them.
+headingErrors :: Text -> IO [Text]
+headingErrors input = do
+  Right doc <- pure (MMark.parse "" input)
+  checkErrors (checkHeadings (MMark.runScanner headingScanner doc)) input
+
+-- | The problems of a document, each named by its kind so that a test does
+-- not have to repeat the whole message.
+problems :: Text -> [Text]
+problems input = kindOf . snd <$> headingProblems (scan input)
+  where
+    scan t = case MMark.parse "" t of
+      Left _ -> error "the test input does not parse"
+      Right doc -> MMark.runScanner headingScanner doc
+    kindOf msg
+      | "skips a level" `T.isSuffixOf` msg = "skip"
+      | "more than one level 1" `T.isInfixOf` msg = "title"
+      | "already given the id" `T.isInfixOf` msg = "collision"
+      | otherwise = msg
diff --git a/tests/Text/MMark/Extension/IconsSpec.hs b/tests/Text/MMark/Extension/IconsSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMark/Extension/IconsSpec.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Text.MMark.Extension.IconsSpec (spec) where
+
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as M
+import Data.Text (Text)
+import Lucid
+import Test.Hspec
+import Text.MMark.Extension.Icons
+import Text.MMark.Extension.TestUtils
+import Text.URI.QQ (scheme)
+
+spec :: Spec
+spec = do
+  describe "icons" $ do
+    let to = withExt (icons table)
+    it "puts the SVG of an autolink in place of it" $
+      ""
+        `to` "
\n"
+    it "labels an icon that has link text" $
+      "[GitHub](icon:github)"
+        `to` "
\n"
+    it "turns the rest of the path into classes" $
+      ""
+        `to` "
\n"
+    it "leaves an icon it does not have as a link" $
+      "" `to` "
icon:nosuch
\n"
+    it "leaves a link with no icon name alone" $
+      "" `to` "
icon:
\n"
+    it "leaves a link of another scheme alone" $
+      ""
+        `to` "
https://example.org
\n"
+    it "leaves other inlines alone" $
+      "Something." `to` "
Something.
\n"
+  describe "iconsWith" $ do
+    let to = withExt (iconsWith [scheme|fa|] "fa" table)
+    it "uses the scheme and the prefix it is given" $
+      ""
+        `to` "
\n"
+    it "leaves the scheme it replaces alone" $
+      "" `to` "
icon:github
\n"
+  describe "checkIcons" $ do
+    it "reports an icon it does not have" $
+      transErrors (checkIcons table) "See  there"
+        `shouldReturn` ["1:5: there is no icon called \"nosuch\""]
+    it "reports a link that names no icon" $
+      transErrors (checkIcons table) "See  there"
+        `shouldReturn` ["1:5: this link names no icon"]
+    it "says nothing about an icon it has" $
+      transErrors (checkIcons table) "See  there"
+        `shouldReturn` []
+    it "says nothing about a link of another scheme" $
+      transErrors (checkIcons table) "See  there"
+        `shouldReturn` []
+  describe "checkIconsWith"
+    $ it "uses the scheme it is given"
+    $ transErrors (checkIconsWith [scheme|fa|] table) "See  there"
+      `shouldReturn` ["1:5: there is no icon called \"nosuch\""]
+
+-- | An icon table with something recognizable in it. Raw SVG is how an icon
+-- usually arrives, so that is what the table holds here.
+table :: Map Text (Html ())
+table = toHtmlRaw <$> M.fromList [("github", "" :: Text)]
diff --git a/tests/Text/MMark/Extension/ImageSpec.hs b/tests/Text/MMark/Extension/ImageSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMark/Extension/ImageSpec.hs
@@ -0,0 +1,242 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.MMark.Extension.ImageSpec (spec) where
+
+import Data.Bits (shiftR, (.&.))
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as B
+import Data.ByteString.Char8 qualified as B8
+import Data.Map.Strict qualified as M
+import Data.Text (Text)
+import Data.Word (Word8)
+import System.FilePath (())
+import Test.Hspec
+import Text.MMark qualified as MMark
+import Text.MMark.Extension.Image
+import Text.MMark.Extension.TestUtils
+import Text.MMark.Trans (Span)
+import Text.URI qualified as URI
+
+spec :: Spec
+spec = do
+  describe "checkAltText" $ do
+    it "reports an image with no description" $
+      transErrors checkAltText "![](/a.png)"
+        `shouldReturn` ["1:1: this image has no description for the alt attribute"]
+    it "accepts an image with a description" $
+      transErrors checkAltText "![a cat](/a.png)" `shouldReturn` []
+    it "reports an image nested in a link" $
+      transErrors checkAltText "[![](/a.png)](/x)"
+        `shouldReturn` ["1:2: this image has no description for the alt attribute"]
+    it "finds an image inside a block quote" $
+      transErrors checkAltText "> ![](/a.png)"
+        `shouldReturn` ["1:3: this image has no description for the alt attribute"]
+    it "reports every undescribed image, once each" $
+      transErrors checkAltText "![](/a.png) ![b](/b.png) ![](/c.png)"
+        `shouldReturn` [ "1:1: this image has no description for the alt attribute",
+                         "1:26: this image has no description for the alt attribute"
+                       ]
+
+  describe "lazyImages" $ do
+    it "adds the loading and decoding attributes" $
+      withExt
+        lazyImages
+        "![a cat](/a.png)"
+        "
\"a
\n"
+    it "leaves other inlines alone" $
+      withExt lazyImages "[a link](/x)" "
a link
\n"
+
+  describe "imageScanner" $ do
+    it "collects the URI of an image" $
+      scanned "![a cat](/a.png)" `shouldBe` ["/a.png"]
+    it "collects every image of a document" $
+      scanned "![a](/a.png)\n\n![b](/b.png)" `shouldBe` ["/a.png", "/b.png"]
+    it "collects an image nested in a link and in a quote" $
+      scanned "[![a](/a.png)](/x)\n\n> ![b](/b.png)"
+        `shouldBe` ["/a.png", "/b.png"]
+    it "keeps two images with the same URI apart" $
+      length (M.toList (scan "![a](/a.png) ![a](/a.png)")) `shouldBe` 2
+    it "collects nothing from a document with no images" $
+      scanned "just some text" `shouldBe` []
+
+  describe "imageDimensions" $ do
+    it "gives an image the size it was measured to have" $
+      withSizes
+        (Just (640, 480))
+        "![a cat](/a.png)"
+        "
\"a
\n"
+    it "leaves an image that could not be measured alone" $
+      withSizes
+        Nothing
+        "![a cat](/a.png)"
+        "
\"a
\n"
+    it "leaves an image with no measurement at all alone" $
+      withExt
+        (imageDimensions M.empty)
+        "![a cat](/a.png)"
+        "
\"a
\n"
+    it "composes with lazyImages" $
+      withSizesUsing
+        (lazyImages <>)
+        (Just (7, 3))
+        "![a cat](/a.png)"
+        "
\"a
\n"
+
+  describe "imageSizeOf" $ do
+    it "measures a PNG" $
+      measuring (pngBytes 7 3) `shouldReturn` Just (7, 3)
+    it "measures a PNG larger than a byte in each direction" $
+      measuring (pngBytes 1920 1080) `shouldReturn` Just (1920, 1080)
+    it "measures a GIF" $
+      measuring (gifBytes 11 5) `shouldReturn` Just (11, 5)
+    it "measures a GIF larger than a byte in each direction" $
+      measuring (gifBytes 800 600) `shouldReturn` Just (800, 600)
+    it "measures a JPEG" $
+      measuring (jpegBytes [] 13 9) `shouldReturn` Just (13, 9)
+    it "measures a JPEG behind a segment it does not care about" $
+      measuring (jpegBytes [app0, comment 40] 320 240)
+        `shouldReturn` Just (320, 240)
+    it "measures a JPEG behind a marker that carries no payload" $
+      -- 0xD8 is SOI, whose two following bytes are not a length; a walk
+      -- that reads them as one lands in the middle of nothing.
+      measuring (jpegBytes [app0, standalone 0xD8, comment 8] 64 48)
+        `shouldReturn` Just (64, 48)
+    it "measures a JPEG whose frame is not the baseline one" $
+      -- SOF2, the progressive frame header
+      measuring (jpegBytesWith 0xC2 [app0] 21 12) `shouldReturn` Just (21, 12)
+    it "does not mistake a huffman table for a frame" $
+      -- 0xC4 is in the SOF range by number but is not a frame
+      measuring (jpegBytes [tableNotAFrame] 30 20) `shouldReturn` Just (30, 20)
+    it "gives up on a JPEG that ends before its frame" $
+      measuring (B.pack [0xFF, 0xD8] <> app0) `shouldReturn` Nothing
+    it "gives up on a JPEG whose segment lengths are nonsense" $
+      -- a segment that claims to be no bytes long, then one that claims to
+      -- run past the end of the file
+      measuring
+        ( B.pack [0xFF, 0xD8, 0xFF, 0xE0, 0x00, 0x00]
+            <> B.replicate 8 0x20
+            <> B.pack [0xFF, 0xC0]
+            <> be16 11
+            <> B.pack [8]
+            <> be16 99
+            <> be16 99
+            <> B.pack [1, 1, 0x11, 0]
+        )
+        `shouldReturn` Nothing
+    it "gives up on a file that is not an image" $
+      measuring (B8.pack "just some text, not an image at all")
+        `shouldReturn` Nothing
+    it "gives up on an empty file" $
+      measuring B.empty `shouldReturn` Nothing
+    it "gives up on a truncated PNG" $
+      measuring (B.take 20 (pngBytes 7 3)) `shouldReturn` Nothing
+    it "gives up on a truncated GIF" $
+      measuring (B.take 8 (gifBytes 11 5)) `shouldReturn` Nothing
+    it "gives up on a file that is not there instead of throwing" $
+      withTempDir (\dir -> imageSizeOf (dir  "nope.png"))
+        `shouldReturn` Nothing
+    it "gives up on a directory instead of throwing" $
+      withTempDir imageSizeOf `shouldReturn` Nothing
+
+----------------------------------------------------------------------------
+-- Helpers
+
+-- | Scan a document and return the URI of every image it has, in order.
+scanned :: Text -> [Text]
+scanned = fmap URI.render . M.elems . scan
+
+scan :: Text -> M.Map Span URI.URI
+scan input = case MMark.parse "" input of
+  Left _ -> error "the test input does not parse"
+  Right doc -> MMark.runScanner imageScanner doc
+
+-- | Render a document with every image measured as the given size.
+withSizes :: Maybe (Int, Int) -> Text -> Text -> Expectation
+withSizes = withSizesUsing id
+
+withSizesUsing ::
+  -- | What else to render with
+  (MMark.RenderExtension -> MMark.RenderExtension) ->
+  -- | The size every image is measured to have
+  Maybe (Int, Int) ->
+  -- | Input for the parser
+  Text ->
+  -- | Expected output of the render
+  Text ->
+  Expectation
+withSizesUsing f size input expected =
+  withExt (f (imageDimensions (size <$ scan input))) input expected
+
+-- | The bytes of a PNG of the given size: the signature and the @IHDR@
+-- chunk, which is all that states the size.
+pngBytes :: Int -> Int -> ByteString
+pngBytes w h =
+  B.pack [137, 80, 78, 71, 13, 10, 26, 10]
+    <> be32 13
+    <> B8.pack "IHDR"
+    <> be32 w
+    <> be32 h
+    <> B.pack [8, 2, 0, 0, 0]
+
+-- | The bytes of a GIF of the given size: the signature and the logical
+-- screen descriptor.
+gifBytes :: Int -> Int -> ByteString
+gifBytes w h = B8.pack "GIF89a" <> le16 w <> le16 h <> B.pack [0, 0, 0]
+
+-- | The bytes of a JPEG of the given size: @SOI@, the given segments, then
+-- a baseline frame header.
+jpegBytes :: [ByteString] -> Int -> Int -> ByteString
+jpegBytes = jpegBytesWith 0xC0
+
+-- | Like 'jpegBytes', but you choose which frame header states the size.
+jpegBytesWith :: Word8 -> [ByteString] -> Int -> Int -> ByteString
+jpegBytesWith marker leading w h =
+  B.pack [0xFF, 0xD8] <> B.concat leading <> sof <> B.pack [0xFF, 0xD9]
+  where
+    sof =
+      B.pack [0xFF, marker]
+        <> be16 11
+        <> B.pack [8]
+        <> be16 h
+        <> be16 w
+        <> B.pack [1, 1, 0x11, 0]
+
+-- | A @JFIF@ header, the segment that usually comes first.
+app0 :: ByteString
+app0 =
+  B.pack [0xFF, 0xE0]
+    <> be16 16
+    <> B8.pack "JFIF\NUL"
+    <> B.pack [1, 1, 0, 0, 1, 0, 1, 0, 0]
+
+-- | A comment segment carrying the given number of bytes of padding.
+comment :: Int -> ByteString
+comment n = B.pack [0xFF, 0xFE] <> be16 (n + 2) <> B.replicate n 0x20
+
+-- | A marker that carries no payload at all.
+standalone :: Word8 -> ByteString
+standalone m = B.pack [0xFF, m]
+
+-- | A huffman table, which sits in the range the frame headers occupy but
+-- is not one of them.
+tableNotAFrame :: ByteString
+tableNotAFrame = B.pack [0xFF, 0xC4] <> be16 6 <> B.replicate 4 0
+
+-- | Write the given bytes to a file and measure it.
+measuring :: ByteString -> IO (Maybe (Int, Int))
+measuring bs = withTempDir $ \dir -> do
+  let path = dir  "image"
+  B.writeFile path bs
+  imageSizeOf path
+
+be32 :: Int -> ByteString
+be32 n = B.pack (fmap (byte n) [24, 16, 8, 0])
+
+be16 :: Int -> ByteString
+be16 n = B.pack (fmap (byte n) [8, 0])
+
+le16 :: Int -> ByteString
+le16 n = B.pack (fmap (byte n) [0, 8])
+
+byte :: Int -> Int -> Word8
+byte n s = fromIntegral ((n `shiftR` s) .&. 0xFF)
diff --git a/tests/Text/MMark/Extension/LineHighlightSpec.hs b/tests/Text/MMark/Extension/LineHighlightSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMark/Extension/LineHighlightSpec.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.MMark.Extension.LineHighlightSpec (spec) where
+
+import Data.Text qualified as T
+import Test.Hspec
+import Text.MMark.Extension.LineHighlight
+import Text.MMark.Extension.TestUtils
+
+spec :: Spec
+spec = do
+  describe "parseLineSpec" $ do
+    it "reads a single line" $
+      parseLineSpec "haskell {2}" `shouldBe` Just (Just "haskell", [2])
+    it "reads a range" $
+      parseLineSpec "haskell {4-6}" `shouldBe` Just (Just "haskell", [4, 5, 6])
+    it "reads a mixture" $
+      parseLineSpec "haskell {2,4-6}" `shouldBe` Just (Just "haskell", [2, 4, 5, 6])
+    it "works without a language" $
+      parseLineSpec "{1}" `shouldBe` Just (Nothing, [1])
+    it "gives nothing when there is no specification" $
+      parseLineSpec "haskell" `shouldBe` Nothing
+    it "gives nothing when the specification makes no sense" $ do
+      parseLineSpec "haskell {x}" `shouldBe` Nothing
+      parseLineSpec "haskell {6-4}" `shouldBe` Nothing
+  describe "lineHighlight" $ do
+    it "points at the line it is told to" $
+      withExt
+        lineHighlight
+        "```haskell {2}\none\ntwo\n```"
+        "
one\ntwo\n
\n"
+    it "leaves a code block with no specification alone" $
+      withExt
+        lineHighlight
+        "```haskell\none\n```"
+        "
one\n
\n"
+    it "renders a block of real code, pointing where it is told" $
+      withExt
+        lineHighlight
+        ( T.unlines
+            [ "```haskell {2,4-6}",
+              "module Main (main) where",
+              "",
+              "import Data.List (sort & \"x\")",
+              "main :: IO ()",
+              "main = print (sort [3,1,2] <> [])",
+              "-- done",
+              "```"
+            ]
+        )
+        ( T.concat
+            [ "
",
+              "module Main (main) where\n",
+              "\n",
+              "import Data.List (sort & "x")\n",
+              "main :: IO ()\n",
+              "main = print (sort [3,1,2] <> [])\n",
+              "-- done\n",
+              "
\n"
+            ]
+        )
+    it "gives a block with no language no class to be styled by" $
+      withExt
+        lineHighlight
+        "``` {1,3}\na\nb\nc\n```"
+        ( T.concat
+            [ "
",
+              "a\n",
+              "b\n",
+              "c\n",
+              "
\n"
+            ]
+        )
+    it "ignores a line the block does not have" $
+      withExt
+        lineHighlight
+        "```haskell {2,9}\na\nb\nc\n```"
+        "
a\nb\nc\n
\n"
diff --git a/tests/Text/MMark/Extension/LinkSpec.hs b/tests/Text/MMark/Extension/LinkSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMark/Extension/LinkSpec.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.MMark.Extension.LinkSpec (spec) where
+
+import Data.ByteString qualified as B
+import Data.IORef
+import Data.Text (Text)
+import Data.Text qualified as T
+import System.Directory (createDirectory)
+import System.FilePath (())
+import Test.Hspec
+import Text.MMark qualified as MMark
+import Text.MMark.Extension.Link
+import Text.MMark.Extension.TestUtils
+import Text.URI (URI)
+import Text.URI qualified as URI
+
+spec :: Spec
+spec = do
+  describe "linkTarget" $ do
+    let to = withExt linkTarget
+    context "when no link title provided"
+      $ it "has no effect"
+      $ "[link](/url)" `to` "
link
\n"
+    context "when link title does not start with a target"
+      $ it "has no effect"
+      $ "[link](/url 'something _blank')"
+        `to` "
link
\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` "
link
\n"
+      context "when there is also a title"
+        $ it "works as intended, target is stripped from the title"
+        $ "[link](/url '_blank something')"
+          `to` "
link
\n"
+      context "when the target is not a new browsing context"
+        $ it "does not add a rel attribute"
+        $ "[link](/url '_self something')"
+          `to` "
link
\n"
+  describe "checkFragments" $ do
+    it "accepts a link to a heading that exists" $
+      fragmentErrors "# Real\n\n[go](#real)" `shouldReturn` []
+    it "reports a link to a heading that does not" $
+      fragmentErrors "# Real\n\n[go](#nope)"
+        `shouldReturn` ["3:1: no heading of this document has the id \"nope\""]
+    it "leaves a link with a scheme alone" $
+      fragmentErrors "[go](https://example.org#nope)" `shouldReturn` []
+    it "reports every bad fragment, once each" $
+      fragmentErrors "# R\n\n[a](#x) and [b](#y)"
+        `shouldReturn` [ "3:1: no heading of this document has the id \"x\"",
+                         "3:13: no heading of this document has the id \"y\""
+                       ]
+
+  describe "checkLocalFiles" $ do
+    it "accepts a link to a file that is there" $
+      localErrors "[go](there.txt)" `shouldReturn` []
+    it "reports a link to a file that is not" $
+      localErrors "[go](nope.txt)"
+        `shouldReturn` ["1:1: there is nothing at ./nope.txt"]
+    it "accepts a link to a directory" $
+      localErrors "[go](sub)" `shouldReturn` []
+    it "accepts a link to a file in a subdirectory" $
+      localErrors "[go](sub/deep.txt)" `shouldReturn` []
+    it "ignores the fragment of a link to a file that is there" $
+      localErrors "[go](there.txt#part)" `shouldReturn` []
+    it "leaves a link with a scheme to checkExternal" $
+      localErrors "[go](https://example.org/nope.txt)" `shouldReturn` []
+    it "leaves a link that is only a fragment alone" $
+      localErrors "[go](#part)" `shouldReturn` []
+    it "checks images too" $
+      localErrors "![x](nope.png)"
+        `shouldReturn` ["1:1: there is nothing at ./nope.png"]
+    it "reports every missing file, once each" $
+      localErrors "[a](nope.txt) and [b](gone.txt)"
+        `shouldReturn` [ "1:1: there is nothing at ./nope.txt",
+                         "1:19: there is nothing at ./gone.txt"
+                       ]
+
+  describe "checkExternal" $ do
+    it "accepts a link the action says is reachable" $
+      externalErrors (const (pure True)) "[go](https://example.org)"
+        `shouldReturn` []
+    it "reports a link the action says is not" $
+      externalErrors (const (pure False)) "[go](https://example.org)"
+        `shouldReturn` ["1:1: cannot reach https://example.org"]
+    it "hands the action the URI of the link" $ do
+      seen <- asked (const True) "[go](https://example.org/a)"
+      seen `shouldBe` ["https://example.org/a"]
+    it "does not ask about a link with no scheme" $
+      asked (const True) "[go](nope.txt)" `shouldReturn` []
+    it "does not ask about a link that is only a fragment" $
+      asked (const True) "[go](#part)" `shouldReturn` []
+    it "asks about every external link, once each" $
+      asked (const True) "[a](https://a.example) [b](https://b.example)"
+        `shouldReturn` ["https://a.example", "https://b.example"]
+    it "checks images too" $
+      externalErrors (const (pure False)) "![x](https://example.org/a.png)"
+        `shouldReturn` ["1:1: cannot reach https://example.org/a.png"]
+
+-- | Scan a document for its header ids and check its fragments.
+fragmentErrors :: Text -> IO [Text]
+fragmentErrors input = do
+  Right doc <- pure (MMark.parse "" input)
+  transErrors (checkFragments (MMark.runScanner headerIdScanner doc)) input
+
+-- | Check the local links of a document against a directory holding
+-- @there.txt@ and @sub\/deep.txt@.
+localErrors :: Text -> IO [Text]
+localErrors input = withTempDir $ \dir -> do
+  B.writeFile (dir  "there.txt") ""
+  createDirectory (dir  "sub")
+  B.writeFile (dir  "sub"  "deep.txt") ""
+  errs <- transErrorsM (checkLocalFiles dir) input
+  -- the messages name the base directory, which is a different one every
+  -- run, so put something back that a test can be written against
+  return (T.replace (T.pack dir) "." <$> errs)
+
+-- | Check the external links of a document with the given action.
+externalErrors :: (URI -> IO Bool) -> Text -> IO [Text]
+externalErrors reachable = transErrorsM (checkExternal reachable)
+
+-- | The URIs 'checkExternal' asked the action about, in order.
+asked :: (URI -> Bool) -> Text -> IO [Text]
+asked answer input = do
+  ref <- newIORef []
+  _ <-
+    externalErrors
+      (\uri -> modifyIORef' ref (URI.render uri :) >> pure (answer uri))
+      input
+  reverse <$> readIORef ref
diff --git a/tests/Text/MMark/Extension/LinkTargetSpec.hs b/tests/Text/MMark/Extension/LinkTargetSpec.hs
deleted file mode 100644
--- a/tests/Text/MMark/Extension/LinkTargetSpec.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# 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` "
link
\n"
-    context "when link title does not start with a target" $
-      it "has no effect" $
-        "[link](/url 'something _blank')"
-          `to` "
link
\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` "
link
\n"
-      context "when there is also a title" $
-        it "works as intended, target is stripped from the title" $
-          "[link](/url '_blank something')"
-            `to` "
link
\n"
diff --git a/tests/Text/MMark/Extension/MathJaxSpec.hs b/tests/Text/MMark/Extension/MathJaxSpec.hs
--- a/tests/Text/MMark/Extension/MathJaxSpec.hs
+++ b/tests/Text/MMark/Extension/MathJaxSpec.hs
@@ -11,10 +11,10 @@
   describe "mathJax" $ do
     let to = withExt (mathJax Nothing)
         to' = withExt (mathJax (Just '$'))
-    context "when span char is not specified" $
-      it "transforms all code spans correctly" $
-        "I've got `foo`."
-          `to` "
I've got \\(foo\\).
\n"
+    context "when span char is not specified"
+      $ it "transforms all code spans correctly"
+      $ "I've got `foo`."
+        `to` "
I've got \\(foo\\).
\n"
     context "when span char is specified" $ do
       it "does not affect mismatching code spans" $
         "I've got `foo`."
@@ -22,16 +22,16 @@
       it "transforms matching code spans correctly" $
         "I've got `$foo$`."
           `to'` "
I've got \\(foo\\).
\n"
-    context "when code block is not labelled with \"mathjax\"" $
-      it "does not affect it" $
-        "```\nfoo\n```\n"
-          `to` "
foo\n
\n"
+    context "when code block is not labelled with \"mathjax\""
+      $ it "does not affect it"
+      $ "```\nfoo\n```\n"
+        `to` "
foo\n
\n"
     context "when code block is labelled with \"mathjax\"" $ do
-      context "when code block contains a single line" $
-        it "renders it correctly" $
-          "```mathjax\nfoo\n```\n"
-            `to` "
\\[foo\\]
\n"
-      context "when code block contains multiple lines" $
-        it "renders it correctly" $
-          "```mathjax\nfoo\nbar\n```\n"
-            `to` "
\\[foo\\]\\[bar\\]
\n"
+      context "when code block contains a single line"
+        $ it "renders it correctly"
+        $ "```mathjax\nfoo\n```\n"
+          `to` "
\\[foo\\]
\n"
+      context "when code block contains multiple lines"
+        $ it "renders it correctly"
+        $ "```mathjax\nfoo\nbar\n```\n"
+          `to` "
\\[foo\\]\\[bar\\]
\n"
diff --git a/tests/Text/MMark/Extension/MermaidSpec.hs b/tests/Text/MMark/Extension/MermaidSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMark/Extension/MermaidSpec.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.MMark.Extension.MermaidSpec (spec) where
+
+import Data.Map.Strict qualified as M
+import Data.Text.Lazy qualified as TL
+import Lucid qualified as L
+import Test.Hspec
+import Text.MMark qualified as MMark
+import Text.MMark.Extension.Mermaid
+import Text.MMark.Extension.TestUtils
+
+spec :: Spec
+spec = do
+  describe "mermaid" $ do
+    it "renders a mermaid block for the browser" $
+      withExt
+        mermaid
+        "```mermaid\ngraph TD;\n```"
+        "
graph TD;\n
\n"
+    it "leaves another code block alone" $
+      withExt
+        mermaid
+        "```haskell\nmain\n```"
+        "
main\n
\n"
+  describe "mermaidScanner and mermaidSvg" $ do
+    it "puts the rendered diagram in place of the block" $ do
+      Right doc <- pure (MMark.parse "" "```mermaid\ngraph TD;\n```")
+      let svgs = M.map (const "") (MMark.runScanner mermaidScanner doc)
+      render (mermaidSvg svgs) doc
+        `shouldBe` "
\n"
+    it "leaves a block with no diagram as its source" $ do
+      Right doc <- pure (MMark.parse "" "```mermaid\ngraph TD;\n```")
+      render (mermaidSvg M.empty) doc
+        `shouldBe` "
graph TD;\n
\n"
+  where
+    render e = TL.toStrict . L.renderText . MMark.render e
diff --git a/tests/Text/MMark/Extension/MetadataSpec.hs b/tests/Text/MMark/Extension/MetadataSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMark/Extension/MetadataSpec.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.MMark.Extension.MetadataSpec (spec) where
+
+import Test.Hspec
+import Text.MMark qualified as MMark
+import Text.MMark.Extension.Metadata
+import Text.URI qualified as URI
+
+spec :: Spec
+spec = describe "metadataScanner" $ do
+  it "finds the title, the lead, and the first image" $ do
+    m <- scan "# Title\n\nThe lead here.\n\n![pic](/p.png)\n\nMore."
+    metaTitle m `shouldBe` Just "Title"
+    metaLead m `shouldBe` Just "The lead here."
+    fmap URI.render (metaImage m) `shouldBe` Just "/p.png"
+  it "counts words" $ do
+    m <- scan "one two three four five"
+    metaWords m `shouldBe` 5
+  it "rounds the reading time up and never gives zero" $ do
+    m <- scan "one two"
+    readingTime 200 m `shouldBe` 1
+  it "keeps the first of each thing" $ do
+    m <- scan "# One\n\n# Two"
+    metaTitle m `shouldBe` Just "One"
+  where
+    scan input = do
+      Right doc <- pure (MMark.parse "" input)
+      pure (MMark.runScanner metadataScanner doc)
diff --git a/tests/Text/MMark/Extension/ObfuscateEmailSpec.hs b/tests/Text/MMark/Extension/ObfuscateEmailSpec.hs
deleted file mode 100644
--- a/tests/Text/MMark/Extension/ObfuscateEmailSpec.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-{-# 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" $
-        "" `to` "
Enable JavaScript to see this email
\n"
-    context "when URI has some other scheme" $
-      it "produces the correct HTML" $
-        "" `to` "
https:example.org
\n"
-    context "other elements" $
-      it "not affected" $
-        "Something." `to` "
Something.
\n"
diff --git a/tests/Text/MMark/Extension/PermalinksSpec.hs b/tests/Text/MMark/Extension/PermalinksSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/MMark/Extension/PermalinksSpec.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.MMark.Extension.PermalinksSpec (spec) where
+
+import Lucid
+import Test.Hspec
+import Text.MMark.Extension.Permalinks
+import Text.MMark.Extension.TestUtils
+
+spec :: Spec
+spec = do
+  describe "permalinks" $ do
+    it "adds a link to the heading id" $
+      withExt
+        permalinks
+        "# Title"
+        "
Title#
\n"
+    it "works for every level" $
+      withExt
+        permalinks
+        "###### Deep"
+        "
Deep#
\n"
+    it "leaves other blocks alone" $
+      withExt permalinks "Just text." "
Just text.
\n"
+  describe "permalinksWith" $ do
+    it "can be given another class and label" $
+      withExt
+        (permalinksWith (const True) "anchor" Nothing "\182")
+        "# T"
+        "
T\182
\n"
+    it "labels the link with the markup it is given" $
+      withExt
+        (permalinksWith (const True) "anchor" Nothing (toHtmlRaw ("" :: String)))
+        "# T"
+        "
T
\n"
+    it "keeps a link a screen reader is told about" $
+      withExt
+        (permalinksWith (const True) "anchor" (Just "Link to this section") "#")
+        "# T"
+        "
T#
\n"
+    it "gives a link only to the levels it is told to" $ do
+      withExt (permalinksWith (\n -> n >= 2 && n <= 4) "anchor" Nothing "#") "# T" "
T
\n"
+      withExt
+        (permalinksWith (\n -> n >= 2 && n <= 4) "anchor" Nothing "#")
+        "## T"
+        "
T#
\n"
+      withExt (permalinksWith (\n -> n >= 2 && n <= 4) "anchor" Nothing "#") "##### T" "
T
\n"
diff --git a/tests/Text/MMark/Extension/PunctuationPrettifierSpec.hs b/tests/Text/MMark/Extension/PunctuationPrettifierSpec.hs
--- a/tests/Text/MMark/Extension/PunctuationPrettifierSpec.hs
+++ b/tests/Text/MMark/Extension/PunctuationPrettifierSpec.hs
@@ -9,7 +9,7 @@
 spec :: Spec
 spec =
   describe "punctuationPrettifier" $ do
-    let to = withExt punctuationPrettifier
+    let to = withTrans punctuationPrettifier
     context "on plain inlines" $ do
       it "replaces ... with ellipsis" $
         "He forgot where he came from..." `to` "
He forgot where he came from…
\n"
@@ -31,6 +31,6 @@
         "Something-\"foo\"." `to` "
Something-”foo”.
\n"
       it "a tricky test 2" $
         "Something.--" `to` "
Something.–
\n"
-    context "on other inlines" $
-      it "has no effect" $
-        "`code -- span`" `to` "
code -- span
\n"
+    context "on other inlines"
+      $ it "has no effect"
+      $ "`code -- span`" `to` "
code -- span
\n"
diff --git a/tests/Text/MMark/Extension/SkylightingSpec.hs b/tests/Text/MMark/Extension/SkylightingSpec.hs
--- a/tests/Text/MMark/Extension/SkylightingSpec.hs
+++ b/tests/Text/MMark/Extension/SkylightingSpec.hs
@@ -2,6 +2,7 @@
 
 module Text.MMark.Extension.SkylightingSpec (spec) where
 
+import Data.Text qualified as T
 import Test.Hspec
 import Text.MMark.Extension.Skylighting
 import Text.MMark.Extension.TestUtils
@@ -10,11 +11,45 @@
 spec =
   describe "skylighting" $ do
     let to = withExt skylighting
-    context "when info string does not result in a successful lookup" $
-      it "has no effect" $
-        "```foo\nmain :: IO ()\nmain = return ()\n```\n"
+    context "when info string does not result in a successful lookup"
+      $ it "has no effect"
+      $ "```foo\nmain :: IO ()\nmain = return ()\n```\n"
+        `to` "
main :: IO ()\nmain = return ()\n
\n"
+    context "with info string results in a successful lookup"
+      $ it "renders it correctly"
+      $ "```haskell\nmain :: IO ()\nmain = return ()\n```\n"
+        `to` "
main :: IO ()\nmain = return ()\n
\n"
+    context "when the info string ends with a line specification" $ do
+      it "still recognizes the language, and points at the line" $
+        "```haskell {2}\nmain :: IO ()\nmain = return ()\n```\n"
+          `to` T.concat
+            [ "
",
+              "main :: IO ()\n",
+              "",
+              "main = return ()\n",
+              "",
+              "
\n"
+            ]
+      it "points at every line a range names" $
+        "```haskell {1-2}\nmain :: IO ()\nmain = return ()\n```\n"
+          `to` T.concat
+            [ "
",
+              "",
+              "main :: IO ()\n",
+              "",
+              "",
+              "main = return ()\n",
+              "",
+              "
\n"
+            ]
+      it "does not take a specification that names no line for one" $
+        -- there is no such thing as pointing at nothing, so this is a
+        -- malformed info string and the whole of it names the language
+        "```haskell {}\nmain :: IO ()\nmain = return ()\n```\n"
+          `to` "
main :: IO ()\nmain = return ()\n
\n"
+      it "leaves a block alone when the language is still not one it knows" $
+        "```foo {1}\nmain :: IO ()\nmain = return ()\n```\n"
           `to` "
main :: IO ()\nmain = return ()\n
\n"
-    context "with info string results in a successful lookup" $
-      it "renders it correctly" $
-        "```haskell\nmain :: IO ()\nmain = return ()\n```\n"
+      it "ignores a line the block does not have" $
+        "```haskell {9}\nmain :: IO ()\nmain = return ()\n```\n"
           `to` "
main :: IO ()\nmain = return ()\n
\n"
diff --git a/tests/Text/MMark/Extension/TableOfContentsSpec.hs b/tests/Text/MMark/Extension/TableOfContentsSpec.hs
--- a/tests/Text/MMark/Extension/TableOfContentsSpec.hs
+++ b/tests/Text/MMark/Extension/TableOfContentsSpec.hs
@@ -2,25 +2,54 @@
 
 module Text.MMark.Extension.TableOfContentsSpec (spec) where
 
-import qualified Data.Text.IO as TIO
-import qualified Data.Text.Lazy as TL
-import qualified Lucid as L
+import Data.Text (Text)
+import Data.Text.IO qualified as TIO
+import Data.Text.Lazy qualified as TL
+import Lucid qualified as L
 import Test.Hspec
-import qualified Text.MMark as MMark
+import Text.MMark qualified as MMark
 import Text.MMark.Extension.TableOfContents
+import Text.MMark.Extension.TestUtils (summarize)
+import Text.Megaparsec (errorBundlePretty)
 
 spec :: Spec
 spec =
-  describe "toc" $
+  describe "toc" $ do
     it "works" $ do
       input <- TIO.readFile "data/toc.md"
       expected <- TIO.readFile "data/toc.html"
       Right doc <- pure (MMark.parse "" input)
-      let headings = MMark.runScanner doc (tocScanner (> 1))
-          actual =
-            TL.toStrict
-              . L.renderText
-              . MMark.render
-              . MMark.useExtension (toc "toc" headings)
-              $ doc
-      actual `shouldBe` expected
+      let headings = MMark.runScanner (tocScanner (> 1)) doc
+      case MMark.runTrans (toc "toc" headings) doc of
+        Left errs -> expectationFailure (errorBundlePretty errs)
+        Right doc' ->
+          (TL.toStrict . L.renderText . MMark.render mempty) doc'
+            `shouldBe` expected
+    it "leaves a code block with another label alone" $
+      withToc (> 0) "toc" "# A\n\n```haskell\nx = 1\n```\n"
+        `shouldBe` Right "
A
\n
x = 1\n
\n"
+    it "uses the label it is given" $
+      withToc (> 0) "contents" "# A\n\n```contents\n```\n"
+        `shouldBe` Right "
A
\n
    \n
  • \nA\n
    • \n
\n"
+    it "reports a table of contents with nothing to put in it" $
+      withToc (> 1) "toc" "# A\n\n```toc\n```\n"
+        `shouldBe` Left ["3:1: there are no headings to put in the table of contents"]
+    it "reports a table of contents in a document with no headings at all" $
+      withToc (> 0) "toc" "Some text.\n\n```toc\n```\n"
+        `shouldBe` Left ["3:1: there are no headings to put in the table of contents"]
+    it "says nothing about a document that asks for no table of contents" $
+      withToc (> 1) "toc" "# A\n\nSome text.\n"
+        `shouldBe` Right "
A
\n
Some text.
\n"
+
+-- | Build a table of contents out of the headings the predicate admits and
+-- put it where the given label asks, giving either the problems reported or
+-- the rendered document.
+withToc :: (Int -> Bool) -> Text -> Text -> Either [Text] Text
+withToc p label input =
+  case MMark.parse "" input of
+    Left _ -> error "the test input does not parse"
+    Right doc ->
+      case MMark.runTrans (toc label (MMark.runScanner (tocScanner p) doc)) doc of
+        Left errs -> Left (summarize (errorBundlePretty errs))
+        Right doc' ->
+          Right (TL.toStrict (L.renderText (MMark.render mempty doc')))
diff --git a/tests/Text/MMark/Extension/TestUtils.hs b/tests/Text/MMark/Extension/TestUtils.hs
--- a/tests/Text/MMark/Extension/TestUtils.hs
+++ b/tests/Text/MMark/Extension/TestUtils.hs
@@ -1,19 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Text.MMark.Extension.TestUtils
   ( withExt,
+    withTrans,
+    transErrors,
+    transErrorsM,
+    checkErrors,
+    summarize,
+    withTempDir,
   )
 where
 
+import Control.Exception (bracket)
+import Data.Char (isDigit)
 import Data.Text (Text)
-import qualified Data.Text.Lazy as TL
-import qualified Lucid as L
+import Data.Text qualified as T
+import Data.Text.Lazy qualified as TL
+import Lucid qualified as L
+import System.Directory
+  ( createDirectory,
+    getTemporaryDirectory,
+    removeDirectoryRecursive,
+    removeFile,
+  )
+import System.IO (hClose, openTempFile)
 import Test.Hspec
-import qualified Text.MMark as MMark
+import Text.MMark qualified as MMark
+import Text.MMark.Trans (Bni, Trans, TransT)
+import Text.Megaparsec (errorBundlePretty)
 
--- | Feed input into MMark parser, apply an extension, render the parsed
--- document and demand that it matches the given example.
+-- | Feed input into MMark parser, apply a render extension, render the
+-- parsed document and demand that it matches the given example.
 withExt ::
-  -- | MMark extension to use
-  MMark.Extension ->
+  -- | Render extension to use
+  MMark.RenderExtension ->
   -- | Input for the parser
   Text ->
   -- | Expected output of the render
@@ -21,10 +41,94 @@
   Expectation
 withExt ext input expected = do
   Right doc <- pure (MMark.parse "" input)
-  let actual =
-        TL.toStrict
-          . L.renderText
-          . MMark.render
-          . MMark.useExtension ext
-          $ doc
-  actual `shouldBe` expected
+  render mempty doc `shouldBe` expected
+  where
+    render e = TL.toStrict . L.renderText . MMark.render (e <> ext)
+
+-- | Like 'withExt', but applies a transformation instead.
+withTrans ::
+  -- | Transformation to apply
+  (Bni -> Trans Bni) ->
+  -- | Input for the parser
+  Text ->
+  -- | Expected output of the render
+  Text ->
+  Expectation
+withTrans f input expected = do
+  Right doc <- pure (MMark.parse "" input)
+  case MMark.runTrans f doc of
+    Left errs -> expectationFailure (errorBundlePretty errs)
+    Right doc' ->
+      (TL.toStrict . L.renderText . MMark.render mempty) doc'
+        `shouldBe` expected
+
+-- | Apply a transformation that is expected to report problems and return
+-- one @line:col: message@ string per problem.
+transErrors ::
+  -- | Transformation to apply
+  (Bni -> Trans Bni) ->
+  -- | Input for the parser
+  Text ->
+  IO [Text]
+transErrors f input = do
+  Right doc <- pure (MMark.parse "" input)
+  pure $ case MMark.runTrans f doc of
+    Right _ -> []
+    Left errs -> summarize (errorBundlePretty errs)
+
+-- | Like 'transErrors', but for a transformation that needs 'IO'.
+transErrorsM ::
+  -- | Transformation to apply
+  (Bni -> TransT IO Bni) ->
+  -- | Input for the parser
+  Text ->
+  IO [Text]
+transErrorsM f input = do
+  Right doc <- pure (MMark.parse "" input)
+  r <- MMark.runTransM f doc
+  pure $ case r of
+    Right _ -> []
+    Left errs -> summarize (errorBundlePretty errs)
+
+-- | Reduce a rendered error bundle to one @line:col: message@ string per
+-- error, dropping the source excerpt megaparsec prints in between.
+summarize :: String -> [Text]
+summarize = go Nothing . fmap T.strip . T.lines . T.pack
+  where
+    go _ [] = []
+    go cur (l : ls)
+      | T.null l = go cur ls
+      | isPos l = go (Just l) ls
+      | "|" `T.isInfixOf` l = go cur ls
+      | otherwise = case cur of
+          Just p -> (p <> " " <> l) : go Nothing ls
+          Nothing -> go Nothing ls
+    isPos t = ":" `T.isSuffixOf` t && T.all (\c -> isDigit c || c == ':') t
+
+-- | Run a check that is expected to report problems and return one
+-- @line:col: message@ string per problem.
+checkErrors ::
+  -- | Check to run
+  Trans a ->
+  -- | Input for the parser
+  Text ->
+  IO [Text]
+checkErrors c input = do
+  Right doc <- pure (MMark.parse "" input)
+  pure $ case MMark.runCheck c doc of
+    Right _ -> []
+    Left errs -> summarize (errorBundlePretty errs)
+
+-- | Run an action in a fresh empty directory, which is removed afterwards.
+withTempDir :: (FilePath -> IO a) -> IO a
+withTempDir = bracket acquire removeDirectoryRecursive
+  where
+    -- 'openTempFile' is the only way base offers to get a name nothing else
+    -- has taken, so take one and swap the file for a directory.
+    acquire = do
+      tmp <- getTemporaryDirectory
+      (path, h) <- openTempFile tmp "mmark-ext-test"
+      hClose h
+      removeFile path
+      createDirectory path
+      return path