diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +## MMark Ext 0.2.1.3 + +* The test suite passes with `modern-uri-0.3.4` and later. + +* Dropped support for GHC 8.6 and older. + ## MMark Ext 0.2.1.2 * Made the tests pass with `skylighting-0.7.6`. diff --git a/LICENSE.md b/LICENSE.md --- a/LICENSE.md +++ b/LICENSE.md @@ -1,4 +1,4 @@ -Copyright © 2017–2018 Mark Karpov +Copyright © 2017–present Mark Karpov All rights reserved. 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) -[![Build Status](https://travis-ci.org/mmark-md/mmark-ext.svg?branch=master)](https://travis-ci.org/mmark-md/mmark-ext) +![CI](https://github.com/mmark-md/mmark-ext/workflows/CI/badge.svg?branch=master) Commonly useful extensions for the [MMark](https://hackage.haskell.org/package/mmark) markdown processor. @@ -18,6 +18,6 @@ ## License -Copyright © 2017–2019 Mark Karpov +Copyright © 2017–present Mark Karpov Distributed under BSD 3 clause license. 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 @@ -1,6 +1,6 @@ -- | -- Module : Text.MMark.Extension.Comment --- Copyright : © 2018–2019 Mark Karpov +-- Copyright : © 2018–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -9,24 +9,24 @@ -- -- Turn paragraphs into comments by prefixing them with a certain sequence -- of characters. - module Text.MMark.Extension.Comment - ( commentParagraph ) + ( commentParagraph, + ) where import Control.Monad import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) -import Text.MMark.Extension (Extension, Block (..), Inline (..)) -import qualified Data.Text as T +import qualified Data.Text as T +import Text.MMark.Extension (Block (..), Extension, Inline (..)) import qualified Text.MMark.Extension as Ext -- | This extension removes top-level paragraphs starting with the given -- sequence of non-markup characters. - -commentParagraph - :: Text -- ^ Sequence of characters that starts a comment - -> Extension +commentParagraph :: + -- | Sequence of characters that starts a comment + Text -> + Extension commentParagraph commentPrefix = Ext.blockRender $ \old block -> case block of p@(Paragraph (ois, _)) -> 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 @@ -1,6 +1,6 @@ -- | -- Module : Text.MMark.Extension.Common --- Copyright : © 2017–2019 Mark Karpov +-- Copyright : © 2017–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -43,19 +43,19 @@ -- > , Ext.punctuationPrettifier -- > , Ext.skylighting ] -- > $ r - module Text.MMark.Extension.Common - ( module Text.MMark.Extension.Comment - , module Text.MMark.Extension.FontAwesome - , module Text.MMark.Extension.Footnotes - , module Text.MMark.Extension.GhcSyntaxHighlighter - , module Text.MMark.Extension.Kbd - , module Text.MMark.Extension.LinkTarget - , module Text.MMark.Extension.MathJax - , module Text.MMark.Extension.ObfuscateEmail - , module Text.MMark.Extension.PunctuationPrettifier - , module Text.MMark.Extension.Skylighting - , module Text.MMark.Extension.TableOfContents ) + ( module Text.MMark.Extension.Comment, + module Text.MMark.Extension.FontAwesome, + module Text.MMark.Extension.Footnotes, + module Text.MMark.Extension.GhcSyntaxHighlighter, + module Text.MMark.Extension.Kbd, + module Text.MMark.Extension.LinkTarget, + module Text.MMark.Extension.MathJax, + module Text.MMark.Extension.ObfuscateEmail, + module Text.MMark.Extension.PunctuationPrettifier, + module Text.MMark.Extension.Skylighting, + module Text.MMark.Extension.TableOfContents, + ) where import Text.MMark.Extension.Comment diff --git a/Text/MMark/Extension/FontAwesome.hs b/Text/MMark/Extension/FontAwesome.hs --- a/Text/MMark/Extension/FontAwesome.hs +++ b/Text/MMark/Extension/FontAwesome.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + -- | -- Module : Text.MMark.Extension.FontAwesome --- Copyright : © 2017–2019 Mark Karpov +-- Copyright : © 2017–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -8,23 +11,19 @@ -- Portability : portable -- -- Turn links into Font Awesome icons. - -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} - module Text.MMark.Extension.FontAwesome - ( fontAwesome ) + ( fontAwesome, + ) where -import Data.Semigroup ((<>)) +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) -import qualified Data.Text as T -import qualified Text.MMark.Extension as Ext -import qualified Text.URI as URI -- | Allow to insert @span@s with font awesome icons using autolinks like -- this: @@ -48,18 +47,17 @@ -- > -- -- 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) ] - "" + [] -> 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,6 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + -- | -- Module : Text.MMark.Extension.Footnotes --- Copyright : © 2018–2019 Mark Karpov +-- Copyright : © 2018–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -10,28 +13,24 @@ -- An extension to add footnotes to your documents. -- -- @since 0.1.1.0 - -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} - module Text.MMark.Extension.Footnotes - ( footnotes ) + ( footnotes, + ) where import Control.Monad import Data.Char (isDigit) import Data.List.NonEmpty (NonEmpty (..)) -import Data.Semigroup ((<>)) +import qualified Data.List.NonEmpty as NE import Data.Text (Text) +import qualified Data.Text as T import Lens.Micro ((^.)) import Lucid -import Text.MMark.Extension (Extension, Inline (..), Block (..), getOis) +import Text.MMark.Extension (Block (..), Extension, Inline (..), getOis) +import qualified Text.MMark.Extension as Ext +import qualified Text.URI as URI import Text.URI.Lens (uriPath) import Text.URI.QQ (scheme) -import qualified Data.List.NonEmpty as NE -import qualified Data.Text as T -import qualified Text.MMark.Extension as Ext -import qualified Text.URI as URI -- | The extension performs two transformations: -- @@ -50,53 +49,53 @@ -- that a footnote reference refers to an existing footnote and that -- footnotes have corresponding references, or that they are present in the -- document in the right order. - footnotes :: Extension footnotes = footnoteRefs <> footnoteSection -- | Create footnote references. - footnoteRefs :: Extension footnoteRefs = Ext.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 + [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 other -> old other -- | Create footnote section. - footnoteSection :: Extension footnoteSection = Ext.blockRender $ \old block -> case block of b@(Blockquote [Paragraph (pOis, _), OrderedList i items]) -> if getOis pOis == Plain "footnotes" :| [] - 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 - let j' = renderIx j - li_ [id_ (footnoteId j')] $ do - newline - mapM_ old x - a_ [fragmentHref (referenceId j')] "↩" - newline + 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 + let j' = renderIx j + li_ [id_ (footnoteId j')] $ do newline - + mapM_ old x + a_ [fragmentHref (referenceId j')] "↩" + newline + newline else old b other -> old other - where - newline = "\n" + where + newline = "\n" fragmentHref :: Text -> Attribute fragmentHref = href_ . URI.render . Ext.headerFragment 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 @@ -1,54 +1,30 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + -- | -- Module : Text.MMark.Extension.GhcSyntaxHighlighter --- Copyright : © 2018–2019 Mark Karpov +-- Copyright : © 2018–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable -- --- Use the @ghc-syntax-highlighter@ package to highlight Haskell code. This --- module only works with GHC 8.4.1 and newer (with older versions the --- extension just won't have any effect). +-- Use the @ghc-syntax-highlighter@ package to highlight Haskell code. -- -- @since 0.2.1.0 - -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - module Text.MMark.Extension.GhcSyntaxHighlighter - ( ghcSyntaxHighlighter ) + ( ghcSyntaxHighlighter, + ) where import Data.Text (Text) +import qualified Data.Text as T +import GHC.SyntaxHighlighter import Lucid -import Text.MMark.Extension (Extension, Block (..)) -import qualified Data.Text as T +import Text.MMark.Extension (Block (..), Extension) import qualified Text.MMark.Extension as Ext -#if __GLASGOW_HASKELL__ >= 804 -import GHC.SyntaxHighlighter -#else -data Token - = KeywordTok - | PragmaTok - | SymbolTok - | VariableTok - | ConstructorTok - | OperatorTok - | CharTok - | StringTok - | IntegerTok - | RationalTok - | CommentTok - | SpaceTok - | OtherTok - deriving (Eq, Ord, Enum, Bounded, Show) -tokenizeHaskell :: Text -> Maybe [(Token, Text)] -tokenizeHaskell _ = Nothing -#endif - -- | Use the @ghc-syntax-highlighter@ package to highlight Haskell code. The -- extension is applied only to code blocks with info string @\"haskell\"@. -- @@ -76,7 +52,6 @@ -- 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 ghcSyntaxHighlighter = Ext.blockRender $ \old block -> case block of @@ -95,7 +70,6 @@ newline = "\n" -- | Render a single 'Token'. - tokenToHtml :: (Token, Text) -> Html () tokenToHtml (tokenType, txt) = span_ [class_ rawClass | not (T.null rawClass)] (toHtml txt) @@ -103,19 +77,18 @@ rawClass = tokenClass tokenType -- | Return class corresponding to given 'TokenType'. - tokenClass :: Token -> Text tokenClass = \case - KeywordTok -> "kw" - PragmaTok -> "pr" - SymbolTok -> "sy" - VariableTok -> "va" + KeywordTok -> "kw" + PragmaTok -> "pr" + SymbolTok -> "sy" + VariableTok -> "va" ConstructorTok -> "cr" - OperatorTok -> "op" - CharTok -> "ch" - StringTok -> "st" - IntegerTok -> "it" - RationalTok -> "ra" - CommentTok -> "co" - SpaceTok -> "" - OtherTok -> "ot" + OperatorTok -> "op" + CharTok -> "ch" + StringTok -> "st" + IntegerTok -> "it" + RationalTok -> "ra" + CommentTok -> "co" + SpaceTok -> "" + OtherTok -> "ot" 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 @@ -1,6 +1,8 @@ +{-# LANGUAGE QuasiQuotes #-} + -- | -- Module : Text.MMark.Extension.Kbd --- Copyright : © 2018 Mark Karpov +-- Copyright : © 2018–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -9,18 +11,16 @@ -- -- Introduce @kbd@ tags into resulting HTML document by wrapping content in -- links with URL with @kbd@ scheme. - -{-# LANGUAGE QuasiQuotes #-} - module Text.MMark.Extension.Kbd - ( kbd ) + ( kbd, + ) where import Lucid import Text.MMark.Extension (Extension, Inline (..)) -import Text.URI.QQ (scheme) import qualified Text.MMark.Extension as Ext -import qualified Text.URI as URI +import qualified Text.URI as URI +import Text.URI.QQ (scheme) -- | Introduce @kbd@ tags into resulting HTML document by wrapping content -- in links with URL with @kbd@ scheme. @@ -35,7 +35,6 @@ -- author, but you can of course do somethnig like this instead: -- -- > To enable that mode press [Ctrl+A](kbd:). - kbd :: Extension kbd = Ext.inlineRender $ \old inline -> case inline of diff --git a/Text/MMark/Extension/LinkTarget.hs b/Text/MMark/Extension/LinkTarget.hs --- a/Text/MMark/Extension/LinkTarget.hs +++ b/Text/MMark/Extension/LinkTarget.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + -- | -- Module : Text.MMark.Extension.LinkTarget --- Copyright : © 2018 Mark Karpov +-- Copyright : © 2018–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -9,19 +12,16 @@ -- -- Specify the @target@ attribute of links in link titles. This allows, e.g. -- make a link open in new tab. - -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} - module Text.MMark.Extension.LinkTarget - ( linkTarget ) + ( 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 Data.Text as T import qualified Text.MMark.Extension as Ext -- | When title of a link starts with the word @\"_blank\"@, @\"_self\"@, @@ -32,15 +32,16 @@ -- 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 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 @@ -1,6 +1,8 @@ +{-# LANGUAGE OverloadedStrings #-} + -- | -- Module : Text.MMark.Extension.MathJax --- Copyright : © 2018 Mark Karpov +-- Copyright : © 2018–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -10,19 +12,16 @@ -- Turn code spans and fenced code blocks into MathJax formulas. -- -- @since 0.1.1.0 - -{-# LANGUAGE OverloadedStrings #-} - module Text.MMark.Extension.MathJax - ( mathJax ) + ( mathJax, + ) where import Control.Monad -import Data.Semigroup ((<>)) import Data.Text (Text) +import qualified Data.Text as T import Lucid -import Text.MMark.Extension (Extension, Inline (..), Block (..)) -import qualified Data.Text as T +import Text.MMark.Extension (Block (..), Extension, Inline (..)) import qualified Text.MMark.Extension as Ext -- | The extension allows to transform inline code spans into MathJax inline @@ -36,16 +35,15 @@ -- 'Nothing' is passed instead of a char, we apply the transformation to all -- code spans (useful for more academic articles that do not deal with -- code). - -mathJax - :: Maybe Char -- ^ Starting\/ending character in MathJax inline spans - -> Extension +mathJax :: + -- | Starting\/ending character in MathJax inline spans + Maybe Char -> + Extension 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 mch = Ext.inlineRender $ \old inline -> case inline of @@ -59,21 +57,21 @@ other -> old other where spn :: Text -> Html () - spn x = span_ [class_ "math inline"] $ - "\\(" >> toHtml x >> "\\)" + spn x = + span_ [class_ "math inline"] $ + "\\(" >> toHtml x >> "\\)" -- | Turn code blocks with info string @\"mathjax\"@ into MathJax display -- spans. - mathJaxBlock :: Extension mathJaxBlock = Ext.blockRender $ \old block -> case block of b@(CodeBlock mlabel txt) -> if mlabel == Just "mathjax" then do - p_ . forM_ (T.lines txt) $ \x -> - span_ [class_ "math display"] $ - "\\[" >> toHtml x >> "\\]" - "\n" + p_ . forM_ (T.lines txt) $ \x -> + span_ [class_ "math display"] $ + "\\[" >> toHtml x >> "\\]" + "\n" else old b other -> old other diff --git a/Text/MMark/Extension/ObfuscateEmail.hs b/Text/MMark/Extension/ObfuscateEmail.hs --- a/Text/MMark/Extension/ObfuscateEmail.hs +++ b/Text/MMark/Extension/ObfuscateEmail.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + -- | -- Module : Text.MMark.Extension.ObfuscateEmail --- Copyright : © 2018 Mark Karpov +-- Copyright : © 2018–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -8,21 +11,18 @@ -- Portability : portable -- -- Obfuscate email addresses. - -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} - module Text.MMark.Extension.ObfuscateEmail - ( obfuscateEmail ) + ( obfuscateEmail, + ) where import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) import Lucid import Text.MMark.Extension (Extension, Inline (..)) -import Text.URI.QQ (scheme, uri) import qualified Text.MMark.Extension as Ext import qualified Text.URI as URI +import Text.URI.QQ (scheme, uri) -- | This extension makes email addresses in autolinks be rendered as -- something like this: @@ -42,20 +42,23 @@ -- > item.html(email); -- > }); -- > }); - -obfuscateEmail - :: Text - -- ^ Name of class to assign to the links, e.g. @\"protected-email\"@ - -> Extension +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" - (URI.render email { URI.uriScheme = Nothing }) ] + then + let txt = Plain "Enable JavaScript to see this email" :| [] + js = [uri|javascript:void(0)|] + in with + (old (Link txt js mtitle)) + [ class_ class', + data_ + "email" + (URI.render email {URI.uriScheme = Nothing}) + ] else old l other -> old other 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 @@ -1,6 +1,9 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + -- | -- Module : Text.MMark.Extension.PunctuationPrettifier --- Copyright : © 2018 Mark Karpov +-- Copyright : © 2018–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -8,18 +11,15 @@ -- Portability : portable -- -- Punctuation prettifier. - -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - module Text.MMark.Extension.PunctuationPrettifier - ( punctuationPrettifier ) + ( punctuationPrettifier, + ) where import Data.Char (isSpace) import Data.Text (Text) -import Text.MMark.Extension (Extension, Inline (..)) import qualified Data.Text as T +import Text.MMark.Extension (Extension, Inline (..)) import qualified Text.MMark.Extension as Ext -- | Prettify punctuation (only affects plain text in inlines): @@ -32,31 +32,30 @@ -- * 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 + other -> other -gen - :: (Bool, Text) - -- ^ Whether the previous character was a space and remaining input - -> Maybe (Char, (Bool, Text)) - -- ^ Next generated char and the state +gen :: + -- | Whether the previous character was a space and remaining input + (Bool, Text) -> + -- | Next generated char and the state + Maybe (Char, (Bool, Text)) gen (s, i) = case T.uncons i of Nothing -> Nothing Just ('.', i') -> case T.splitAt 2 i' of ("..", i'') -> Just ('…', (False, i'')) - _ -> Just ('.', (False, i')) + _ -> Just ('.', (False, i')) Just ('-', i') -> case T.splitAt 2 i' of ("--", i'') -> Just ('—', (False, i'')) _ -> case T.splitAt 1 i' of ("-", i'') -> Just ('–', (False, i'')) - _ -> Just ('-', (False, i')) + _ -> Just ('-', (False, i')) Just ('\"', i') -> if s -- whether previous character was a space character then Just ('“', (False, i')) 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 @@ -1,6 +1,9 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + -- | -- Module : Text.MMark.Extension.Skylighting --- Copyright : © 2018 Mark Karpov +-- Copyright : © 2018–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -8,22 +11,18 @@ -- Portability : portable -- -- Use the Skylighting library to highlight code snippets. - -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - module Text.MMark.Extension.Skylighting - ( skylighting ) + ( skylighting, + ) where import Control.Monad -import Data.Semigroup ((<>)) import Data.Text (Text) +import qualified Data.Text as T import Lucid import Skylighting (Token, TokenType (..)) -import Text.MMark.Extension (Extension, Block (..)) -import qualified Data.Text as T -import qualified Skylighting as S +import qualified Skylighting as S +import Text.MMark.Extension (Block (..), Extension) import qualified Text.MMark.Extension as Ext -- | Use the @skylighting@ package to render code blocks with info strings @@ -62,35 +61,36 @@ -- * 'VariableTok' = @\"va\"@ -- * 'VerbatimStringTok' = @\"vs\"@ -- * 'WarningTok' = @\"wa\"@ - skylighting :: Extension skylighting = Ext.blockRender $ \old block -> case block of cb@(CodeBlock (Just infoString') txt) -> - let tokenizerConfig = S.TokenizerConfig - { S.syntaxMap = S.defaultSyntaxMap - , S.traceOutput = False } + let tokenizerConfig = + S.TokenizerConfig + { S.syntaxMap = S.defaultSyntaxMap, + S.traceOutput = False + } infoString = T.replace "-" " " infoString' - in case S.lookupSyntax infoString S.defaultSyntaxMap of - Nothing -> old cb - Just syntax -> - case S.tokenize tokenizerConfig syntax txt of - Left _ -> old cb - Right ls -> do - div_ [class_ "source-code"] - . pre_ - . code_ [class_ ("language-" <> infoString)] - . forM_ ls $ \l -> do - mapM_ tokenToHtml l - newline - newline + in case S.lookupSyntax infoString S.defaultSyntaxMap of + Nothing -> old cb + Just syntax -> + case S.tokenize tokenizerConfig syntax txt of + Left _ -> old cb + Right ls -> do + div_ [class_ "source-code"] + . pre_ + . code_ [class_ ("language-" <> infoString)] + . forM_ ls + $ \l -> do + mapM_ tokenToHtml l + newline + newline other -> old other where newline :: Html () newline = "\n" -- | Render a single 'Token'. - tokenToHtml :: Token -> Html () tokenToHtml (tokenType, txt) = span_ [class_ rawClass | not (T.null rawClass)] (toHtml txt) @@ -98,37 +98,36 @@ rawClass = tokenClass tokenType -- | Return class corresponding to given 'TokenType'. - tokenClass :: TokenType -> Text tokenClass = \case - KeywordTok -> "kw" - DataTypeTok -> "dt" - DecValTok -> "dv" - BaseNTok -> "bn" - FloatTok -> "fl" - CharTok -> "ch" - StringTok -> "st" - CommentTok -> "co" - OtherTok -> "ot" - AlertTok -> "al" - FunctionTok -> "fu" - RegionMarkerTok -> "re" - ErrorTok -> "er" - ConstantTok -> "cn" - SpecialCharTok -> "sc" + KeywordTok -> "kw" + DataTypeTok -> "dt" + DecValTok -> "dv" + BaseNTok -> "bn" + FloatTok -> "fl" + CharTok -> "ch" + StringTok -> "st" + CommentTok -> "co" + OtherTok -> "ot" + AlertTok -> "al" + FunctionTok -> "fu" + RegionMarkerTok -> "re" + ErrorTok -> "er" + ConstantTok -> "cn" + SpecialCharTok -> "sc" VerbatimStringTok -> "vs" - SpecialStringTok -> "ss" - ImportTok -> "im" - DocumentationTok -> "do" - AnnotationTok -> "an" - CommentVarTok -> "cv" - VariableTok -> "va" - ControlFlowTok -> "cf" - OperatorTok -> "op" - BuiltInTok -> "bu" - ExtensionTok -> "ex" - PreprocessorTok -> "pp" - AttributeTok -> "at" - InformationTok -> "in" - WarningTok -> "wa" - NormalTok -> "" + SpecialStringTok -> "ss" + ImportTok -> "im" + DocumentationTok -> "do" + AnnotationTok -> "an" + CommentVarTok -> "cv" + VariableTok -> "va" + ControlFlowTok -> "cf" + OperatorTok -> "op" + BuiltInTok -> "bu" + ExtensionTok -> "ex" + PreprocessorTok -> "pp" + AttributeTok -> "at" + InformationTok -> "in" + WarningTok -> "wa" + NormalTok -> "" 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,6 +1,8 @@ +{-# LANGUAGE LambdaCase #-} + -- | -- Module : Text.MMark.Extension.TableOfContents --- Copyright : © 2017–2018 Mark Karpov +-- Copyright : © 2017–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -15,35 +17,31 @@ -- -- You may use something different than @\"toc\"@ as the info string of the -- code block. - -{-# LANGUAGE LambdaCase #-} - module Text.MMark.Extension.TableOfContents - ( Toc - , tocScanner - , toc ) + ( Toc, + tocScanner, + toc, + ) where +import qualified Control.Foldl as L import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE import Data.Maybe (maybeToList) import Data.Text (Text) -import Text.MMark.Extension (Extension, Block (..), Inline (..), Bni) -import qualified Control.Foldl as L -import qualified Data.List.NonEmpty as NE +import Text.MMark.Extension (Block (..), Bni, Extension, Inline (..)) import qualified Text.MMark.Extension as Ext -- | An opaque type representing table of contents produced by the -- 'tocScanner' scanner. - newtype Toc = Toc [(Int, NonEmpty Inline)] -- | The scanner builds table of contents 'Toc' that can then be passed to -- 'toc' to obtain an extension that renders the table of contents in HTML. - -tocScanner - :: (Int -> Bool) - -- ^ Whether to include a header of this level (1–6) - -> L.Fold Bni Toc +tocScanner :: + -- | 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 -> case block of Heading1 x -> f 1 x xs @@ -52,20 +50,21 @@ Heading4 x -> f 4 x xs Heading5 x -> f 5 x xs Heading6 x -> f 6 x xs - _ -> xs + _ -> xs where f n a as = if p n - then as . ((n, a):) + then as . ((n, a) :) else as -- | Create an extension that replaces a certain code block with previously -- constructed table of contents. - -toc - :: Text -- ^ Label of the code block to replace by the table of contents - -> Toc -- ^ Previously generated by 'tocScanner' - -> Extension +toc :: + -- | Label 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 @@ -78,13 +77,13 @@ -- | Construct 'Bni' for a table of contents from given collection of -- headers. This is a non-public helper. - renderToc :: NonEmpty (Int, NonEmpty Inline) -> Bni renderToc = UnorderedList . NE.unfoldr f where - f ((n,x) :| xs) = + f ((n, x) :| xs) = let (sitems, fitems) = span ((> n) . fst) xs url = Ext.headerFragment (Ext.headerId x) - in ( Naked (Link x url Nothing :| []) - : maybeToList (renderToc <$> NE.nonEmpty sitems) - , NE.nonEmpty fitems ) + in ( Naked (Link x url Nothing :| []) : + maybeToList (renderToc <$> NE.nonEmpty sitems), + NE.nonEmpty fitems + ) diff --git a/data/toc.html b/data/toc.html --- a/data/toc.html +++ b/data/toc.html @@ -9,7 +9,7 @@ Vestibulum nec ornare leo. Cras pharetra, ex sed dapibus pretium, diam lectus accumsan enim, at malesuada tellus lorem et orci. Sed condimentum varius ex in mollis.

-

https://example.org/

+

https://example.org

Ut in imperdiet neque. Etiam iaculis rhoncus nisl vel porta. Praesent velit orci, laoreet suscipit bibendum eu, ornare et orci. Fusce feugiat, felis a vehicula pulvinar, nulla purus dictum arcu, et varius urna purus et nibh. @@ -57,7 +57,7 @@ risus. Maecenas vehicula, leo vitae semper tristique, libero urna consectetur massa, eget pharetra magna est nec massa. Vestibulum malesuada lobortis lacinia.

-

My image

+

My image

Phasellus tincidunt metus quam, vel mollis turpis ultrices et. Phasellus consequat diam eu turpis sollicitudin tempus. Fusce suscipit bibendum nisl, quis rutrum eros volutpat in. Fusce tempor nisi eu ligula volutpat, eu diff --git a/mmark-ext.cabal b/mmark-ext.cabal --- a/mmark-ext.cabal +++ b/mmark-ext.cabal @@ -1,94 +1,103 @@ -name: mmark-ext -version: 0.2.1.2 -cabal-version: 1.18 -tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.3 -license: BSD3 -license-file: LICENSE.md -author: Mark Karpov -maintainer: Mark Karpov -homepage: https://github.com/mmark-md/mmark-ext -bug-reports: https://github.com/mmark-md/mmark-ext/issues -category: Text -synopsis: Commonly useful extensions for the MMark markdown processor -build-type: Simple +cabal-version: 1.18 +name: mmark-ext +version: 0.2.1.3 +license: BSD3 +license-file: LICENSE.md +maintainer: Mark Karpov +author: Mark Karpov +tested-with: ghc ==8.8.4 ghc ==8.10.4 ghc ==9.0.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 description: + Commonly useful extensions for the MMark markdown processor. Click on + "Text.MMark.Extension.Common" to get started. - Commonly useful extensions for the MMark markdown processor. Click on - "Text.MMark.Extension.Common" to get started. +category: Text +build-type: Simple +data-files: + data/*.md + data/*.html -extra-doc-files: CHANGELOG.md - , README.md -data-files: data/*.md - , data/*.html +extra-doc-files: + CHANGELOG.md + README.md source-repository head - type: git - location: https://github.com/mmark-md/mmark-ext.git + type: git + location: https://github.com/mmark-md/mmark-ext.git flag dev - description: Turn on development settings. - manual: True - default: False + description: Turn on development settings. + default: False + manual: True library - build-depends: base >= 4.9 && < 5.0 - , foldl >= 1.2 && < 1.5 - , lucid >= 2.6 && < 3.0 - , microlens >= 0.4 && < 0.5 - , mmark >= 0.0.4 && <= 0.1 - , modern-uri >= 0.2 && < 0.4 - , skylighting >= 0.5 && < 0.8 - , text >= 0.2 && < 1.3 - if impl(ghc >= 8.4) - build-depends: ghc-syntax-highlighter >= 0.0.1 && < 0.1 - exposed-modules: Text.MMark.Extension.Common - , 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 - if flag(dev) - ghc-options: -O0 -Wall -Werror -Wcompat - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wnoncanonical-monad-instances - -Wnoncanonical-monadfail-instances - else - ghc-options: -O2 -Wall - default-language: Haskell2010 + exposed-modules: + Text.MMark.Extension.Common + 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 + build-depends: + base >=4.13 && <5.0, + foldl >=1.2 && <1.5, + ghc-syntax-highlighter >=0.0.1 && <0.1, + lucid >=2.6 && <3.0, + microlens >=0.4 && <0.5, + mmark >=0.0.4 && <=0.1, + modern-uri >=0.3.4 && <0.4, + skylighting >=0.7.6 && <0.11, + text >=0.2 && <1.3 + + if flag(dev) + ghc-options: + -O0 -Wall -Werror -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wnoncanonical-monad-instances + + else + ghc-options: -O2 -Wall + test-suite tests - main-is: Spec.hs - hs-source-dirs: tests - type: exitcode-stdio-1.0 - build-depends: base >= 4.9 && < 5.0 - , hspec >= 2.0 && < 3.0 - , lucid >= 2.6 && < 3.0 - , mmark >= 0.0.4 && <= 0.1 - , mmark-ext - , skylighting >= 0.5 && < 0.8 - , text >= 0.2 && < 1.3 - build-tools: hspec-discover >= 2.0 && < 3.0 - if flag(dev) - ghc-options: -O0 -Wall -Werror - else - ghc-options: -O2 -Wall - other-modules: Text.MMark.Extension.CommentSpec - , Text.MMark.Extension.FontAwesomeSpec - , 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 + type: exitcode-stdio-1.0 + main-is: Spec.hs + build-tools: hspec-discover >=2.0 && <3.0 + hs-source-dirs: tests + other-modules: + Text.MMark.Extension.CommentSpec + Text.MMark.Extension.FontAwesomeSpec + 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 + build-depends: + base >=4.13 && <5.0, + hspec >=2.0 && <3.0, + lucid >=2.6 && <3.0, + mmark >=0.0.4 && <=0.1, + mmark-ext, + skylighting >=0.7.6 && <0.11, + text >=0.2 && <1.3 + + if flag(dev) + ghc-options: -O0 -Wall -Werror + + else + ghc-options: -O2 -Wall diff --git a/tests/Text/MMark/Extension/FontAwesomeSpec.hs b/tests/Text/MMark/Extension/FontAwesomeSpec.hs --- a/tests/Text/MMark/Extension/FontAwesomeSpec.hs +++ b/tests/Text/MMark/Extension/FontAwesomeSpec.hs @@ -18,7 +18,7 @@ "" `to` "

\n" context "when URI has some other scheme" $ it "produces the correct HTML" $ - "" `to` "

https://example.org/

\n" + "" `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 @@ -12,21 +12,21 @@ let to = withExt footnotes context "when link has no scheme" $ it "has no effect" $ - "Link [link](1)." `to` - "

Link link.

\n" + "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" + "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" + "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" + "> 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" + "> footnotes\n\n 1. Something.\n" + `to` "
    \n
  1. \nSomething.\n↩
    2. \n
\n" 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 @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Text.MMark.Extension.GhcSyntaxHighlighterSpec (spec) where @@ -11,13 +10,7 @@ spec = describe "ghcSyntaxHighlighter" $ do let to = withExt ghcSyntaxHighlighter - context "when info string is not \"haskell\"" $ - it "has no effect" $ - "```foo\nmain :: IO ()\nmain = return ()\n```\n" `to` - "
main :: IO ()\nmain = return ()\n
\n" -#if __GLASGOW_HASKELL__ >= 804 context "with info string is \"haskell\"" $ it "renders it correctly" $ - "```haskell\nmain :: IO ()\nmain = return ()\n```\n" `to` - "
main :: IO ()\nmain = return ()\n
\n" -#endif + "```haskell\nmain :: IO ()\nmain = return ()\n```\n" + `to` "
main :: IO ()\nmain = return ()\n
\n" diff --git a/tests/Text/MMark/Extension/LinkTargetSpec.hs b/tests/Text/MMark/Extension/LinkTargetSpec.hs --- a/tests/Text/MMark/Extension/LinkTargetSpec.hs +++ b/tests/Text/MMark/Extension/LinkTargetSpec.hs @@ -15,14 +15,14 @@ "[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" + "[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" + "[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" + "[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 @@ -9,29 +9,29 @@ spec :: Spec spec = describe "mathJax" $ do - let to = withExt (mathJax Nothing) + 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" + "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`." `to'` - "

I've got foo.

\n" + "I've got `foo`." + `to'` "

I've got foo.

\n" it "transforms matching code spans correctly" $ - "I've got `$foo$`." `to'` - "

I've got \\(foo\\).

\n" + "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" + "```\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" + "```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" + "```mathjax\nfoo\nbar\n```\n" + `to` "

\\[foo\\]\\[bar\\]

\n" diff --git a/tests/Text/MMark/Extension/ObfuscateEmailSpec.hs b/tests/Text/MMark/Extension/ObfuscateEmailSpec.hs --- a/tests/Text/MMark/Extension/ObfuscateEmailSpec.hs +++ b/tests/Text/MMark/Extension/ObfuscateEmailSpec.hs @@ -12,7 +12,7 @@ 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" + "" `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" 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 @@ -11,26 +11,26 @@ describe "punctuationPrettifier" $ do let to = withExt punctuationPrettifier context "on plain inlines" $ do - it "replaces ... with ellipsis" $ - "He forgot where he came from..." `to` "

He forgot where he came from…

\n" - it "replaces --- with em dash" $ - "Here we go---at last." `to` "

Here we go—at last.

\n" - it "replaces -- with en dash" $ - "Here we go -- at last." `to` "

Here we go – at last.

\n" - it "replaces double quotes intelligently" $ - "\"Something\"" `to` "

“Something”

\n" - it "replaces double quotes intelligently (empty)" $ - "\"\"" `to` "

“”

\n" - it "replaces single quotes intelligently" $ do - "'Something'" `to` "

‘Something’

\n" - "I'm doin' well, 'cause I care 'bout 'Big Jim'." - `to` "

I’m doin’ well, ‘cause I care ‘bout ‘Big Jim’.

\n" - it "replaces single quotes intelligently (empty)" $ - "''" `to` "

‘’

\n" - it "a tricky test 1" $ - "Something-\"foo\"." `to` "

Something-”foo”.

\n" - it "a tricky test 2" $ - "Something.--" `to` "

Something.–

\n" + it "replaces ... with ellipsis" $ + "He forgot where he came from..." `to` "

He forgot where he came from…

\n" + it "replaces --- with em dash" $ + "Here we go---at last." `to` "

Here we go—at last.

\n" + it "replaces -- with en dash" $ + "Here we go -- at last." `to` "

Here we go – at last.

\n" + it "replaces double quotes intelligently" $ + "\"Something\"" `to` "

“Something”

\n" + it "replaces double quotes intelligently (empty)" $ + "\"\"" `to` "

“”

\n" + it "replaces single quotes intelligently" $ do + "'Something'" `to` "

‘Something’

\n" + "I'm doin' well, 'cause I care 'bout 'Big Jim'." + `to` "

I’m doin’ well, ‘cause I care ‘bout ‘Big Jim’.

\n" + it "replaces single quotes intelligently (empty)" $ + "''" `to` "

‘’

\n" + it "a tricky test 1" $ + "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" 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 @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Text.MMark.Extension.SkylightingSpec (spec) where @@ -13,18 +12,9 @@ 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" `to` - "
main :: IO ()\nmain = return ()\n
\n" + "```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` -#if MIN_VERSION_skylighting(0,7,6) - -- version 0.7.6 and later - "
main :: IO ()\nmain = return ()\n
\n" -#elif MIN_VERSION_skylighting(0,7,4) - -- versions 0.7.4 and 0.7.5 - "
main :: IO ()\nmain = return ()\n
\n" -#else - -- versions older than 0.7.4 - "
main :: IO ()\nmain = return ()\n
\n" -#endif + "```haskell\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,24 +2,25 @@ 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 Test.Hspec +import qualified Text.MMark as MMark import Text.MMark.Extension.TableOfContents -import qualified Data.Text.IO as TIO -import qualified Data.Text.Lazy as TL -import qualified Lucid as L -import qualified Text.MMark as MMark spec :: Spec spec = describe "toc" $ it "works" $ do - input <- TIO.readFile "data/toc.md" + input <- TIO.readFile "data/toc.md" expected <- TIO.readFile "data/toc.html" let Right doc = MMark.parse "" input - headings = MMark.runScanner doc (tocScanner (> 1)) - actual = TL.toStrict - . L.renderText - . MMark.render - . MMark.useExtension (toc "toc" headings) - $ doc + headings = MMark.runScanner doc (tocScanner (> 1)) + actual = + TL.toStrict + . L.renderText + . MMark.render + . MMark.useExtension (toc "toc" headings) + $ doc actual `shouldBe` expected 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,26 +1,30 @@ module Text.MMark.Extension.TestUtils - ( withExt ) + ( withExt, + ) where import Data.Text (Text) -import Test.Hspec import qualified Data.Text.Lazy as TL -import qualified Lucid as L -import qualified Text.MMark as MMark +import qualified Lucid as L +import Test.Hspec +import qualified Text.MMark as MMark -- | Feed input into MMark parser, apply an extension, render the parsed -- document and demand that it matches the given example. - -withExt - :: MMark.Extension -- ^ MMark extension to use - -> Text -- ^ Input for the parser - -> Text -- ^ Expected output of the render - -> Expectation +withExt :: + -- | MMark extension to use + MMark.Extension -> + -- | Input for the parser + Text -> + -- | Expected output of the render + Text -> + Expectation withExt ext input expected = do let Right doc = MMark.parse "" input - actual = TL.toStrict - . L.renderText - . MMark.render - . MMark.useExtension ext - $ doc + actual = + TL.toStrict + . L.renderText + . MMark.render + . MMark.useExtension ext + $ doc actual `shouldBe` expected