Copyright | © 2017–present Mark Karpov |
---|---|
License | BSD 3 clause |
Maintainer | Mark Karpov <markkarpov92@gmail.com> |
Stability | experimental |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
MMark (read “em-mark”) is a strict markdown processor for writers. “Strict” means that not every input is considered valid markdown document and parse errors are possible and even desirable, because they allow us to spot markup issues without searching for them in rendered document. If a markdown document passes MMark parser, then it'll likely produce HTML without quirks. This feature makes it a good choice for writers and bloggers.
MMark and Common Mark
MMark mostly tries to follow the Common Mark specification as given here:
https://spec.commonmark.org/0.28/
However, due to the fact that we do not allow inputs that do not make
sense, and also try to guard against common mistakes (like writing ##My
header
and having it rendered as a paragraph starting with hashes) MMark
obviously can't follow the specification precisely. In particular,
parsing of inlines differs considerably from Common Mark.
Another difference between Common Mark and MMark is that the latter supports more (pun alert) common markdown extensions out-of-the-box. In particular, MMark supports:
- parsing of an optional YAML block
- strikeout using
~~this~~
syntax - superscript using
^this^
syntax - subscript using
~this~
syntax - automatic assignment of ids to headers
- pipe tables (as on GitHub)
One does not need to enable or tweak anything for these to work, they are built-in features.
The readme contains a more detailed description of differences between Common Mark and MMark.
How to use the library
The module is intended to be imported qualified:
import Text.MMark (MMark) import qualified Text.MMark as MMark
Working with MMark happens in three stages:
- Parsing of markdown document.
- Applying extensions, which optionally may require scanning of previously parsed document (for example to build a table of contents).
- Rendering of HTML document.
The structure of the documentation below corresponds to these stages and should clarify the details.
“Getting started” example
Here is a complete example of a program that reads a markdown file named
"input.md"
and outputs an HTML file named "output.html"
:
{-# LANGUAGE OverloadedStrings #-} module Main (main) where import qualified Data.Text.IO as T import qualified Data.Text.Lazy.IO as TL import qualified Lucid as L import qualified Text.MMark as MMark import qualified Text.Megaparsec as M main :: IO () main = do let input = "input.md" txt <- T.readFile input -- (1) case MMark.parse input txt of -- (2) Left bundle -> putStrLn (M.errorBundlePretty bundle) -- (3) Right r -> TL.writeFile "output.html" -- (6) . L.renderText -- (5) . MMark.render -- (4) $ r
Let's break it down:
- We read a source markdown file as strict
Text
. - The source is fed into the
parse
function which does the parsing. It can either fail with a collection of parse errors or succeed returning a value of the opaqueMMark
type. - If parsing fails, we pretty-print the parse errors with
errorBundlePretty
. - Then we just render the document with
render
first to Lucid's
.Html
() - …and then to lazy
Text
withrenderText
. - Finally we write the result as
"output.html"
.
Other modules of interest
The Text.MMark module contains all the “core” functionality one may need. However, one of the main selling points of MMark is that it's possible to write your own extensions which stay highly composable (if done right), so proliferation of third-party extensions is to be expected and encouraged. To write an extension of your own import the Text.MMark.Extension module, which has some documentation focusing on extension writing.
Synopsis
- data MMark
- data MMarkErr
- parse :: FilePath -> Text -> Either (ParseErrorBundle Text MMarkErr) MMark
- data Extension
- useExtension :: Extension -> MMark -> MMark
- useExtensions :: [Extension] -> MMark -> MMark
- runScanner :: MMark -> Fold Bni a -> a
- runScannerM :: Monad m => MMark -> FoldM m Bni a -> m a
- projectYaml :: MMark -> Maybe Value
- render :: MMark -> Html ()
Parsing
MMark custom parse errors.
YamlParseError String | YAML error that occurred during parsing of a YAML block |
NonFlankingDelimiterRun (NonEmpty Char) | This delimiter run should be in left- or right- flanking position |
ListStartIndexTooBig Word | Ordered list start numbers must be nine digits or less Since: 0.0.2.0 |
ListIndexOutOfOrder Word Word | The index in an ordered list is out of order, first number is the actual index we ran into, the second number is the expected index Since: 0.0.2.0 |
DuplicateReferenceDefinition Text | Duplicate reference definitions are not allowed Since: 0.0.3.0 |
CouldNotFindReferenceDefinition Text [Text] | Could not find this reference definition, the second argument is the collection of close names (typo corrections) Since: 0.0.3.0 |
InvalidNumericCharacter Int | This numeric character is invalid Since: 0.0.3.0 |
UnknownHtmlEntityName Text | Unknown HTML5 entity name Since: 0.0.3.0 |
Instances
Extensions
An extension. You can apply extensions with useExtension
and 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.
useExtensions :: [Extension] -> MMark -> MMark Source #
Apply several Extension
s to an MMark
document.
This is a simple shortcut:
useExtensions exts = useExtension (mconcat exts)
As mentioned in the docs for useExtension
, the order in which you apply
extensions matters. Extensions closer to beginning of the list are
applied later, i.e. the last extension in the list is applied first.
Scanning
Scan an MMark
document efficiently in one pass. This uses the
excellent Fold
type, which see.
Take a look at the Text.MMark.Extension module if you want to create scanners of your own.
Like runScanner
, but allows to run scanners with monadic context.
To bring Fold
and FoldM
types to the “least common denominator”
use generalize
and simplify
.
Since: 0.0.2.0
projectYaml :: MMark -> Maybe Value Source #
Extract contents of an optional YAML block that may have been parsed.
Rendering
render :: MMark -> Html () Source #
Render a MMark
markdown document. You can then render
to
various things:Html
()
- to lazy
Text
withrenderText
- to lazy
ByteString
withrenderBS
- directly to file with
renderToFile