mmark 0.0.7.6 → 0.0.8.0

raw patch · 18 files changed

+434/−377 lines, 18 filesdep ~containersdep ~microlenssetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers, microlens

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• Setup.hs +0/−6
• Text/MMark.hs +3/−3
• Text/MMark/Extension.hs +3/−3
• Text/MMark/Internal/Type.hs +241/−0
• Text/MMark/Parser.hs +38/−38
• Text/MMark/Parser/Internal.hs +4/−4
• Text/MMark/Parser/Internal/Type.hs +9/−6
• Text/MMark/Render.hs +21/−4
• Text/MMark/Trans.hs +7/−1
• Text/MMark/Type.hs +0/−237
• Text/MMark/Util.hs +12/−4
• bench/memory/Main.hs +2/−2
• bench/speed/Main.hs +2/−2
• mmark.cabal +43/−40
• tests/Text/MMark/ExtensionSpec.hs +5/−5
• tests/Text/MMark/TestUtils.hs +4/−4
• tests/Text/MMarkSpec.hs +35/−18

@@ -1,3 +1,8 @@+## MMark 0.0.8.0++* Exposed the following modules: `Text.MMark.Internal.Type`,+  `Text.MMark.Render`, `Text.MMark.Trans`, `Text.MMark.Util`.+ ## MMark 0.0.7.6  * The test suite now passes with `modern-uri-0.3.4.4`.

@@ -1,6 +0,0 @@-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain

@@ -133,11 +133,11 @@   ) where -import qualified Control.Foldl as L+import Control.Foldl qualified as L import Data.Aeson+import Text.MMark.Internal.Type import Text.MMark.Parser (MMarkErr (..), parse) import Text.MMark.Render (render)-import Text.MMark.Type  ---------------------------------------------------------------------------- -- Extensions@@ -186,7 +186,7 @@ -- -- @since 0.0.2.0 runScannerM ::-  Monad m =>+  (Monad m) =>   -- | Document to scan   MMark ->   -- | 'L.FoldM' to use

@@ -102,10 +102,10 @@   ) where -import qualified Control.Foldl as L+import Control.Foldl qualified as L import Data.Monoid hiding ((<>)) import Lucid-import Text.MMark.Type+import Text.MMark.Internal.Type import Text.MMark.Util  -- | Create an extension that performs a transformation on 'Block's of@@ -164,7 +164,7 @@ -- -- @since 0.0.2.0 scannerM ::-  Monad m =>+  (Monad m) =>   -- | Initial state   m a ->   -- | Folding function

@@ -0,0 +1,241 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module      :  Text.MMark.Internal.Type+-- Copyright   :  © 2017–present Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Internal type definitions. The public subset of these is re-exported from+-- "Text.MMark.Extension".+--+-- @since 0.0.8.0+module Text.MMark.Internal.Type+  ( MMark (..),+    Extension (..),+    Render (..),+    Bni,+    Block (..),+    CellAlign (..),+    Inline (..),+    Ois,+    mkOisInternal,+    getOis,+  )+where++import Control.DeepSeq+import Data.Aeson+import Data.Data (Data)+import Data.Function (on)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Monoid hiding ((<>))+import Data.Text (Text)+import Data.Typeable (Typeable)+import GHC.Generics+import Lucid+import Text.URI (URI (..))++-- | Representation of complete markdown document. You can't look inside of+-- 'MMark' on purpose. The only way to influence an 'MMark' document you+-- obtain as a result of parsing is via the extension mechanism.+data MMark = MMark+  { -- | Parsed YAML document at the beginning (optional)+    mmarkYaml :: Maybe Value,+    -- | Actual contents of the document+    mmarkBlocks :: [Bni],+    -- | Extension specifying how to process and render the blocks+    mmarkExtension :: Extension+  }++instance NFData MMark where+  rnf MMark {..} = rnf mmarkYaml `seq` rnf mmarkBlocks++-- | Dummy instance.+--+-- @since 0.0.5.0+instance Show MMark where+  show = const "MMark {..}"++-- | An extension. You can apply extensions with 'Text.MMark.useExtension'+-- and 'Text.MMark.useExtensions' functions. The "Text.MMark.Extension"+-- module provides tools for writing your own extensions.+--+-- Note that 'Extension' is an instance of 'Semigroup' and 'Monoid', i.e.+-- you can combine several extensions into one. Since the @('<>')@ operator+-- is right-associative and 'mconcat' is a right fold under the hood, the+-- expression+--+-- > l <> r+--+-- means that the extension @r@ will be applied before the extension @l@,+-- similar to how 'Endo' works. This may seem counter-intuitive, but only+-- with this logic we get consistency of ordering with more complex+-- expressions:+--+-- > e2 <> e1 <> e0 == e2 <> (e1 <> e0)+--+-- Here, @e0@ will be applied first, then @e1@, then @e2@. The same applies+-- to expressions involving 'mconcat'—extensions closer to beginning of the+-- list passed to 'mconcat' will be applied later.+data Extension = Extension+  { -- | Block transformation+    extBlockTrans :: Endo Bni,+    -- | Block render+    extBlockRender :: Render (Block (Ois, Html ())),+    -- | Inline transformation+    extInlineTrans :: Endo Inline,+    -- | Inline render+    extInlineRender :: Render Inline+  }++instance Semigroup Extension where+  x <> y =+    Extension+      { extBlockTrans = on (<>) extBlockTrans x y,+        extBlockRender = on (<>) extBlockRender x y,+        extInlineTrans = on (<>) extInlineTrans x y,+        extInlineRender = on (<>) extInlineRender x y+      }++instance Monoid Extension where+  mempty =+    Extension+      { extBlockTrans = mempty,+        extBlockRender = mempty,+        extInlineTrans = mempty,+        extInlineRender = mempty+      }+  mappend = (<>)++-- | An internal type that captures the extensible rendering process we use.+-- 'Render' has a function inside which transforms a rendering function of+-- the type @a -> Html ()@.+--+-- @since 0.0.8.0+newtype Render a = Render+  {runRender :: (a -> Html ()) -> a -> Html ()}++instance Semigroup (Render a) where+  Render f <> Render g = Render (f . g)++instance Monoid (Render a) where+  mempty = Render id+  mappend = (<>)++-- | A shortcut for the frequently used type @'Block' ('NonEmpty'+-- 'Inline')@.+type Bni = Block (NonEmpty Inline)++-- | We can think of a markdown document as a collection of+-- blocks—structural elements like paragraphs, block quotations, lists,+-- headings, thematic breaks, and code blocks. Some blocks (like block+-- quotes and list items) contain other blocks; others (like headings and+-- paragraphs) contain inline content, see 'Inline'.+--+-- We can divide blocks into two types: container blocks, which can contain+-- other blocks, and leaf blocks, which cannot.+data Block a+  = -- | Thematic break, leaf block+    ThematicBreak+  | -- | Heading (level 1), leaf block+    Heading1 a+  | -- | Heading (level 2), leaf block+    Heading2 a+  | -- | Heading (level 3), leaf block+    Heading3 a+  | -- | Heading (level 4), leaf block+    Heading4 a+  | -- | Heading (level 5), leaf block+    Heading5 a+  | -- | Heading (level 6), leaf block+    Heading6 a+  | -- | Code block, leaf block with info string and contents+    CodeBlock (Maybe Text) Text+  | -- | Naked content, without an enclosing tag+    Naked a+  | -- | Paragraph, leaf block+    Paragraph a+  | -- | Blockquote container block+    Blockquote [Block a]+  | -- | Ordered list ('Word' is the start index), container block+    OrderedList Word (NonEmpty [Block a])+  | -- | Unordered list, container block+    UnorderedList (NonEmpty [Block a])+  | -- | Table, first argument is the alignment options, then we have a+    -- 'NonEmpty' list of rows, where every row is a 'NonEmpty' list of+    -- cells, where every cell is an @a@ thing.+    --+    -- The first row is always the header row, because pipe-tables that we+    -- support cannot lack a header row.+    --+    -- @since 0.0.4.0+    Table (NonEmpty CellAlign) (NonEmpty (NonEmpty a))+  deriving (Show, Eq, Ord, Data, Typeable, Generic, Functor, Foldable)++instance (NFData a) => NFData (Block a)++-- | Options for cell alignment in tables.+--+-- @since 0.0.4.0+data CellAlign+  = -- | No specific alignment specified+    CellAlignDefault+  | -- | Left-alignment+    CellAlignLeft+  | -- | Right-alignment+    CellAlignRight+  | -- | Center-alignment+    CellAlignCenter+  deriving (Show, Eq, Ord, Data, Typeable, Generic)++instance NFData CellAlign++-- | Inline markdown content.+data Inline+  = -- | Plain text+    Plain Text+  | -- | Line break (hard)+    LineBreak+  | -- | Emphasis+    Emphasis (NonEmpty Inline)+  | -- | Strong emphasis+    Strong (NonEmpty Inline)+  | -- | Strikeout+    Strikeout (NonEmpty Inline)+  | -- | Subscript+    Subscript (NonEmpty Inline)+  | -- | Superscript+    Superscript (NonEmpty Inline)+  | -- | Code span+    CodeSpan Text+  | -- | Link with text, destination, and optionally title+    Link (NonEmpty Inline) URI (Maybe Text)+  | -- | Image with description, URL, and optionally title+    Image (NonEmpty Inline) URI (Maybe Text)+  deriving (Show, Eq, Ord, Data, Typeable, Generic)++instance NFData Inline++-- | 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+-- only inspect it with 'getOis'.+newtype Ois = Ois (NonEmpty Inline)++-- | Make an 'Ois' value. This is an internal constructor that should not be+-- exposed!+mkOisInternal :: NonEmpty Inline -> Ois+mkOisInternal = Ois++-- | Project @'NonEmpty' 'Inline'@ from 'Ois'.+getOis :: Ois -> NonEmpty Inline+getOis (Ois inlines) = inlines

@@ -24,35 +24,35 @@   ) where -import Control.Applicative (Alternative, liftA2)+import Control.Applicative hiding (many, some) import Control.Monad-import qualified Control.Monad.Combinators.NonEmpty as NE-import qualified Data.Aeson as Aeson+import Control.Monad.Combinators.NonEmpty qualified as NE+import Data.Aeson qualified as Aeson import Data.Bifunctor (Bifunctor (..)) import Data.Bool (bool)-import qualified Data.Char as Char-import qualified Data.DList as DList+import Data.Char qualified as Char+import Data.DList qualified as DList import Data.HTML.Entities (htmlEntityMap)-import qualified Data.HashMap.Strict as HM+import Data.HashMap.Strict qualified as HM import Data.List.NonEmpty (NonEmpty (..), (<|))-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Maybe (catMaybes, fromJust, isJust, isNothing) import Data.Monoid (Any (..)) import Data.Ratio ((%))-import qualified Data.Set as E+import Data.Set qualified as E import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE import Lens.Micro ((^.))-import qualified Text.Email.Validate as Email+import Text.Email.Validate qualified as Email+import Text.MMark.Internal.Type import Text.MMark.Parser.Internal-import Text.MMark.Type import Text.MMark.Util import Text.Megaparsec hiding (State (..), parse) import Text.Megaparsec.Char hiding (eol)-import qualified Text.Megaparsec.Char.Lexer as L+import Text.Megaparsec.Char.Lexer qualified as L import Text.URI (URI)-import qualified Text.URI as URI+import Text.URI qualified as URI import Text.URI.Lens (uriPath)  #if !defined(ghcjs_HOST_OS)@@ -518,7 +518,7 @@         <$ manyTill           (optional nonEmptyLine)           (endOfTable >>= guard)-          <* sc+        <* sc  -- | Parse a paragraph or naked text (in some cases). pParagraph :: BParser (Block Isp)@@ -816,7 +816,7 @@     mkLabel = T.unwords . T.words . asPlainText  -- | Parse a URI.-pUri :: (Ord e, Show e, MonadParsec e Text m) => m URI+pUri :: (MonadParsec e Text m) => m URI pUri = between (char '<') (char '>') URI.parser <|> naked   where     naked = do@@ -831,7 +831,7 @@       return r  -- | Parse a title of a link or an image.-pTitle :: MonadParsec MMarkErr Text m => m Text+pTitle :: (MonadParsec MMarkErr Text m) => m Text pTitle =   choice     [ p '\"' '\"',@@ -845,7 +845,7 @@          in manyEscapedWith f "unescaped character"  -- | Parse label of a reference link.-pRefLabel :: MonadParsec MMarkErr Text m => m (Int, Text)+pRefLabel :: (MonadParsec MMarkErr Text m) => m (Int, Text) pRefLabel = do   try $ do     void (char '[')@@ -927,7 +927,7 @@   where     go !n = liftA2 (:) (m n) (go (n + 1)) <|> pure [] -foldMany :: MonadPlus m => m (a -> a) -> m (a -> a)+foldMany :: (MonadPlus m) => m (a -> a) -> m (a -> a) foldMany f = go id   where     go g =@@ -935,7 +935,7 @@         Nothing -> pure g         Just h -> go (h . g) -foldMany' :: MonadPlus m => m ([a] -> [a]) -> m [a]+foldMany' :: (MonadPlus m) => m ([a] -> [a]) -> m [a] foldMany' f = ($ []) <$> go id   where     go g =@@ -943,13 +943,13 @@         Nothing -> pure g         Just h -> go (g . h) -foldSome :: MonadPlus m => m (a -> a) -> m (a -> a)+foldSome :: (MonadPlus m) => m (a -> a) -> m (a -> a) foldSome f = liftA2 (flip (.)) f (foldMany f) -foldSome' :: MonadPlus m => m ([a] -> [a]) -> m [a]+foldSome' :: (MonadPlus m) => m ([a] -> [a]) -> m [a] foldSome' f = liftA2 ($) f (foldMany' f) -sepByCount :: MonadPlus m => Int -> m a -> m sep -> m [a]+sepByCount :: (MonadPlus m) => Int -> m a -> m sep -> m [a] sepByCount 0 _ _ = pure [] sepByCount n p sep = liftA2 (:) p (count (n - 1) (sep *> p)) @@ -957,7 +957,7 @@ nonEmptyLine = takeWhile1P Nothing notNewline  manyEscapedWith ::-  MonadParsec MMarkErr Text m =>+  (MonadParsec MMarkErr Text m) =>   (Char -> Bool) ->   String ->   m Text@@ -970,7 +970,7 @@     ]  someEscapedWith ::-  MonadParsec MMarkErr Text m =>+  (MonadParsec MMarkErr Text m) =>   (Char -> Bool) ->   m Text someEscapedWith f =@@ -981,13 +981,13 @@       (:) <$> satisfy f     ] -escapedChar :: MonadParsec e Text m => m Char+escapedChar :: (MonadParsec e Text m) => m Char escapedChar =   label "escaped character" $     try (char '\\' *> satisfy isAsciiPunctuation)  -- | Parse an HTML5 entity reference.-entityRef :: MonadParsec MMarkErr Text m => m String+entityRef :: (MonadParsec MMarkErr Text m) => m String entityRef = do   o <- getOffset   let f (TrivialError _ us es) = TrivialError o us es@@ -1004,7 +1004,7 @@     Just txt -> return (T.unpack txt)  -- | Parse a numeric character using the given numeric parser.-numRef :: MonadParsec MMarkErr Text m => m Char+numRef :: (MonadParsec MMarkErr Text m) => m Char numRef = do   o <- getOffset   let f = between (string "&#") (char ';')@@ -1013,19 +1013,19 @@     then customFailure' o (InvalidNumericCharacter n)     else return (Char.chr n) -sc :: MonadParsec e Text m => m ()+sc :: (MonadParsec e Text m) => m () sc = void $ takeWhileP (Just "white space") isSpaceN -sc1 :: MonadParsec e Text m => m ()+sc1 :: (MonadParsec e Text m) => m () sc1 = void $ takeWhile1P (Just "white space") isSpaceN -sc' :: MonadParsec e Text m => m ()+sc' :: (MonadParsec e Text m) => m () sc' = void $ takeWhileP (Just "white space") isSpace -sc1' :: MonadParsec e Text m => m ()+sc1' :: (MonadParsec e Text m) => m () sc1' = void $ takeWhile1P (Just "white space") isSpace -eol :: MonadParsec e Text m => m ()+eol :: (MonadParsec e Text m) => m () eol =   void . label "newline" $     choice@@ -1034,7 +1034,7 @@         string "\r"       ] -eol' :: MonadParsec e Text m => m Bool+eol' :: (MonadParsec e Text m) => m Bool eol' = option False (True <$ eol)  ----------------------------------------------------------------------------@@ -1152,7 +1152,7 @@   SubscriptFrame -> "~"   SuperscriptFrame -> "^" -replaceEof :: forall e. Show e => String -> ParseError Text e -> ParseError Text e+replaceEof :: String -> ParseError Text e -> ParseError Text e replaceEof altLabel = \case   TrivialError pos us es -> TrivialError pos (f <$> us) (E.map f es)   FancyError pos xs -> FancyError pos xs@@ -1245,7 +1245,7 @@     toNaked (Paragraph inner) = Naked inner     toNaked other = other -succeeds :: Alternative m => m () -> m Bool+succeeds :: (Alternative m) => m () -> m Bool succeeds m = True <$ m <|> pure False  prependErr :: Int -> MMarkErr -> [Block Isp] -> [Block Isp]@@ -1259,7 +1259,7 @@ toNesTokens :: Text -> NonEmpty Char toNesTokens = NE.fromList . T.unpack -unexpEic :: MonadParsec e Text m => ErrorItem Char -> m a+unexpEic :: (MonadParsec e Text m) => ErrorItem Char -> m a unexpEic x =   failure     (Just x)@@ -1278,7 +1278,7 @@  -- | Report custom failure at specified location. customFailure' ::-  MonadParsec MMarkErr Text m =>+  (MonadParsec MMarkErr Text m) =>   Int ->   MMarkErr ->   m a

@@ -47,8 +47,8 @@ import Data.Bifunctor import Data.Function ((&)) import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM-import qualified Data.List.NonEmpty as NE+import Data.HashMap.Strict qualified as HM+import Data.List.NonEmpty qualified as NE import Data.Ratio ((%)) import Data.Text (Text) import Data.Text.Metrics (damerauLevenshteinNorm)@@ -56,7 +56,7 @@ import Lens.Micro.Extras (view) import Text.MMark.Parser.Internal.Type import Text.Megaparsec hiding (State)-import qualified Text.Megaparsec as M+import Text.Megaparsec qualified as M import Text.URI (URI)  ----------------------------------------------------------------------------@@ -252,7 +252,7 @@     }  -- | Locally change state in a state monad and then restore it back.-locally :: MonadState s m => Lens' s a -> a -> m b -> m b+locally :: (MonadState s m) => Lens' s a -> a -> m b -> m b locally l x m = do   y <- gets (^. l)   modify' (set l x)

@@ -47,17 +47,17 @@  import Control.DeepSeq import Data.CaseInsensitive (CI)-import qualified Data.CaseInsensitive as CI+import Data.CaseInsensitive qualified as CI import Data.Data (Data) import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM+import Data.HashMap.Strict qualified as HM import Data.Hashable (Hashable) import Data.List (intercalate) import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Proxy import Data.Text (Text)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Typeable (Typeable) import GHC.Generics import Lens.Micro.TH@@ -208,10 +208,13 @@       showTokens (Proxy :: Proxy Text) dels         ++ " should be in left- or right- flanking position"     ListStartIndexTooBig n ->-      "ordered list start numbers must be nine digits or less, " ++ show n+      "ordered list start numbers must be nine digits or less, "+        ++ show n         ++ " is too big"     ListIndexOutOfOrder actual expected ->-      "list index is out of order: " ++ show actual ++ ", expected "+      "list index is out of order: "+        ++ show actual+        ++ ", expected "         ++ show expected     DuplicateReferenceDefinition name ->       "duplicate reference definitions are not allowed: \""

@@ -12,8 +12,15 @@ -- Portability :  portable -- -- MMark rendering machinery.+--+-- @since 0.0.8.0 module Text.MMark.Render   ( render,+    applyBlockRender,+    defaultBlockRender,+    applyInlineRender,+    defaultInlineRender,+    newline,   ) where @@ -22,13 +29,13 @@ import Data.Char (isSpace) import Data.Function (fix) import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NE-import qualified Data.Text as T+import Data.List.NonEmpty qualified as NE+import Data.Text qualified as T import Lucid+import Text.MMark.Internal.Type import Text.MMark.Trans-import Text.MMark.Type import Text.MMark.Util-import qualified Text.URI as URI+import Text.URI qualified as URI  -- | Render a 'MMark' markdown document. You can then render @'Html' ()@ to -- various things:@@ -50,6 +57,8 @@         . fmap (applyInlineTrans extInlineTrans)  -- | Apply a 'Render' to a given @'Block' 'Html' ()@.+--+-- @since 0.0.8.0 applyBlockRender ::   Render (Block (Ois, Html ())) ->   Block (Ois, Html ()) ->@@ -57,6 +66,8 @@ applyBlockRender r = fix (runRender r . defaultBlockRender)  -- | The default 'Block' render.+--+-- @since 0.0.8.0 defaultBlockRender ::   -- | Rendering function to use to render sub-blocks   (Block (Ois, Html ()) -> Html ()) ->@@ -131,10 +142,14 @@       CellAlignCenter -> [style_ "text-align:center"]  -- | Apply a render to a given 'Inline'.+--+-- @since 0.0.8.0 applyInlineRender :: Render Inline -> Inline -> Html () applyInlineRender r = fix (runRender r . defaultInlineRender)  -- | The default render for 'Inline' elements.+--+-- @since 0.0.8.0 defaultInlineRender ::   -- | Rendering function to use to render sub-inlines   (Inline -> Html ()) ->@@ -165,5 +180,7 @@      in img_ (alt_ (asPlainText desc) : src_ (URI.render src) : title)  -- | HTML containing a newline.+--+-- @since 0.0.8.0 newline :: Html () newline = "\n"

@@ -10,6 +10,8 @@ -- Portability :  portable -- -- MMark block\/inline transformation helpers.+--+-- @since 0.0.8.0 module Text.MMark.Trans   ( applyBlockTrans,     applyInlineTrans,@@ -17,9 +19,11 @@ where  import Data.Monoid hiding ((<>))-import Text.MMark.Type+import Text.MMark.Internal.Type  -- | Apply block transformation in the @'Endo' 'Bni'@ form to a block 'Bni'.+--+-- @since 0.0.8.0 applyBlockTrans :: Endo Bni -> Bni -> Bni applyBlockTrans trans@(Endo f) = \case   Blockquote xs -> f (Blockquote (s xs))@@ -31,6 +35,8 @@  -- | Apply inline transformation in the @'Endo' 'Inline'@ form to an -- 'Inline'.+--+-- @since 0.0.8.0 applyInlineTrans :: Endo Inline -> Inline -> Inline applyInlineTrans trans@(Endo f) = \case   Emphasis xs -> f (Emphasis (s xs))

@@ -1,237 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE RecordWildCards #-}---- |--- Module      :  Text.MMark.Type--- Copyright   :  © 2017–present Mark Karpov--- License     :  BSD 3 clause------ Maintainer  :  Mark Karpov <markkarpov92@gmail.com>--- Stability   :  experimental--- Portability :  portable------ Internal type definitions. Some of these are re-exported in the public--- modules.-module Text.MMark.Type-  ( MMark (..),-    Extension (..),-    Render (..),-    Bni,-    Block (..),-    CellAlign (..),-    Inline (..),-    Ois,-    mkOisInternal,-    getOis,-  )-where--import Control.DeepSeq-import Data.Aeson-import Data.Data (Data)-import Data.Function (on)-import Data.List.NonEmpty (NonEmpty (..))-import Data.Monoid hiding ((<>))-import Data.Text (Text)-import Data.Typeable (Typeable)-import GHC.Generics-import Lucid-import Text.URI (URI (..))---- | Representation of complete markdown document. You can't look inside of--- 'MMark' on purpose. The only way to influence an 'MMark' document you--- obtain as a result of parsing is via the extension mechanism.-data MMark = MMark-  { -- | Parsed YAML document at the beginning (optional)-    mmarkYaml :: Maybe Value,-    -- | Actual contents of the document-    mmarkBlocks :: [Bni],-    -- | Extension specifying how to process and render the blocks-    mmarkExtension :: Extension-  }--instance NFData MMark where-  rnf MMark {..} = rnf mmarkYaml `seq` rnf mmarkBlocks---- | Dummy instance.------ @since 0.0.5.0-instance Show MMark where-  show = const "MMark {..}"---- | An extension. You can apply extensions with 'Text.MMark.useExtension'--- and 'Text.MMark.useExtensions' functions. The "Text.MMark.Extension"--- module provides tools for writing your own extensions.------ Note that 'Extension' is an instance of 'Semigroup' and 'Monoid', i.e.--- you can combine several extensions into one. Since the @('<>')@ operator--- is right-associative and 'mconcat' is a right fold under the hood, the--- expression------ > l <> r------ means that the extension @r@ will be applied before the extension @l@,--- similar to how 'Endo' works. This may seem counter-intuitive, but only--- with this logic we get consistency of ordering with more complex--- expressions:------ > e2 <> e1 <> e0 == e2 <> (e1 <> e0)------ Here, @e0@ will be applied first, then @e1@, then @e2@. The same applies--- to expressions involving 'mconcat'—extensions closer to beginning of the--- list passed to 'mconcat' will be applied later.-data Extension = Extension-  { -- | Block transformation-    extBlockTrans :: Endo Bni,-    -- | Block render-    extBlockRender :: Render (Block (Ois, Html ())),-    -- | Inline transformation-    extInlineTrans :: Endo Inline,-    -- | Inline render-    extInlineRender :: Render Inline-  }--instance Semigroup Extension where-  x <> y =-    Extension-      { extBlockTrans = on (<>) extBlockTrans x y,-        extBlockRender = on (<>) extBlockRender x y,-        extInlineTrans = on (<>) extInlineTrans x y,-        extInlineRender = on (<>) extInlineRender x y-      }--instance Monoid Extension where-  mempty =-    Extension-      { extBlockTrans = mempty,-        extBlockRender = mempty,-        extInlineTrans = mempty,-        extInlineRender = mempty-      }-  mappend = (<>)---- | An internal type that captures the extensible rendering process we use.--- 'Render' has a function inside which transforms a rendering function of--- the type @a -> Html ()@.-newtype Render a = Render-  {runRender :: (a -> Html ()) -> a -> Html ()}--instance Semigroup (Render a) where-  Render f <> Render g = Render (f . g)--instance Monoid (Render a) where-  mempty = Render id-  mappend = (<>)---- | A shortcut for the frequently used type @'Block' ('NonEmpty'--- 'Inline')@.-type Bni = Block (NonEmpty Inline)---- | We can think of a markdown document as a collection of--- blocks—structural elements like paragraphs, block quotations, lists,--- headings, thematic breaks, and code blocks. Some blocks (like block--- quotes and list items) contain other blocks; others (like headings and--- paragraphs) contain inline content, see 'Inline'.------ We can divide blocks into two types: container blocks, which can contain--- other blocks, and leaf blocks, which cannot.-data Block a-  = -- | Thematic break, leaf block-    ThematicBreak-  | -- | Heading (level 1), leaf block-    Heading1 a-  | -- | Heading (level 2), leaf block-    Heading2 a-  | -- | Heading (level 3), leaf block-    Heading3 a-  | -- | Heading (level 4), leaf block-    Heading4 a-  | -- | Heading (level 5), leaf block-    Heading5 a-  | -- | Heading (level 6), leaf block-    Heading6 a-  | -- | Code block, leaf block with info string and contents-    CodeBlock (Maybe Text) Text-  | -- | Naked content, without an enclosing tag-    Naked a-  | -- | Paragraph, leaf block-    Paragraph a-  | -- | Blockquote container block-    Blockquote [Block a]-  | -- | Ordered list ('Word' is the start index), container block-    OrderedList Word (NonEmpty [Block a])-  | -- | Unordered list, container block-    UnorderedList (NonEmpty [Block a])-  | -- | Table, first argument is the alignment options, then we have a-    -- 'NonEmpty' list of rows, where every row is a 'NonEmpty' list of-    -- cells, where every cell is an @a@ thing.-    ---    -- The first row is always the header row, because pipe-tables that we-    -- support cannot lack a header row.-    ---    -- @since 0.0.4.0-    Table (NonEmpty CellAlign) (NonEmpty (NonEmpty a))-  deriving (Show, Eq, Ord, Data, Typeable, Generic, Functor, Foldable)--instance NFData a => NFData (Block a)---- | Options for cell alignment in tables.------ @since 0.0.4.0-data CellAlign-  = -- | No specific alignment specified-    CellAlignDefault-  | -- | Left-alignment-    CellAlignLeft-  | -- | Right-alignment-    CellAlignRight-  | -- | Center-alignment-    CellAlignCenter-  deriving (Show, Eq, Ord, Data, Typeable, Generic)--instance NFData CellAlign---- | Inline markdown content.-data Inline-  = -- | Plain text-    Plain Text-  | -- | Line break (hard)-    LineBreak-  | -- | Emphasis-    Emphasis (NonEmpty Inline)-  | -- | Strong emphasis-    Strong (NonEmpty Inline)-  | -- | Strikeout-    Strikeout (NonEmpty Inline)-  | -- | Subscript-    Subscript (NonEmpty Inline)-  | -- | Superscript-    Superscript (NonEmpty Inline)-  | -- | Code span-    CodeSpan Text-  | -- | Link with text, destination, and optionally title-    Link (NonEmpty Inline) URI (Maybe Text)-  | -- | Image with description, URL, and optionally title-    Image (NonEmpty Inline) URI (Maybe Text)-  deriving (Show, Eq, Ord, Data, Typeable, Generic)--instance NFData Inline---- | 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--- only inspect it with 'getOis'.-newtype Ois = Ois (NonEmpty Inline)---- | Make an 'Ois' value. This is an internal constructor that should not be--- exposed!-mkOisInternal :: NonEmpty Inline -> Ois-mkOisInternal = Ois---- | Project @'NonEmpty' 'Inline'@ from 'Ois'.-getOis :: Ois -> NonEmpty Inline-getOis (Ois inlines) = inlines

@@ -10,7 +10,9 @@ -- Stability   :  experimental -- Portability :  portable ----- Internal utilities.+-- Misc utilities.+--+-- @since 0.0.8.0 module Text.MMark.Util   ( asPlainText,     headerId,@@ -21,13 +23,15 @@ import Data.Char (isAlphaNum, isSpace) import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text)-import qualified Data.Text as T-import Text.MMark.Type+import Data.Text qualified as T+import Text.MMark.Internal.Type import Text.URI (URI (..))-import qualified Text.URI as URI+import Text.URI qualified as URI  -- | Convert a non-empty collection of 'Inline's into their plain text -- representation. This is used e.g. to render image descriptions.+--+-- @since 0.0.8.0 asPlainText :: NonEmpty Inline -> Text asPlainText = foldMap $ \case   Plain txt -> txt@@ -46,6 +50,8 @@ -- extensions. -- -- See also: 'headerFragment'.+--+-- @since 0.0.8.0 headerId :: NonEmpty Inline -> Text headerId =   T.intercalate "-"@@ -56,6 +62,8 @@  -- | Generate a 'URI' containing only a fragment from its textual -- representation. Useful for getting URL from id of a header.+--+-- @since 0.0.8.0 headerFragment :: Text -> URI headerFragment fragment =   URI

@@ -1,7 +1,7 @@ module Main (main) where -import qualified Data.Text.IO as T-import qualified Text.MMark as MMark+import Data.Text.IO qualified as T+import Text.MMark qualified as MMark import Weigh  main :: IO ()

@@ -1,8 +1,8 @@ module Main (main) where  import Criterion.Main-import qualified Data.Text.IO as T-import qualified Text.MMark as MMark+import Data.Text.IO qualified as T+import Text.MMark qualified as MMark  main :: IO () main =

@@ -1,11 +1,11 @@ cabal-version:   2.4 name:            mmark-version:         0.0.7.6+version:         0.0.8.0 license:         BSD-3-Clause license-file:    LICENSE.md maintainer:      Mark Karpov <markkarpov92@gmail.com> author:          Mark Karpov <markkarpov92@gmail.com>-tested-with:     ghc ==8.10.7 ghc ==9.0.2 ghc ==9.2.1+tested-with:     ghc ==9.4.7 ghc ==9.6.3 ghc ==9.8.1 homepage:        https://github.com/mmark-md/mmark bug-reports:     https://github.com/mmark-md/mmark/issues synopsis:        Strict markdown processor for writers@@ -33,36 +33,36 @@     exposed-modules:         Text.MMark         Text.MMark.Extension+        Text.MMark.Internal.Type+        Text.MMark.Render+        Text.MMark.Trans+        Text.MMark.Util      other-modules:         Text.MMark.Parser         Text.MMark.Parser.Internal         Text.MMark.Parser.Internal.Type-        Text.MMark.Render-        Text.MMark.Trans-        Text.MMark.Type-        Text.MMark.Util -    default-language: Haskell2010+    default-language: GHC2021     build-depends:         aeson >=0.11 && <3,-        base >=4.13 && <5.0,+        base >=4.15 && <5,         case-insensitive >=1.2 && <1.3,         containers >=0.5 && <0.7,-        deepseq >=1.3 && <1.5,-        dlist >=0.8 && <2.0,+        deepseq >=1.3 && <1.6,+        dlist >=0.8 && <2,         email-validate >=2.2 && <2.4,         foldl >=1.2 && <1.5,-        hashable >=1 && <1.5,+        hashable >=1 && <1.6,         html-entity-map >=0.1 && <0.2,-        lucid >=2.9.13 && <3.0,-        megaparsec >=8.0 && <10.0,+        lucid >=2.9.13 && <3,+        megaparsec >=8 && <10,         microlens >=0.4 && <0.5,         microlens-th >=0.4 && <0.5,         modern-uri >=0.3.4.4 && <0.4,-        mtl >=2.0 && <3.0,-        parser-combinators >=0.4 && <2.0,-        text >=0.2 && <2.1,+        mtl >=2 && <3,+        parser-combinators >=0.4 && <2,+        text >=0.2 && <2.2,         text-metrics >=0.3 && <0.4,         unordered-containers >=0.2.5 && <0.3 @@ -70,16 +70,13 @@         build-depends: yaml >=0.11.5 && <0.12      if flag(dev)-        ghc-options: -O0 -Wall -Werror+        ghc-options:+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages      else         ghc-options: -O2 -Wall -    if flag(dev)-        ghc-options:-            -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns-            -Wnoncanonical-monad-instances-     if impl(ghcjs >=0)         ghcjs-options: +RTS -K1G -RTS -Wall @@ -92,22 +89,24 @@         Text.MMark.ExtensionSpec         Text.MMark.TestUtils -    default-language: Haskell2010+    default-language: GHC2021     build-depends:-        QuickCheck >=2.4 && <3.0,+        QuickCheck >=2.4 && <3,         aeson >=0.11 && <3,-        base >=4.13 && <5.0,+        base >=4.15 && <5,         foldl >=1.2 && <1.5,-        hspec >=2.0 && <3.0,-        hspec-megaparsec >=2.0 && <3.0,-        lucid >=2.9.13 && <3.0,-        megaparsec >=8.0 && <10.0,+        hspec >=2 && <3,+        hspec-megaparsec >=2 && <3,+        lucid >=2.9.13 && <3,+        megaparsec >=8 && <10,         mmark,         modern-uri >=0.3.4.4 && <0.4,-        text >=0.2 && <2.1+        text >=0.2 && <2.2      if flag(dev)-        ghc-options: -O0 -Wall -Werror+        ghc-options:+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages      else         ghc-options: -O2 -Wall@@ -119,15 +118,17 @@     type:             exitcode-stdio-1.0     main-is:          Main.hs     hs-source-dirs:   bench/speed-    default-language: Haskell2010+    default-language: GHC2021     build-depends:-        base >=4.13 && <5.0,-        criterion >=0.6.2.1 && <1.6,+        base >=4.15 && <5,+        criterion >=0.6.2.1 && <1.7,         mmark,-        text >=0.2 && <2.1+        text >=0.2 && <2.2      if flag(dev)-        ghc-options: -O2 -Wall -Werror+        ghc-options:+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages      else         ghc-options: -O2 -Wall@@ -139,15 +140,17 @@     type:             exitcode-stdio-1.0     main-is:          Main.hs     hs-source-dirs:   bench/memory-    default-language: Haskell2010+    default-language: GHC2021     build-depends:-        base >=4.13 && <5.0,+        base >=4.15 && <5,         mmark,-        text >=0.2 && <2.1,+        text >=0.2 && <2.2,         weigh >=0.0.4      if flag(dev)-        ghc-options: -O2 -Wall -Werror+        ghc-options:+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages      else         ghc-options: -O2 -Wall

@@ -6,15 +6,15 @@  import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text)-import qualified Data.Text as T-import qualified Lucid as L+import Data.Text qualified as T+import Lucid qualified as L import Test.Hspec import Test.QuickCheck-import qualified Text.MMark as MMark+import Text.MMark qualified as MMark import Text.MMark.Extension (Block (..), Inline (..))-import qualified Text.MMark.Extension as Ext+import Text.MMark.Extension qualified as Ext import Text.MMark.TestUtils-import qualified Text.URI as URI+import Text.URI qualified as URI  spec :: Spec spec = parallel $ do

@@ -15,13 +15,13 @@ where  import Control.Monad-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Text (Text)-import qualified Data.Text.Lazy as TL-import qualified Lucid as L+import Data.Text.Lazy qualified as TL+import Lucid qualified as L import Test.Hspec import Text.MMark (MMark, MMarkErr)-import qualified Text.MMark as MMark+import Text.MMark qualified as MMark import Text.Megaparsec  ----------------------------------------------------------------------------

@@ -3,24 +3,24 @@  module Text.MMarkSpec (spec) where -import qualified Control.Foldl as L+import Control.Foldl qualified as L import Data.Aeson import Data.Char import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Monoid import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.IO as TIO+import Data.Text qualified as T+import Data.Text.IO qualified as TIO import Lucid import Test.Hspec import Test.Hspec.Megaparsec import Text.MMark (MMarkErr (..))-import qualified Text.MMark as MMark+import Text.MMark qualified as MMark import Text.MMark.Extension (Inline (..))-import qualified Text.MMark.Extension as Ext+import Text.MMark.Extension qualified as Ext import Text.MMark.TestUtils-import Text.Megaparsec (ErrorFancy (..), Stream)+import Text.Megaparsec (ErrorFancy (..))  -- NOTE This test suite is mostly based on (sometimes altered) examples from -- the Common Mark specification. We use the version 0.28 (2017-08-01),@@ -1346,7 +1346,11 @@          in s               ~-> err                 7-                ( utok '\\' <> etoks "//" <> etok '#' <> etok '/' <> etok '<'+                ( utok '\\'+                    <> etoks "//"+                    <> etok '#'+                    <> etok '/'+                    <> etok '<'                     <> etok '?'                     <> elabel "ASCII alpha character"                     <> euri@@ -1379,7 +1383,11 @@          in s               ~-> err                 7-                ( utok '"' <> etoks "//" <> etok '#' <> etok '/' <> etok '<'+                ( utok '"'+                    <> etoks "//"+                    <> etok '#'+                    <> etok '/'+                    <> etok '<'                     <> etok '?'                     <> elabel "ASCII alpha character"                     <> euri@@ -1521,7 +1529,10 @@          in s               ~~-> [ err                        9-                       ( utok '[' <> etoks "&#" <> etok '&' <> etok ']'+                       ( utok '['+                           <> etoks "&#"+                           <> etok '&'+                           <> etok ']'                            <> elabel "escaped character"                        ),                      err 17 (utok '[' <> etok ']' <> eic)@@ -1531,7 +1542,10 @@          in s               ~~-> [ err                        9-                       ( utok '[' <> etoks "&#" <> etok '&' <> etok ']'+                       ( utok '['+                           <> etoks "&#"+                           <> etok '&'+                           <> etok ']'                            <> elabel "escaped character"                        ),                      err 21 (utok '[' <> etok ']' <> eic)@@ -1864,7 +1878,10 @@          in s               ~-> err                 23-                ( utoks "so" <> etok '\'' <> etok '\"' <> etok '('+                ( utoks "so"+                    <> etok '\''+                    <> etok '\"'+                    <> etok '('                     <> elabel "white space"                     <> elabel "newline"                 )@@ -2111,27 +2128,27 @@ -- Helpers  -- | Unexpected end of inline block.-ueib :: Stream s => ET s+ueib :: ET s ueib = ulabel "end of inline block"  -- | Expecting end of inline block.-eeib :: Stream s => ET s+eeib :: ET s eeib = elabel "end of inline block"  -- | Expecting end of URI.-euri :: Stream s => ET s+euri :: ET s euri = elabel "end of URI"  -- | Expecting inline content.-eic :: Stream s => ET s+eic :: ET s eic = elabel "inline content"  -- | Expecting white space.-ews :: Stream s => ET s+ews :: ET s ews = elabel "white space"  -- | Expecting code span content.-ecsc :: Stream s => ET s+ecsc :: ET s ecsc = elabel "code span content"  -- | Expecting common URI components.