summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormrkkrp <>2018-03-08 17:17:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-03-08 17:17:00 (GMT)
commitfef185cb897b25620aec120695cc51dd084a81c3 (patch)
tree00f6de31f48fd53ca762ecce0a9cc9efb586aff4
parentf34379390517a8516e5d768332908a3e924dfd6e (diff)
version 0.0.5.6HEAD0.0.5.6master
-rw-r--r--CHANGELOG.md5
-rw-r--r--README.md2
-rw-r--r--Text/MMark/Extension.hs10
-rw-r--r--Text/MMark/Render.hs6
-rw-r--r--Text/MMark/Trans.hs47
-rw-r--r--Text/MMark/Type.hs4
-rw-r--r--mmark.cabal9
-rw-r--r--tests/Text/MMark/ExtensionSpec.hs14
8 files changed, 82 insertions, 15 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index de2b168..b61e2d7 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,8 @@
+## MMark 0.0.5.6
+
+* Now `blockTrans` and `inlineTrans` are applied to deeply nested elements
+ too, not only top-level elements.
+
## MMark 0.0.5.5
* Fixed the bug in parser which signalled a parse error when YAML block was
diff --git a/README.md b/README.md
index 30caa1a..e88140a 100644
--- a/README.md
+++ b/README.md
@@ -42,7 +42,7 @@ https://markkarpov.com/post/announcing-mmark.html
## Quick start: MMark vs GitHub-flavored markdown
It's easy to start using MMark if you're used to GitHub-flavored markdown.
-There are three main differences:
+There are four main differences:
1. URIs are not automatically recognized, you must enclose them in `<` and
`>`.
diff --git a/Text/MMark/Extension.hs b/Text/MMark/Extension.hs
index 5b0633d..fec25d6 100644
--- a/Text/MMark/Extension.hs
+++ b/Text/MMark/Extension.hs
@@ -106,7 +106,11 @@ import Text.MMark.Util
import qualified Control.Foldl as L
-- | Create an extension that performs a transformation on 'Block's of
--- markdown document.
+-- markdown document. Since a block may contain other blocks we choose to
+-- perform transformations from the most deeply nested blocks moving
+-- upwards. This has the benefit that the result of any transformation is
+-- final in the sense that sub-elements of resulting block won't be
+-- traversed again.
blockTrans :: (Bni -> Bni) -> Extension
blockTrans f = mempty { extBlockTrans = Endo f }
@@ -131,7 +135,9 @@ blockRender
blockRender f = mempty { extBlockRender = Render f }
-- | Create an extension that performs a transformation on 'Inline'
--- components in entire markdown document.
+-- components in entire markdown document. Similarly to 'blockTrans' the
+-- transformation is applied from the most deeply nested elements moving
+-- upwards.
inlineTrans :: (Inline -> Inline) -> Extension
inlineTrans f = mempty { extInlineTrans = Endo f }
diff --git a/Text/MMark/Render.hs b/Text/MMark/Render.hs
index 485a983..a17dad8 100644
--- a/Text/MMark/Render.hs
+++ b/Text/MMark/Render.hs
@@ -22,9 +22,9 @@ import Control.Monad
import Data.Char (isSpace)
import Data.Function (fix)
import Data.List.NonEmpty (NonEmpty (..))
-import Data.Monoid hiding ((<>))
import Data.Semigroup
import Lucid
+import Text.MMark.Trans
import Text.MMark.Type
import Text.MMark.Util
import qualified Data.List.NonEmpty as NE
@@ -46,10 +46,10 @@ render MMark {..} =
rBlock
= applyBlockRender extBlockRender
. fmap rInlines
- . appEndo extBlockTrans
+ . applyBlockTrans extBlockTrans
rInlines
= (mkOisInternal &&& mapM_ (applyInlineRender extInlineRender))
- . fmap (appEndo extInlineTrans)
+ . fmap (applyInlineTrans extInlineTrans)
-- | Apply a 'Render' to a given @'Block' 'Html' ()@.
diff --git a/Text/MMark/Trans.hs b/Text/MMark/Trans.hs
new file mode 100644
index 0000000..3911870
--- /dev/null
+++ b/Text/MMark/Trans.hs
@@ -0,0 +1,47 @@
+-- |
+-- Module : Text.MMark.Trans
+-- Copyright : © 2017–2018 Mark Karpov
+-- License : BSD 3 clause
+--
+-- Maintainer : Mark Karpov <markkarpov92@gmail.com>
+-- Stability : experimental
+-- Portability : portable
+--
+-- MMark block\/inline transformation helpers.
+
+{-# LANGUAGE LambdaCase #-}
+
+module Text.MMark.Trans
+ ( applyBlockTrans
+ , applyInlineTrans )
+where
+
+import Data.Monoid hiding ((<>))
+import Text.MMark.Type
+
+-- | Apply block transformation in the @'Endo' 'Bni'@ form to a block 'Bni'.
+
+applyBlockTrans :: Endo Bni -> Bni -> Bni
+applyBlockTrans trans@(Endo f) = \case
+ Blockquote xs -> f (Blockquote (s xs))
+ OrderedList w xs -> f (OrderedList w (s <$> xs))
+ UnorderedList xs -> f (UnorderedList (s <$> xs))
+ other -> f other
+ where
+ s = fmap (applyBlockTrans trans)
+
+-- | Apply inline transformation in the @'Endo' 'Inline'@ form to an
+-- 'Inline'.
+
+applyInlineTrans :: Endo Inline -> Inline -> Inline
+applyInlineTrans trans@(Endo f) = \case
+ Emphasis xs -> f (Emphasis (s xs))
+ Strong xs -> f (Strong (s xs))
+ Strikeout xs -> f (Strikeout (s xs))
+ Subscript xs -> f (Subscript (s xs))
+ Superscript xs -> f (Superscript (s xs))
+ Link xs uri mt -> f (Link (s xs) uri mt)
+ Image xs uri mt -> f (Image (s xs) uri mt)
+ other -> f other
+ where
+ s = fmap (applyInlineTrans trans)
diff --git a/Text/MMark/Type.hs b/Text/MMark/Type.hs
index f276b46..f6d1406 100644
--- a/Text/MMark/Type.hs
+++ b/Text/MMark/Type.hs
@@ -121,7 +121,7 @@ newtype Render a = Render
{ runRender :: (a -> Html ()) -> a -> Html () }
instance Semigroup (Render a) where
- Render f <> Render g = Render $ \h -> f (g h)
+ Render f <> Render g = Render (f . g)
instance Monoid (Render a) where
mempty = Render id
@@ -221,7 +221,7 @@ data Inline
instance NFData Inline
--- | A wrapper for “originial inlines”. Source inlines are wrapped in this
+-- | A wrapper for “original inlines”. Source inlines are wrapped in this
-- during rendering of inline components and then it's available to block
-- render, but only for inspection. Altering of 'Ois' is not possible
-- because the user cannot construct a value of the 'Ois' type, he\/she can
diff --git a/mmark.cabal b/mmark.cabal
index d140c95..611473c 100644
--- a/mmark.cabal
+++ b/mmark.cabal
@@ -1,5 +1,5 @@
name: mmark
-version: 0.0.5.5
+version: 0.0.5.6
cabal-version: >= 1.18
tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
license: BSD3
@@ -27,7 +27,7 @@ flag dev
default: False
library
- build-depends: aeson >= 0.11 && < 1.3
+ build-depends: aeson >= 0.11 && < 1.4
, base >= 4.8 && < 5.0
, case-insensitive >= 1.2 && < 1.3
, containers >= 0.5 && < 0.6
@@ -61,6 +61,7 @@ library
, Text.MMark.Parser.Internal
, Text.MMark.Parser.Internal.Type
, Text.MMark.Render
+ , Text.MMark.Trans
, Text.MMark.Type
, Text.MMark.Util
if flag(dev)
@@ -74,7 +75,7 @@ test-suite tests
hs-source-dirs: tests
type: exitcode-stdio-1.0
build-depends: QuickCheck >= 2.4 && < 3.0
- , aeson >= 0.11 && < 1.3
+ , aeson >= 0.11 && < 1.4
, base >= 4.8 && < 5.0
, foldl >= 1.2 && < 1.4
, hspec >= 2.0 && < 3.0
@@ -100,7 +101,7 @@ benchmark bench-speed
hs-source-dirs: bench/speed
type: exitcode-stdio-1.0
build-depends: base >= 4.8 && < 5.0
- , criterion >= 0.6.2.1 && < 1.4
+ , criterion >= 0.6.2.1 && < 1.5
, mmark
, text >= 0.2 && < 1.3
if flag(dev)
diff --git a/tests/Text/MMark/ExtensionSpec.hs b/tests/Text/MMark/ExtensionSpec.hs
index e35ba07..65788c1 100644
--- a/tests/Text/MMark/ExtensionSpec.hs
+++ b/tests/Text/MMark/ExtensionSpec.hs
@@ -19,11 +19,15 @@ import qualified Text.URI as URI
spec :: Spec
spec = parallel $ do
- describe "blockTrans" $
+ describe "blockTrans" $ do
it "works" $ do
doc <- mkDoc "# My heading"
toText (MMark.useExtension h1_to_h2 doc)
`shouldBe` "<h2 id=\"my-heading\">My heading</h2>\n"
+ it "extensions can affect nested block structures" $ do
+ doc <- mkDoc "* # My heading"
+ toText (MMark.useExtension h1_to_h2 doc)
+ `shouldBe` "<ul>\n<li>\n<h2 id=\"my-heading\">My heading</h2>\n</li>\n</ul>\n"
describe "blockRender" $ do
it "works" $ do
doc <- mkDoc "# My heading"
@@ -33,11 +37,15 @@ spec = parallel $ do
doc <- mkDoc "* # Something"
toText (MMark.useExtension add_h1_content doc)
`shouldBe` "<ul>\n<li>\n<h1 data-content=\"Something\" id=\"something\">Something</h1>\n</li>\n</ul>\n"
- describe "inlineTrans" $
+ describe "inlineTrans" $ do
it "works" $ do
doc <- mkDoc "# My *heading*"
toText (MMark.useExtension em_to_strong doc)
`shouldBe` "<h1 id=\"my-heading\">My <strong>heading</strong></h1>\n"
+ it "extensions can affect nested inline structures" $ do
+ doc <- mkDoc "# My ~*heading*~"
+ toText (MMark.useExtension em_to_strong doc)
+ `shouldBe` "<h1 id=\"my-heading\">My <sub><strong>heading</strong></sub></h1>\n"
describe "inlineRender" $ do
it "works" $ do
doc <- mkDoc "# My *heading*"
@@ -134,7 +142,7 @@ add_h1_content = Ext.blockRender $ \old block ->
[ L.data_ "content" (Ext.asPlainText . Ext.getOis . fst $ inner) ]
other -> old other
--- | Covert all 'Emphasis' to 'Strong'.
+-- | Convert all 'Emphasis' to 'Strong'.
em_to_strong :: MMark.Extension
em_to_strong = Ext.inlineTrans $ \case