packages feed

commonmark-extensions (empty) → 0.1.0.0

raw patch · 42 files changed

+4645/−0 lines, 42 filesdep +QuickCheckdep +basedep +bytestring

Dependencies added: QuickCheck, base, bytestring, commonmark, commonmark-extensions, containers, criterion, emojis, parsec, semigroups, tasty, tasty-hunit, tasty-quickcheck, text, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,47 @@+# commonmark-extensions++This package provides some syntax extensions for the+commonmark package:++- [`hard_line_breaks`] (treat new lines as hard breaks)+- [`smart`] (smart quotes, dashes, and ellipses)+- [`strikethrough`] (strikethrough)+- [`superscript`] (superscript)+- [`subscript`] (subscript)+- [`math`] (LaTeX math)+- [`emoji`] (emoji)+- [`autolinks`] (autolink bare URLs and email addresses)+- [`pipe_tables`] (pipe tables)+- [`footnotes`] (footnotes)+- [`definition_lists`] (definition lists)+- [`fancy_lists`] (fancy ordered list markers (parentheses, alpha, roman)+- [`task_lists`] (task lists)+- [`attributes`] (attributes for all inline and block elements)+- [`raw_attribute`] (special raw block and inline elements in any format)+- [`bracketed_spans`] (spans of inline elements with attributes)+- [`fenced_divs`] (groups of block elements with attributes)+- [`auto_identifiers`] (automatic generation of identifiers for headings)+- [`auto_identifiers_ascii`] (automatic generation of ASCII identifiers for headings)+- [`implicit_heading_references`] (headings implicitly define link references)++[`pipe_tables`]: test/pipe_tables.md+[`hard_line_breaks`]: test/hard_line_breaks.md+[`smart`]: test/smart.md+[`strikethrough`]: test/strikethrough.md+[`superscript`]: test/superscript.md+[`subscript`]: test/subscript.md+[`math`]: test/math.md+[`emoji`]: test/emoji.md+[`autolinks`]: test/autolinks.md+[`footnotes`]: test/footnotes.md+[`definition_lists`]: test/definition_lists.md+[`fancy_lists`]: test/fancy_lists.md+[`task_lists`]: test/task_lists.md+[`attributes`]: test/attributes.md+[`raw_attribute`]: test/raw_attribute.md+[`bracketed_spans`]: test/bracketed_spans.md+[`fenced_divs`]: test/fenced_divs.md+[`auto_identifiers`]: test/auto_identifiers.md+[`auto_identifiers_ascii`]: test/auto_identifiers_ascii.md+[`implicit_heading_references`]: test/implicit_heading_references.md+
+ benchmark/benchmark.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+import Criterion.Main+import Data.Text (Text)+import Data.Functor.Identity  -- base >= 4.8+import Commonmark+import Commonmark.Extensions+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid+#endif++main :: IO ()+main = do+  sample <- T.replicate 10 <$> TIO.readFile "benchmark/sample.md"+  defaultMainWith defaultConfig+    [ benchCommonmark (smartPunctuationSpec <> defaultSyntaxSpec)+        ("commonmark +smart", sample)+    , benchCommonmark (autolinkSpec <> defaultSyntaxSpec)+        ("commonmark +autolink", sample)+    , benchCommonmark (attributesSpec <> defaultSyntaxSpec)+        ("commonmark +attributes", sample)+    , benchCommonmark (defaultSyntaxSpec <> pipeTableSpec)+        ("commonmark +pipe_table", sample)+    ]++benchCommonmark :: SyntaxSpec Identity (Html ()) (Html ())+                -> (String, Text)+                -> Benchmark+benchCommonmark spec (name, contents) =+  bench name $+    nf (either (error . show) renderHtml+        . runIdentity . parseCommonmarkWith spec . tokenize name)+    contents+
+ changelog.md view
@@ -0,0 +1,3 @@+# Changelog for commonmark-extensions++## Unreleased changes
+ commonmark-extensions.cabal view
@@ -0,0 +1,117 @@+name:           commonmark-extensions+version:        0.1.0.0+synopsis:       Pure Haskell commonmark parser.+description:+   This library provides some useful extensions to core commonmark+   syntax: smart quotes, definition lists, tables, footnotes, math,+   and more.++category:       Text+homepage:       https://github.com/jgm/commonmark-hs+bug-reports:    https://github.com/jgm/commonmark-hs/issues+author:         John MacFarlane+maintainer:     jgm@berkeley.edu+copyright:      2018-2020 John MacFarlane+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    changelog.md+    README.md+    test/definition_lists.md+    test/fancy_lists.md+    test/autolinks.md+    test/auto_identifiers.md+    test/auto_identifiers_ascii.md+    test/implicit_heading_references.md+    test/pipe_tables.md+    test/attributes.md+    test/raw_attribute.md+    test/fenced_divs.md+    test/bracketed_spans.md+    test/footnotes.md+    test/math.md+    test/emoji.md+    test/smart.md+    test/strikethrough.md+    test/superscript.md+    test/subscript.md+    test/hard_line_breaks.md++source-repository head+  type: git+  location: https://github.com/jgm/commonmark-hs++library+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , text+    , bytestring+    , containers+    , transformers+    , parsec+    , commonmark >= 0.1 && < 0.2+    -- for extensions:+    , emojis >= 0.1 && < 0.2+  if !impl(ghc >= 8.0)+    build-depends: semigroups == 0.18.*+  exposed-modules:+      Commonmark.Extensions+      Commonmark.Extensions.Smart+      Commonmark.Extensions.HardLineBreaks+      Commonmark.Extensions.Strikethrough+      Commonmark.Extensions.Superscript+      Commonmark.Extensions.Subscript+      Commonmark.Extensions.PipeTable+      Commonmark.Extensions.Math+      Commonmark.Extensions.Emoji+      Commonmark.Extensions.Autolink+      Commonmark.Extensions.Footnote+      Commonmark.Extensions.DefinitionList+      Commonmark.Extensions.Attributes+      Commonmark.Extensions.AutoIdentifiers+      Commonmark.Extensions.FancyList+      Commonmark.Extensions.TaskList+      Commonmark.Extensions.ImplicitHeadingReferences+  ghc-options: -Wall -fno-warn-unused-do-bind -funbox-small-strict-fields+  if impl(ghc >= 8.8)+    ghc-options:  -fwrite-ide-info -hiedir=.hie+  default-language: Haskell2010++test-suite test-commonmark-extensions+  type: exitcode-stdio-1.0+  main-is: test-commonmark-extensions.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-K40K+  build-depends:+      base >=4.7 && <5+    , commonmark+    , commonmark-extensions+    , text+    , tasty+    , tasty-quickcheck+    , tasty-hunit+    , QuickCheck+    , parsec+  default-language: Haskell2010++benchmark benchmark-commonmark-extensions+  type:            exitcode-stdio-1.0+  main-is:         benchmark.hs+  hs-source-dirs:  benchmark+  build-depends:+       commonmark >= 0.1 && < 0.2+     , commonmark-extensions+     , base >= 4.8 && < 5+     , text+     , transformers+     , containers+     , bytestring+     , criterion >= 1.0 && < 1.6+  ghc-options: -threaded -rtsopts -with-rtsopts=-K10K+  default-language: Haskell2010
+ src/Commonmark/Extensions.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE CPP #-}+{- |++Syntax extensions for the commonmark library.+Usage example:++> {-# LANGUAGE ScopedTypeVariables #-}+> import Commonmark+> import Commonmark.Extensions+> import Data.Text.IO as TIO+> import Data.Text.Lazy.IO as TLIO+>+> main :: IO ()+> main = do+>   let customSyntax =+>          (mathSpec <> smartPunctuationSpec <> defaultSyntaxSpec)+>   inp <- TIO.getContents+>   res <- commonmarkWith customSyntax "stdin" inp+>   case res of+>     Left e                  -> error (show e)+>     Right (html :: Html ()) -> TLIO.putStr $ renderHtml html++-}++module Commonmark.Extensions+    ( module Commonmark.Extensions.Smart+    , module Commonmark.Extensions.HardLineBreaks+    , module Commonmark.Extensions.Strikethrough+    , module Commonmark.Extensions.Superscript+    , module Commonmark.Extensions.Subscript+    , module Commonmark.Extensions.PipeTable+    , module Commonmark.Extensions.Math+    , module Commonmark.Extensions.Emoji+    , module Commonmark.Extensions.Autolink+    , module Commonmark.Extensions.Footnote+    , module Commonmark.Extensions.DefinitionList+    , module Commonmark.Extensions.Attributes+    , module Commonmark.Extensions.AutoIdentifiers+    , module Commonmark.Extensions.FancyList+    , module Commonmark.Extensions.TaskList+    , module Commonmark.Extensions.ImplicitHeadingReferences+    , gfmExtensions+    ) where++import           Commonmark.Extensions.Smart+import           Commonmark.Extensions.HardLineBreaks+import           Commonmark.Extensions.Strikethrough+import           Commonmark.Extensions.Superscript+import           Commonmark.Extensions.Subscript+import           Commonmark.Extensions.PipeTable+import           Commonmark.Extensions.Math+import           Commonmark.Extensions.Emoji+import           Commonmark.Extensions.Autolink+import           Commonmark.Extensions.Footnote+import           Commonmark.Extensions.DefinitionList+import           Commonmark.Extensions.Attributes+import           Commonmark.Extensions.AutoIdentifiers+import           Commonmark.Extensions.FancyList+import           Commonmark.Extensions.TaskList+import           Commonmark.Extensions.ImplicitHeadingReferences+import           Commonmark+import           Data.Typeable+#if !MIN_VERSION_base(4,11,0)+import           Data.Monoid ((<>))+#endif++-- | Standard extensions for GitHub-flavored Markdown.+gfmExtensions :: (Monad m, Typeable m, IsBlock il bl, IsInline il,+                  Typeable il, Typeable bl, HasEmoji il,+                  HasStrikethrough il, HasPipeTable il bl,+                  HasTaskList il bl, ToPlainText il)+              => SyntaxSpec m il bl+gfmExtensions =+  emojiSpec <> strikethroughSpec <> pipeTableSpec <> autolinkSpec <>+    autoIdentifiersSpec <> taskListSpec+
+ src/Commonmark/Extensions/Attributes.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE LambdaCase #-}+module Commonmark.Extensions.Attributes+  ( attributesSpec+  , HasDiv(..)+  , fencedDivSpec+  , HasSpan(..)+  , bracketedSpanSpec+  , rawAttributeSpec+  , pAttributes+  )+where+import Commonmark.Types+import Commonmark.Tag (htmlAttributeName, htmlDoubleQuotedAttributeValue)+import Commonmark.Tokens+import Commonmark.Syntax+import Commonmark.Inlines+import Commonmark.TokParsers+import Commonmark.SourceMap+import Commonmark.Blocks+import Commonmark.Entity (unEntity)+import Commonmark.Html+import Data.Dynamic+import Data.Tree+import Control.Monad (mzero, guard, void)+import Text.Parsec+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif++class HasDiv bl where+  div_ :: bl -> bl++instance HasDiv (Html a) where+  div_ bs = htmlBlock "div" $ Just (htmlRaw "\n" <> bs)++instance (HasDiv bl, Semigroup bl)+        => HasDiv (WithSourceMap bl) where+  div_ bs = (div_ <$> bs) <* addName "div"++fencedDivSpec+             :: (Monad m, IsInline il, IsBlock il bl, HasDiv bl)+             => SyntaxSpec m il bl+fencedDivSpec = mempty+  { syntaxBlockSpecs = [fencedDivBlockSpec] }++fencedDivBlockSpec :: (Monad m, IsBlock il bl, HasDiv bl)+                   => BlockSpec m il bl+fencedDivBlockSpec = BlockSpec+     { blockType           = "FencedDiv"+     , blockStart          = try $ do+             prepos <- getPosition+             nonindentSpaces+             pos <- getPosition+             let indentspaces = sourceColumn pos - sourceColumn prepos+             colons <- many1 (symbol ':')+             let fencelength = length colons+             guard $ fencelength >= 3+             skipWhile (hasType Spaces)+             attrs <- pAttributes+             skipWhile (hasType Spaces)+             lookAhead $ void lineEnd <|> eof+             addNodeToStack $+                Node (defBlockData fencedDivBlockSpec){+                          blockData = toDyn+                               (fencelength, indentspaces, attrs),+                          blockStartPos = [pos] } []+             return BlockStartMatch+     , blockCanContain     = const True+     , blockContainsLines  = False+     , blockParagraph      = False+     , blockContinue       = \node -> try (do+             nonindentSpaces+             pos <- getPosition+             ts <- many1 (symbol ':')+             let closelength = length ts+             skipWhile (hasType Spaces)+             lookAhead $ void lineEnd <|> eof+             let fencelength = getFenceLength node+             guard $ closelength >= fencelength+             -- ensure that there aren't subordinate open fenced divs+             -- with fencelength <= closelength:+             ns <- nodeStack <$> getState+             guard $ not $ any+               (\n ->+                 (blockType (blockSpec (rootLabel n))) == "FencedDiv" &&+                 (getFenceLength n) <= closelength) $+               takeWhile (\n -> not+                    (blockType (blockSpec (rootLabel n)) == "FencedDiv" &&+                     blockStartPos (rootLabel n) ==+                     blockStartPos (rootLabel node)))+               ns+             endOfBlock+             return $! (pos, node))+               <|> (do let ((_, indentspaces, _)+                              :: (Int, Int, Attributes)) = fromDyn+                                   (blockData (rootLabel node))+                                   (3, 0, mempty)+                       pos <- getPosition+                       _ <- gobbleUpToSpaces indentspaces+                       return $! (pos, node))+     , blockConstructor    = \node -> do+           let ((_, _, attrs) :: (Int, Int, Attributes)) =+                   fromDyn (blockData (rootLabel node)) (3, 0, mempty)+           (addAttributes attrs . div_ . mconcat)+             <$> renderChildren node+     , blockFinalize       = defaultFinalizer+     }++getFenceLength :: (Monad m, IsBlock il bl, HasDiv bl)+               => BlockNode m il bl -> Int+getFenceLength node =+  let ((fencelength, _, _)+         :: (Int, Int, Attributes)) = fromDyn+                        (blockData (rootLabel node))+                        (3, 0, mempty)+  in fencelength++bracketedSpanSpec+             :: (Monad m, IsInline il, HasSpan il)+             => SyntaxSpec m il bl+bracketedSpanSpec = mempty+  { syntaxBracketedSpecs = [ bsSpec ]+  }+  where+   bsSpec = BracketedSpec+            { bracketedName = "Span"+            , bracketedNests = True+            , bracketedPrefix = Nothing+            , bracketedSuffixEnd = Nothing+            , bracketedSuffix = pSpanSuffix+            }+   pSpanSuffix _rm _key = do+     attrs <- pAttributes+     return $! spanWith attrs++class IsInline a => HasSpan a where+  spanWith :: Attributes -> a -> a++instance Rangeable (Html a) => HasSpan (Html a) where+  spanWith attrs ils = addAttributes attrs $ htmlInline "span" (Just ils)++instance (HasSpan i, Semigroup i, Monoid i)+        => HasSpan (WithSourceMap i) where+  spanWith attrs x = (spanWith attrs <$> x) <* addName "span"++pRawSpan :: (IsInline a, Monad m) => InlineParser m a+pRawSpan = try $ do+  tok <- symbol '`'+  pBacktickSpan tok >>=+   \case+    Left ticks     -> return $! str (untokenize ticks)+    Right codetoks -> do+      let raw = untokenize codetoks+      (do f <- pRawAttribute+          return $! rawInline f raw)+       <|> (return $! code . normalizeCodeSpan $ raw)++rawAttributeSpec :: (Monad m, IsBlock il bl)+                         => SyntaxSpec m il bl+rawAttributeSpec = mempty+  { syntaxBlockSpecs = [ rawAttributeBlockSpec ]+  , syntaxInlineParsers = [ pRawSpan ]+  }++rawAttributeBlockSpec :: (Monad m, IsBlock il bl)+                              => BlockSpec m il bl+rawAttributeBlockSpec = BlockSpec+     { blockType           = "RawBlock"+     , blockStart          = try $ do+             prepos <- getPosition+             nonindentSpaces+             pos <- getPosition+             let indentspaces = sourceColumn pos - sourceColumn prepos+             (c, ticks) <-  (('`',) <$> many1 (symbol '`'))+                        <|> (('~',) <$> many1 (symbol '~'))+             let fencelength = length ticks+             guard $ fencelength >= 3+             skipWhile (hasType Spaces)+             fmt <- pRawAttribute+             skipWhile (hasType Spaces)+             lookAhead $ void lineEnd <|> eof+             addNodeToStack $+                Node (defBlockData rawAttributeBlockSpec){+                          blockData = toDyn+                               (c, fencelength, indentspaces, fmt),+                          blockStartPos = [pos] } []+             return BlockStartMatch+     , blockCanContain     = const False+     , blockContainsLines  = True+     , blockParagraph      = False+     , blockContinue       = \node -> try (do+             let ((c, fencelength, _, _)+                    :: (Char, Int, Int, Format)) = fromDyn+                                   (blockData (rootLabel node))+                                   ('`', 3, 0, Format mempty)+             nonindentSpaces+             pos <- getPosition+             ts <- many1 (symbol c)+             guard $ length ts >= fencelength+             skipWhile (hasType Spaces)+             lookAhead $ void lineEnd <|> eof+             endOfBlock+             return $! (pos, node))+               <|> (do let ((_, _, indentspaces, _)+                              :: (Char, Int, Int, Format)) = fromDyn+                                   (blockData (rootLabel node))+                                   ('`', 3, 0, Format mempty)+                       pos <- getPosition+                       _ <- gobbleUpToSpaces indentspaces+                       return $! (pos, node))+     , blockConstructor    = \node -> do+           let ((_, _, _, fmt) :: (Char, Int, Int, Format)) =+                   fromDyn (blockData (rootLabel node))+                     ('`', 3, 0, Format mempty)+           let codetext = untokenize $ drop 1 (getBlockText node)+           -- drop 1 initial lineend token+           return $! rawBlock fmt codetext+     , blockFinalize       = defaultFinalizer+     }++-- | Allow attributes on everything.+attributesSpec+             :: (Monad m, IsInline il)+             => SyntaxSpec m il bl+attributesSpec = mempty+  { syntaxAttributeParsers = [pAttributes]+  }++pAttributes :: forall u m . Monad m => ParsecT [Tok] u m Attributes+pAttributes = mconcat <$> many1 pattr+  where+    pattr = try $ do+      symbol '{'+      optional whitespace+      let pAttribute = pIdentifier <|> pClass <|> pKeyValue+      a <- pAttribute+      as <- many $ try (whitespace *> (pIdentifier <|> pClass <|> pKeyValue))+      optional whitespace+      symbol '}'+      return $! (a:as)++pRawAttribute :: Monad m => ParsecT [Tok] u m Format+pRawAttribute = try $ do+  symbol '{'+  optional whitespace+  symbol '='+  Tok _ _ t <- satisfyWord (const True)+  optional whitespace+  symbol '}'+  return $! Format t++pIdentifier :: Monad m => ParsecT [Tok] u m Attribute+pIdentifier = try $ do+  symbol '#'+  xs <- many1 $+        satisfyWord (const True)+    <|> satisfyTok (\c -> hasType (Symbol '-') c || hasType (Symbol '_') c+                        || hasType (Symbol ':') c || hasType (Symbol '.') c)+  return $! ("id", unEntity xs)++pClass :: Monad m => ParsecT [Tok] u m Attribute+pClass = do+  symbol '.'+  xs <- many1 $+        satisfyWord (const True)+    <|> satisfyTok (\c -> hasType (Symbol '-') c || hasType (Symbol '_') c)+  return $! ("class", unEntity xs)++pKeyValue :: Monad m => ParsecT [Tok] u m Attribute+pKeyValue = do+  name <- htmlAttributeName+  symbol '='+  val <- htmlDoubleQuotedAttributeValue+       <|> many1 (noneOfToks [Spaces, LineEnd, Symbol '<', Symbol '>',+                      Symbol '=', Symbol '`', Symbol '\'', Symbol '"',+                      Symbol '}'])+  let val' = case val of+               Tok (Symbol '"') _ _:_:_  -> drop 1 $ init $ val+               Tok (Symbol '\'') _ _:_:_ -> mzero+               _ -> val+  return $! (untokenize name, unEntity val')
+ src/Commonmark/Extensions/AutoIdentifiers.hs view
@@ -0,0 +1,470 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Commonmark.Extensions.AutoIdentifiers+  ( autoIdentifiersSpec+  , autoIdentifiersAsciiSpec+  )+where+import Commonmark.Types+import Commonmark.Syntax+import Commonmark.Blocks+import Data.Char (isSpace, isAlphaNum, isAscii, isMark,+                  generalCategory, GeneralCategory(ConnectorPunctuation))+import Data.Dynamic+import qualified Data.Map as M+import qualified Data.Text as T+import Text.Parsec+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif++autoIdentifiersSpec :: (Monad m, IsBlock il bl, IsInline il, ToPlainText il)+                    => SyntaxSpec m il bl+autoIdentifiersSpec = mempty+  { syntaxFinalParsers = [addAutoIdentifiers False]+  }++autoIdentifiersAsciiSpec+                    :: (Monad m, IsBlock il bl, IsInline il, ToPlainText il)+                    => SyntaxSpec m il bl+autoIdentifiersAsciiSpec = mempty+  { syntaxFinalParsers = [addAutoIdentifiers True]+  }++-- Go through the node stack and add identifiers where they+-- are missing.+addAutoIdentifiers :: (Monad m, IsBlock il bl, IsInline il, ToPlainText il)+                   => Bool -> BlockParser m il bl bl+addAutoIdentifiers ascii = do+  nodes <- nodeStack <$> getState+  nodes' <- mapM (traverse $ addId ascii) nodes+  updateState $ \st -> st{ nodeStack = nodes' }+  return $! mempty++addId :: (Monad m, IsBlock il bl, IsInline il, ToPlainText il)+       => Bool -> BlockData m il bl -> BlockParser m il bl (BlockData m il bl)+addId ascii bd+  | blockType (blockSpec bd) `elem` ["ATXHeading", "SetextHeading"] =+    case lookup "id" (blockAttributes bd) of+      Nothing  -> do+        contents <- runInlineParser+                    (removeIndent . mconcat . reverse . blockLines $ bd)+        let ident = makeIdentifier ascii (toPlainText contents)+        counterMap <- counters <$> getState+        let key = "identifier:" <> ident+        cnt <- case M.lookup key counterMap of+                    Nothing -> return 0+                    Just x  -> return $! (fromDyn x (0 :: Int) + 1)+        let ident' = if cnt == 0+                        then ident+                        else ident <> "-" <> T.pack (show cnt)+        updateState $ \st ->+          st{ counters = M.insert key (toDyn cnt) counterMap }+        return $! bd{ blockAttributes = ("id",ident') : blockAttributes bd }+      Just _ -> return $! bd+  | otherwise = return $! bd++makeIdentifier :: Bool -> T.Text -> T.Text+makeIdentifier ascii = toIdent . T.toLower+  where+    toIdent = T.concatMap f+    f '-' = "-"+    f '_' = "_"+    f c | isSpace c = "-"+    f c | isAlphaNum c || isMark c ||+          generalCategory c == ConnectorPunctuation+                    = fromchar c+        | otherwise = mempty+    fromchar c+      | ascii+      , not (isAscii c) = maybe mempty T.singleton $ M.lookup c asciiMap+      | otherwise       = T.singleton c++asciiMap :: M.Map Char Char+asciiMap = M.fromList+  [('\192','A')+  ,('\193','A')+  ,('\194','A')+  ,('\195','A')+  ,('\196','A')+  ,('\197','A')+  ,('\199','C')+  ,('\200','E')+  ,('\201','E')+  ,('\202','E')+  ,('\203','E')+  ,('\204','I')+  ,('\205','I')+  ,('\206','I')+  ,('\207','I')+  ,('\209','N')+  ,('\210','O')+  ,('\211','O')+  ,('\212','O')+  ,('\213','O')+  ,('\214','O')+  ,('\217','U')+  ,('\218','U')+  ,('\219','U')+  ,('\220','U')+  ,('\221','Y')+  ,('\224','a')+  ,('\225','a')+  ,('\226','a')+  ,('\227','a')+  ,('\228','a')+  ,('\229','a')+  ,('\231','c')+  ,('\232','e')+  ,('\233','e')+  ,('\234','e')+  ,('\235','e')+  ,('\236','i')+  ,('\237','i')+  ,('\238','i')+  ,('\239','i')+  ,('\241','n')+  ,('\242','o')+  ,('\243','o')+  ,('\244','o')+  ,('\245','o')+  ,('\246','o')+  ,('\249','u')+  ,('\250','u')+  ,('\251','u')+  ,('\252','u')+  ,('\253','y')+  ,('\255','y')+  ,('\256','A')+  ,('\257','a')+  ,('\258','A')+  ,('\259','a')+  ,('\260','A')+  ,('\261','a')+  ,('\262','C')+  ,('\263','c')+  ,('\264','C')+  ,('\265','c')+  ,('\266','C')+  ,('\267','c')+  ,('\268','C')+  ,('\269','c')+  ,('\270','D')+  ,('\271','d')+  ,('\274','E')+  ,('\275','e')+  ,('\276','E')+  ,('\277','e')+  ,('\278','E')+  ,('\279','e')+  ,('\280','E')+  ,('\281','e')+  ,('\282','E')+  ,('\283','e')+  ,('\284','G')+  ,('\285','g')+  ,('\286','G')+  ,('\287','g')+  ,('\288','G')+  ,('\289','g')+  ,('\290','G')+  ,('\291','g')+  ,('\292','H')+  ,('\293','h')+  ,('\296','I')+  ,('\297','i')+  ,('\298','I')+  ,('\299','i')+  ,('\300','I')+  ,('\301','i')+  ,('\302','I')+  ,('\303','i')+  ,('\304','I')+  ,('\305','i')+  ,('\308','J')+  ,('\309','j')+  ,('\310','K')+  ,('\311','k')+  ,('\313','L')+  ,('\314','l')+  ,('\315','L')+  ,('\316','l')+  ,('\317','L')+  ,('\318','l')+  ,('\323','N')+  ,('\324','n')+  ,('\325','N')+  ,('\326','n')+  ,('\327','N')+  ,('\328','n')+  ,('\332','O')+  ,('\333','o')+  ,('\334','O')+  ,('\335','o')+  ,('\336','O')+  ,('\337','o')+  ,('\340','R')+  ,('\341','r')+  ,('\342','R')+  ,('\343','r')+  ,('\344','R')+  ,('\345','r')+  ,('\346','S')+  ,('\347','s')+  ,('\348','S')+  ,('\349','s')+  ,('\350','S')+  ,('\351','s')+  ,('\352','S')+  ,('\353','s')+  ,('\354','T')+  ,('\355','t')+  ,('\356','T')+  ,('\357','t')+  ,('\360','U')+  ,('\361','u')+  ,('\362','U')+  ,('\363','u')+  ,('\364','U')+  ,('\365','u')+  ,('\366','U')+  ,('\367','u')+  ,('\368','U')+  ,('\369','u')+  ,('\370','U')+  ,('\371','u')+  ,('\372','W')+  ,('\373','w')+  ,('\374','Y')+  ,('\375','y')+  ,('\376','Y')+  ,('\377','Z')+  ,('\378','z')+  ,('\379','Z')+  ,('\380','z')+  ,('\381','Z')+  ,('\382','z')+  ,('\416','O')+  ,('\417','o')+  ,('\431','U')+  ,('\432','u')+  ,('\461','A')+  ,('\462','a')+  ,('\463','I')+  ,('\464','i')+  ,('\465','O')+  ,('\466','o')+  ,('\467','U')+  ,('\468','u')+  ,('\486','G')+  ,('\487','g')+  ,('\488','K')+  ,('\489','k')+  ,('\490','O')+  ,('\491','o')+  ,('\496','j')+  ,('\500','G')+  ,('\501','g')+  ,('\504','N')+  ,('\505','n')+  ,('\512','A')+  ,('\513','a')+  ,('\514','A')+  ,('\515','a')+  ,('\516','E')+  ,('\517','e')+  ,('\518','E')+  ,('\519','e')+  ,('\520','I')+  ,('\521','i')+  ,('\522','I')+  ,('\523','i')+  ,('\524','O')+  ,('\525','o')+  ,('\526','O')+  ,('\527','o')+  ,('\528','R')+  ,('\529','r')+  ,('\530','R')+  ,('\531','r')+  ,('\532','U')+  ,('\533','u')+  ,('\534','U')+  ,('\535','u')+  ,('\536','S')+  ,('\537','s')+  ,('\538','T')+  ,('\539','t')+  ,('\542','H')+  ,('\543','h')+  ,('\550','A')+  ,('\551','a')+  ,('\552','E')+  ,('\553','e')+  ,('\558','O')+  ,('\559','o')+  ,('\562','Y')+  ,('\563','y')+  ,('\894',';')+  ,('\7680','A')+  ,('\7681','a')+  ,('\7682','B')+  ,('\7683','b')+  ,('\7684','B')+  ,('\7685','b')+  ,('\7686','B')+  ,('\7687','b')+  ,('\7690','D')+  ,('\7691','d')+  ,('\7692','D')+  ,('\7693','d')+  ,('\7694','D')+  ,('\7695','d')+  ,('\7696','D')+  ,('\7697','d')+  ,('\7698','D')+  ,('\7699','d')+  ,('\7704','E')+  ,('\7705','e')+  ,('\7706','E')+  ,('\7707','e')+  ,('\7710','F')+  ,('\7711','f')+  ,('\7712','G')+  ,('\7713','g')+  ,('\7714','H')+  ,('\7715','h')+  ,('\7716','H')+  ,('\7717','h')+  ,('\7718','H')+  ,('\7719','h')+  ,('\7720','H')+  ,('\7721','h')+  ,('\7722','H')+  ,('\7723','h')+  ,('\7724','I')+  ,('\7725','i')+  ,('\7728','K')+  ,('\7729','k')+  ,('\7730','K')+  ,('\7731','k')+  ,('\7732','K')+  ,('\7733','k')+  ,('\7734','L')+  ,('\7735','l')+  ,('\7738','L')+  ,('\7739','l')+  ,('\7740','L')+  ,('\7741','l')+  ,('\7742','M')+  ,('\7743','m')+  ,('\7744','M')+  ,('\7745','m')+  ,('\7746','M')+  ,('\7747','m')+  ,('\7748','N')+  ,('\7749','n')+  ,('\7750','N')+  ,('\7751','n')+  ,('\7752','N')+  ,('\7753','n')+  ,('\7754','N')+  ,('\7755','n')+  ,('\7764','P')+  ,('\7765','p')+  ,('\7766','P')+  ,('\7767','p')+  ,('\7768','R')+  ,('\7769','r')+  ,('\7770','R')+  ,('\7771','r')+  ,('\7774','R')+  ,('\7775','r')+  ,('\7776','S')+  ,('\7777','s')+  ,('\7778','S')+  ,('\7779','s')+  ,('\7786','T')+  ,('\7787','t')+  ,('\7788','T')+  ,('\7789','t')+  ,('\7790','T')+  ,('\7791','t')+  ,('\7792','T')+  ,('\7793','t')+  ,('\7794','U')+  ,('\7795','u')+  ,('\7796','U')+  ,('\7797','u')+  ,('\7798','U')+  ,('\7799','u')+  ,('\7804','V')+  ,('\7805','v')+  ,('\7806','V')+  ,('\7807','v')+  ,('\7808','W')+  ,('\7809','w')+  ,('\7810','W')+  ,('\7811','w')+  ,('\7812','W')+  ,('\7813','w')+  ,('\7814','W')+  ,('\7815','w')+  ,('\7816','W')+  ,('\7817','w')+  ,('\7818','X')+  ,('\7819','x')+  ,('\7820','X')+  ,('\7821','x')+  ,('\7822','Y')+  ,('\7823','y')+  ,('\7824','Z')+  ,('\7825','z')+  ,('\7826','Z')+  ,('\7827','z')+  ,('\7828','Z')+  ,('\7829','z')+  ,('\7830','h')+  ,('\7831','t')+  ,('\7832','w')+  ,('\7833','y')+  ,('\7840','A')+  ,('\7841','a')+  ,('\7842','A')+  ,('\7843','a')+  ,('\7864','E')+  ,('\7865','e')+  ,('\7866','E')+  ,('\7867','e')+  ,('\7868','E')+  ,('\7869','e')+  ,('\7880','I')+  ,('\7881','i')+  ,('\7882','I')+  ,('\7883','i')+  ,('\7884','O')+  ,('\7885','o')+  ,('\7886','O')+  ,('\7887','o')+  ,('\7908','U')+  ,('\7909','u')+  ,('\7910','U')+  ,('\7911','u')+  ,('\7922','Y')+  ,('\7923','y')+  ,('\7924','Y')+  ,('\7925','y')+  ,('\7926','Y')+  ,('\7927','y')+  ,('\7928','Y')+  ,('\7929','y')+  ,('\8175','`')+  ,('\8490','K')+  ,('\8800','=')+  ,('\8814','<')+  ,('\8815','>')+  ]
+ src/Commonmark/Extensions/Autolink.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.Autolink+  ( autolinkSpec )+where+import Commonmark.Types+import Commonmark.Tokens+import Commonmark.Syntax+import Commonmark.Inlines+import Commonmark.TokParsers+import Control.Monad (guard, void)+import Text.Parsec+import Data.Text (Text)+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid+#endif++autolinkSpec :: (Monad m, IsBlock il bl, IsInline il)+             => SyntaxSpec m il bl+autolinkSpec = mempty+  { syntaxInlineParsers = [parseAutolink]+  }++parseAutolink :: (Monad m, IsInline a) => InlineParser m a+parseAutolink = do+  void $ lookAhead $ satisfyTok $ \t ->+    case tokType t of+      WordChars -> True+      Symbol c  -> c == '.' || c == '-' || c == '_' || c == '+'+      _         -> False+  (prefix, linktext) <- withRaw $ wwwAutolink <|> urlAutolink <|> emailAutolink+  return $! link (prefix <> untokenize linktext) "" (str . untokenize $ linktext)++wwwAutolink :: Monad m => InlineParser m Text+wwwAutolink = try $ do+  lookAhead $ satisfyWord (== "www")+  validDomain+  linkSuffix+  return "http://"++validDomain :: Monad m => InlineParser m ()+validDomain = do+  let domainPart = do+        ds <- many1 $ satisfyTok (hasType WordChars)+                           <|> symbol '-'+                           <|> symbol '_'+        guard $ case reverse ds of+                     (Tok WordChars _ _ : _) -> True+                     _ -> False+  domainPart+  skipMany1 $ try (symbol '.' >> domainPart)++linkSuffix :: Monad m => InlineParser m ()+linkSuffix = try $ do+  toks <- getInput+  let possibleSuffixTok (Tok (Symbol c) _ _) =+        c `notElem` ['<','>','{','}','|','\\','^','~','[',']','`']+      possibleSuffixTok (Tok WordChars _ _) = True+      possibleSuffixTok _ = False+  let isDroppable (Tok (Symbol c) _ _) =+         c `elem` ['?','!','.',',',':','*','_','~']+      isDroppable _ = False+  let numToks = case dropWhile isDroppable $+                    reverse (takeWhile possibleSuffixTok toks) of+                     (Tok (Symbol ')') _ _ : xs)+                       | length [t | t@(Tok (Symbol '(') _ _) <- xs] <=+                         length [t | t@(Tok (Symbol ')') _ _) <- xs]+                       -> length xs+                     (Tok (Symbol ';') _ _+                        : Tok WordChars _ _+                        : Tok (Symbol '&') _ _+                        : xs) -> length xs+                     xs -> length xs+  count numToks anyTok+  return ()++urlAutolink :: Monad m => InlineParser m Text+urlAutolink = try $ do+  satisfyWord (`elem` ["http", "https", "ftp"])+  symbol ':'+  symbol '/'+  symbol '/'+  validDomain+  linkSuffix+  return ""++emailAutolink :: Monad m => InlineParser m Text+emailAutolink = try $ do+  let emailNameTok (Tok WordChars _ _) = True+      emailNameTok (Tok (Symbol c) _ _) =+         c == '.' || c == '-' || c == '_' || c == '+'+      emailNameTok _ = False+  skipMany1 $ satisfyTok emailNameTok+  symbol '@'+  validDomain+  return "mailto:"
+ src/Commonmark/Extensions/DefinitionList.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.DefinitionList+  ( definitionListSpec+  , HasDefinitionList(..)+  )+where+import Commonmark.Types+import Commonmark.Syntax+import Commonmark.Blocks+import Commonmark.SourceMap+import Commonmark.TokParsers+import Commonmark.Html+import Control.Monad (mzero)+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup)+import Data.Monoid+#endif+import Data.Dynamic+import Data.Tree+import Text.Parsec++definitionListSpec :: (Monad m, IsBlock il bl, IsInline il,+                       Typeable il, Typeable bl, HasDefinitionList il bl)+                   => SyntaxSpec m il bl+definitionListSpec = mempty+  { syntaxBlockSpecs = [definitionListDefinitionBlockSpec]+  }++definitionListBlockSpec :: (Monad m, IsBlock il bl, HasDefinitionList il bl)+                        => BlockSpec m il bl+definitionListBlockSpec = BlockSpec+     { blockType           = "DefinitionList"+     , blockStart          = mzero+     , blockCanContain     = \sp -> blockType sp == "DefinitionListItem"+     , blockContainsLines  = False+     , blockParagraph      = False+     , blockContinue       = \n -> (,n) <$> getPosition+     , blockConstructor    = \(Node bdata items) -> do+         let listType = fromDyn (blockData bdata) LooseList+         let getItem item@(Node _ ds) = do+               term <- runInlineParser (getBlockText item)+               defs <- mapM (\c -> blockConstructor (bspec c) c) ds+               return $! (term, defs)+         definitionList listType <$> mapM getItem items+     , blockFinalize       = \(Node cdata children) parent -> do+          let spacing =+                if elem LooseList+                     (map (\child ->+                            fromDyn (blockData (rootLabel child))+                              LooseList) children)+                   then LooseList+                   else TightList+          defaultFinalizer (Node cdata{ blockData = toDyn spacing } children)+                           parent+     }++definitionListItemBlockSpec ::+   (Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl)+   => BlockSpec m il bl+definitionListItemBlockSpec = BlockSpec+     { blockType           = "DefinitionListItem"+     , blockStart          = mzero+     , blockCanContain     = \sp -> blockType sp == "DefinitionListDefinition"+     , blockContainsLines  = False+     , blockParagraph      = False+     , blockContinue       = \n -> (,n) <$> getPosition+     , blockConstructor    = \_ -> mzero+     , blockFinalize       = \(Node cdata children) parent -> do+         let listSpacing   = fromDyn (blockData cdata) LooseList+         let totight (Node nd cs)+               | blockType (blockSpec nd) == "Paragraph"+                           = Node nd{ blockSpec = plainSpec } cs+               | otherwise = Node nd cs+         let childrenToTight (Node nd cs) = Node nd (map totight cs)+         let children' =+                case listSpacing of+                  TightList -> map childrenToTight children+                  LooseList -> children+         defaultFinalizer (Node cdata children') parent+     }++++definitionListDefinitionBlockSpec ::+   (Monad m, IsBlock il bl, IsInline il, HasDefinitionList il bl)+   => BlockSpec m il bl+definitionListDefinitionBlockSpec = BlockSpec+     { blockType           = "DefinitionListDefinition"+     , blockStart          = try $ do+         n <- gobbleUpToSpaces 3+         pos <- getPosition+         symbol ':' <|> symbol '~'+         gobbleSpaces (min 1 (3 - n))+         (Node bdata children : rest) <- nodeStack <$> getState+         let defnode = Node (defBlockData+                              definitionListDefinitionBlockSpec){+                                  blockStartPos = [pos] } []+         if blockType (blockSpec bdata) == "DefinitionListItem"+            then addNodeToStack defnode+            else do+             linode <-+               if blockParagraph (blockSpec bdata)+                 then do+                   -- a) we're in a paragraph -> TightList+                   --    make cur a DefinitionListItem instead+                   --    keep the tokens; they will be the term+                   -- remove paragraph from stack+                   updateState $ \st -> st{ nodeStack = rest }+                   return $! Node (defBlockData definitionListItemBlockSpec)+                            { blockData = toDyn TightList+                            , blockLines = blockLines bdata+                            , blockStartPos = blockStartPos bdata+                            } []+                 else+                   case children of+                     (lastChild : rest')+                       | blockParagraph (bspec lastChild) -> do+                         -- b) previous sibling is a paragraph -> LooseList+                         --    last child of cur is a Paragraph+                         --    remove this child and mk new child with its+                         --    content and position.  tokens will be term.+                         -- remove paragraph from stack+                         updateState $ \st -> st{ nodeStack =+                              Node bdata rest' : rest }+                         return $! Node (defBlockData+                                    definitionListItemBlockSpec)+                                  { blockData = toDyn LooseList+                                  , blockStartPos = blockStartPos+                                                     (rootLabel lastChild)+                                  , blockLines = blockLines+                                        (rootLabel lastChild)+                                  } []+                     _ -> mzero++             let listnode = Node (defBlockData definitionListBlockSpec){+                                blockStartPos = blockStartPos+                                             (rootLabel linode) } []+             (Node bdata' children' : rest') <- nodeStack <$> getState+             -- if last child was DefinitionList, set that to current+             case children' of+               m:ms | blockType (blockSpec (rootLabel m)) == "DefinitionList"+                   -> updateState $ \st -> st{ nodeStack =+                        m : Node bdata' ms : rest' }+               _ -> return ()+             (Node bdata'' _ : _) <- nodeStack <$> getState+             case blockType (blockSpec bdata'') of+                  "DefinitionList"+                    -> addNodeToStack linode >> addNodeToStack defnode+                  _ -> addNodeToStack listnode >> addNodeToStack linode >>+                       addNodeToStack defnode+         return BlockStartMatch+     , blockCanContain     = const True+     , blockContainsLines  = False+     , blockParagraph      = False+     , blockContinue       = \node -> do+         pos <- getPosition+         gobbleSpaces 4 <|> 0 <$ lookAhead blankLine+         return $! (pos, node)+     , blockConstructor    = fmap mconcat . renderChildren+     , blockFinalize       = defaultFinalizer+     }++class IsBlock il bl => HasDefinitionList il bl | il -> bl where+  definitionList :: ListSpacing -> [(il,[bl])] -> bl++instance Rangeable (Html a) =>+         HasDefinitionList (Html a) (Html a) where+  definitionList spacing items =+    htmlBlock "dl" $ Just $ htmlRaw "\n" <>+       mconcat (map (definitionListItem spacing) items)++definitionListItem :: ListSpacing -> (Html a, [Html a]) -> Html a+definitionListItem spacing (term, defns) =+  htmlBlock "dt" (Just term) <>+   mconcat (map (\defn ->+            case spacing of+              LooseList -> htmlBlock "dd" (Just (htmlRaw "\n" <> defn))+              TightList -> htmlBlock "dd" (Just defn)) defns)++instance (HasDefinitionList il bl, Semigroup bl, Semigroup il)+        => HasDefinitionList (WithSourceMap il) (WithSourceMap bl) where+  definitionList spacing items = do+    let (terms, defs) = unzip items+    terms' <- sequence terms+    defs' <- mapM sequence defs+    let res = definitionList spacing (zip terms' defs')+    addName "definitionList"+    return res
+ src/Commonmark/Extensions/Emoji.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.Emoji+  ( HasEmoji(..)+  , emojiSpec )+where+import Commonmark.Types+import Commonmark.Tokens+import Commonmark.Syntax+import Commonmark.Inlines+import Commonmark.SourceMap+import Commonmark.TokParsers+import Commonmark.Html+import Text.Emoji (emojiFromAlias)+import Text.Parsec+import Data.Text (Text)++emojiSpec :: (Monad m, IsBlock il bl, IsInline il, HasEmoji il)+          => SyntaxSpec m il bl+emojiSpec = mempty+  { syntaxInlineParsers = [withAttributes parseEmoji]+  }++class HasEmoji a where+  emoji :: Text   -- the ascii keyword+        -> Text   -- the emoji characters+        -> a++instance HasEmoji (Html a) where+  emoji kw t = addAttribute ("class", "emoji") .+               addAttribute ("data-emoji", kw) $+    htmlInline "span" $ Just $ htmlText t++instance (HasEmoji i, Monoid i) => HasEmoji (WithSourceMap i) where+  emoji kw t = emoji kw t <$ addName "emoji"++parseEmoji :: (Monad m, HasEmoji a) => InlineParser m a+parseEmoji = try $ do+  symbol ':'+  ts <- many1 $ satisfyWord (const True)+             <|> symbol '_'+             <|> symbol '+'+             <|> symbol '-'+  symbol ':'+  let kw = untokenize ts+  case emojiFromAlias kw of+    Nothing -> fail "emoji not found"+    Just t  -> return $! emoji kw t
+ src/Commonmark/Extensions/FancyList.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+++module Commonmark.Extensions.FancyList+  ( fancyListSpec+  )+where+import Commonmark.Types+import Commonmark.Tokens+import Commonmark.Syntax+import Commonmark.TokParsers+import Commonmark.Blocks+import qualified Data.Text as T+import Control.Monad (mzero, guard, when)+import Text.Parsec+import qualified Data.Text.Read as TR+import Data.Char (isAlpha, isDigit, isLower, isUpper, ord, toLower)++fancyListSpec :: (Monad m, IsBlock il bl, IsInline il)+               => SyntaxSpec m il bl+fancyListSpec = mempty+  { syntaxBlockSpecs =+     [ listItemSpec (bulletListMarker <|> fancyOrderedListMarker) ]+  }++fancyOrderedListMarker :: Monad m => BlockParser m il bl ListType+fancyOrderedListMarker = do+  initialParen <- option False $ True <$ symbol '('+  (start, enumtype) <- pDecimal <|>+                       pLowerRoman <|> pUpperRoman <|>+                       pLowerAlpha <|> pUpperAlpha+  delimtype <- if initialParen+                  then TwoParens <$ symbol ')'+                  else Period <$ symbol '.' <|> OneParen <$ symbol ')'+  when (delimtype == Period &&+        (enumtype == UpperRoman || enumtype == UpperAlpha)) $ do+    Tok tt _ t <- lookAhead anyTok+    guard $ case tt of+              Spaces  -> T.length t > 1+              LineEnd -> True+              _       -> False+  return $! OrderedList start enumtype delimtype++  where+    pDecimal = do+      Tok WordChars _ ds <- satisfyWord (\t ->+                              T.all isDigit t && T.length t < 10)+      case TR.decimal ds of+        Left e -> fail e+        Right (x,_) -> return $! (x, Decimal)++    pLowerAlpha = do+      Tok WordChars _ ds <- satisfyWord (\t ->+                              T.length t == 1 &&+                              T.all isAlpha t &&+                              T.all isLower t)+      case T.uncons ds of+        Nothing    -> mzero+        Just (c,_) -> return $! (1 + ord c - ord 'a', LowerAlpha)++    pUpperAlpha = do+      Tok WordChars _ ds <- satisfyWord (\t ->+                              T.length t == 1 &&+                              T.all isAlpha t &&+                              T.all isUpper t)+      case T.uncons ds of+        Nothing    -> mzero+        Just (c,_) -> return $! (1 + ord c - ord 'A', UpperAlpha)++    pLowerRoman = do+      Tok WordChars _ ds <- satisfyWord (\t ->+                              T.length t < 10 &&+                              T.all isLowerRoman t)+      case parse (romanNumeral False) "" ds of+        Left _     -> mzero+        Right x    -> return $! (x, LowerRoman)++    pUpperRoman = do+      Tok WordChars _ ds <- satisfyWord (\t ->+                              T.length t < 10 &&+                              T.all isUpperRoman t)+      case parse (romanNumeral True) "" ds of+        Left _     -> mzero+        Right x    -> return $! (x, UpperRoman)++isLowerRoman :: Char -> Bool+isLowerRoman c = c `elem` ['i','v','x','l','c','d','m']++isUpperRoman :: Char -> Bool+isUpperRoman c = c `elem` ['I','V','X','L','C','D','M']++-- from pandoc:+romanNumeral :: Stream s m Char+             => Bool                  -- ^ Uppercase if true+             -> ParsecT s st m Int+romanNumeral upperCase = do+    let rchar uc = char $ if upperCase then uc else toLower uc+    let one         = rchar 'I'+    let five        = rchar 'V'+    let ten         = rchar 'X'+    let fifty       = rchar 'L'+    let hundred     = rchar 'C'+    let fivehundred = rchar 'D'+    let thousand    = rchar 'M'+    lookAhead $ choice [one, five, ten, fifty, hundred, fivehundred, thousand]+    thousands <- ((1000 *) . length) <$> many thousand+    ninehundreds <- option 0 $ try $ hundred >> thousand >> return 900+    fivehundreds <- option 0 $ 500 <$ fivehundred+    fourhundreds <- option 0 $ try $ hundred >> fivehundred >> return 400+    hundreds <- ((100 *) . length) <$> many hundred+    nineties <- option 0 $ try $ ten >> hundred >> return 90+    fifties <- option 0 (50 <$ fifty)+    forties <- option 0 $ try $ ten >> fifty >> return 40+    tens <- ((10 *) . length) <$> many ten+    nines <- option 0 $ try $ one >> ten >> return 9+    fives <- option 0 (5 <$ five)+    fours <- option 0 $ try $ one >> five >> return 4+    ones <- length <$> many one+    let total = thousands + ninehundreds + fivehundreds + fourhundreds ++                hundreds + nineties + fifties + forties + tens + nines ++                fives + fours + ones+    if total == 0+       then fail "not a roman numeral"+       else return $! total
+ src/Commonmark/Extensions/Footnote.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.Footnote+  ( footnoteSpec+  , HasFootnote(..)+  )+where+import Commonmark.Tokens+import Commonmark.Types+import Commonmark.Html+import Commonmark.Syntax+import Commonmark.Blocks+import Commonmark.Inlines+import Commonmark.SourceMap+import Commonmark.TokParsers+import Commonmark.ReferenceMap+import Control.Monad.Trans.Class (lift)+import Control.Monad (mzero)+import Data.List+import Data.Maybe (fromMaybe, mapMaybe)+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup)+import Data.Monoid+#endif+import Data.Dynamic+import Data.Tree+import Text.Parsec+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Map as M++data FootnoteDef bl m =+  FootnoteDef Int Text (ReferenceMap -> m (Either ParseError bl))+  deriving Typeable++instance Eq (FootnoteDef bl m) where+  FootnoteDef num1 lab1 _ == FootnoteDef num2 lab2 _+    = num1 == num2 && lab1 == lab2++instance Ord (FootnoteDef bl m) where+  (FootnoteDef num1 lab1 _) `compare` (FootnoteDef num2 lab2 _) =+    (num1, lab1) `compare` (num2, lab2)++footnoteSpec :: (Monad m, Typeable m, IsBlock il bl, IsInline il,+                 Typeable il, Typeable bl, HasFootnote il bl)+             => SyntaxSpec m il bl+footnoteSpec = mempty+  { syntaxBlockSpecs = [footnoteBlockSpec]+  , syntaxInlineParsers = [withAttributes pFootnoteRef]+  , syntaxFinalParsers = [addFootnoteList]+  }++footnoteBlockSpec :: (Monad m, Typeable m, Typeable il, Typeable bl,+                      IsBlock il bl, IsInline il, HasFootnote il bl)+                  => BlockSpec m il bl+footnoteBlockSpec = BlockSpec+     { blockType           = "Footnote"+     , blockStart          = try $ do+             nonindentSpaces+             pos <- getPosition+             lab' <- pFootnoteLabel+             _ <- symbol ':'+             counters' <- counters <$> getState+             let num = fromMaybe (1 :: Int) $+                       M.lookup "footnote" counters' >>= fromDynamic+             updateState $ \s -> s{ counters =+                                     M.insert "footnote" (toDyn (num + 1))+                                      (counters s) }+             addNodeToStack $+                Node (defBlockData footnoteBlockSpec){+                            blockData = toDyn (num, lab')+                          , blockStartPos = [pos] } []+             return BlockStartMatch+     , blockCanContain     = const True+     , blockContainsLines  = False+     , blockParagraph      = False+     , blockContinue       = \n -> try $ do+             () <$ (gobbleSpaces 4)+               <|> (skipWhile (hasType Spaces) >> () <$ lookAhead lineEnd)+             pos <- getPosition+             return $! (pos, n)+     , blockConstructor    = \node ->+          mconcat <$> mapM (\n ->+              blockConstructor (blockSpec (rootLabel n)) n)+            (reverse (subForest node))+     , blockFinalize       = \(Node root children) parent -> do+         let (num, lab') = fromDyn (blockData root) (1, mempty)+         st <- getState+         let mkNoteContents refmap =+               runParserT+                 (blockConstructor (blockSpec root) (Node root children))+                 st{ referenceMap = refmap }+                 "source" []+         updateState $ \s -> s{+             referenceMap = insertReference lab'+                              (FootnoteDef num lab' mkNoteContents)+                              (referenceMap s)+             }+         return $! parent+     }++pFootnoteLabel :: Monad m => ParsecT [Tok] u m Text+pFootnoteLabel = try $ do+  lab <- pLinkLabel+  case T.uncons lab of+        Just ('^', t') -> return $! t'+        _ -> mzero++pFootnoteRef :: (Monad m, Typeable m, Typeable a,+                 Typeable b, IsInline a, IsBlock a b, HasFootnote a b)+             => InlineParser m a+pFootnoteRef = try $ do+  lab <- pFootnoteLabel+  rm <- getReferenceMap+  case lookupReference lab rm of+        Just (FootnoteDef num _ mkContents) -> do+          res <- lift . lift $ mkContents rm+          case res of+               Left err -> mkPT (\_ -> return (Empty (return (Error err))))+               Right contents -> return $!+                 footnoteRef (T.pack (show num)) lab contents+        Nothing -> mzero++addFootnoteList :: (Monad m, Typeable m, Typeable bl, HasFootnote il bl,+                    IsBlock il bl) => BlockParser m il bl bl+addFootnoteList = do+  rm <- referenceMap <$> getState+  let keys = M.keys . unReferenceMap $ rm+  let getNote key = lookupReference key rm+  let notes = sort $ mapMaybe getNote keys+  let renderNote (FootnoteDef num lab mkContents) = do+        res <- lift $ mkContents rm+        case res of+             Left err -> mkPT (\_ -> return (Empty (return (Error err))))+             Right contents -> return $! footnote num lab contents+  if null notes+     then return mempty+     else footnoteList <$> mapM renderNote notes++class IsBlock il bl => HasFootnote il bl | il -> bl where+  footnote :: Int -> Text -> bl -> bl+  footnoteList :: [bl] -> bl+  footnoteRef :: Text -> Text -> bl -> il++instance Rangeable (Html a) => HasFootnote (Html a) (Html a) where+  footnote num lab' x =+    addAttribute ("class", "footnote") $+    addAttribute ("id", "fn-" <> lab') $+    htmlBlock "div" $ Just $ htmlRaw "\n" <>+      (addAttribute ("class", "footnote-number") $+       htmlBlock "div" $ Just $ htmlRaw "\n" <>+        (addAttribute ("href", "#fnref-" <> lab') $+         htmlInline "a" (Just $ htmlText $ T.pack $ show num)) <>+         htmlRaw "\n") <>+      (addAttribute ("class", "footnote-contents") $+        htmlBlock "div" $ Just $ htmlRaw "\n" <> x)+  footnoteList items =+    addAttribute ("class", "footnotes") $+      htmlBlock "section" $ Just $ htmlRaw "\n" <> mconcat items+  footnoteRef x lab _ =+   addAttribute ("class", "footnote-ref") $+     htmlInline "sup" $ Just $+       addAttribute ("href", "#fn-" <> lab) $+       addAttribute ("id", "fnref-" <> lab) $+       htmlInline "a" $ Just (htmlText x)++instance (HasFootnote il bl, Semigroup bl, Semigroup il)+        => HasFootnote (WithSourceMap il) (WithSourceMap bl) where+  footnote num lab' x = (footnote num lab' <$> x) <* addName "footnote"+  footnoteList items = footnoteList <$> sequence items+  footnoteRef x y z = (footnoteRef x y <$> z) <* addName "footnoteRef"
+ src/Commonmark/Extensions/HardLineBreaks.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.HardLineBreaks+  ( hardLineBreaksSpec )+where+import Commonmark.Types+import Commonmark.Syntax+import Commonmark.Inlines+import Commonmark.TokParsers+import Commonmark.Tokens++hardLineBreaksSpec :: (Monad m, IsBlock il bl, IsInline il)+                   => SyntaxSpec m il bl+hardLineBreaksSpec = mempty+  { syntaxInlineParsers = [ hardLineBreakParser ]+  }++hardLineBreakParser :: (Monad m, IsInline a) => InlineParser m a+hardLineBreakParser = lineBreak <$ satisfyTok (hasType LineEnd)+
+ src/Commonmark/Extensions/ImplicitHeadingReferences.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE LambdaCase #-}+module Commonmark.Extensions.ImplicitHeadingReferences+  ( implicitHeadingReferencesSpec+  )+where+import Commonmark.Types+import Commonmark.Tokens+import Commonmark.Syntax+import Commonmark.Blocks+import Commonmark.ReferenceMap+import qualified Data.Text as T+import Control.Monad (unless)+import Data.Maybe (fromMaybe)+import Text.Parsec+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif++implicitHeadingReferencesSpec+         :: (Monad m, IsBlock il bl, IsInline il)+         => SyntaxSpec m il bl+implicitHeadingReferencesSpec = mempty+  { syntaxFinalParsers = [addHeadingReferences]+  }++-- Go through the node stack and add implicit references+-- for each header.+addHeadingReferences :: (Monad m, IsBlock il bl, IsInline il)+                    => BlockParser m il bl bl+addHeadingReferences = do+  nodes <- nodeStack <$> getState+  mapM_ (traverse addHeadingRef) nodes+  return mempty++addHeadingRef :: (Monad m, IsBlock il bl, IsInline il)+             => BlockData m il bl -> BlockParser m il bl ()+addHeadingRef bd+  | blockType (blockSpec bd) `elem` ["ATXHeading", "SetextHeading"] = do+      -- update ref map+      let lab = untokenize . removeIndent . mconcat . reverse . blockLines $ bd+      let ident = fromMaybe "" $ lookup "id" $ blockAttributes bd+      unless (T.null lab) $+        updateState $ \s -> s{+          referenceMap = insertReference lab+            LinkInfo{ linkDestination = "#" <> ident+                    , linkTitle = mempty+                    , linkAttributes = mempty }+            (referenceMap s) }+  | otherwise = return ()
+ src/Commonmark/Extensions/Math.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.Math+  ( HasMath(..)+  , mathSpec )+where+import Commonmark.Types+import Commonmark.Tokens+import Commonmark.Syntax+import Commonmark.Inlines+import Commonmark.SourceMap+import Commonmark.TokParsers+import Commonmark.Html+import Text.Parsec+import Data.Text (Text)+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup(..))+#endif++mathSpec :: (Monad m, IsBlock il bl, IsInline il, HasMath il)+         => SyntaxSpec m il bl+mathSpec = mempty+  { syntaxInlineParsers = [withAttributes parseMath]+  }++class HasMath a where+  inlineMath :: Text -> a+  displayMath :: Text -> a++instance HasMath (Html a) where+  inlineMath t = addAttribute ("class", "math inline") $+    htmlInline "span" $ Just $ htmlRaw "\\(" <> htmlText t <> htmlRaw "\\)"+  displayMath t = addAttribute ("class", "math display") $+    htmlInline "span" $ Just $ htmlRaw "\\[" <> htmlText t <> htmlRaw "\\]"++instance (HasMath i, Monoid i) => HasMath (WithSourceMap i) where+  inlineMath t = (inlineMath t) <$ addName "inlineMath"+  displayMath t = (displayMath t) <$ addName "displayMath"++parseMath :: (Monad m, HasMath a) => InlineParser m a+parseMath = pDisplayMath <|> pInlineMath++pInlineMath :: (Monad m, HasMath a) => InlineParser m a+pInlineMath = try $ do+  symbol '$'+  notFollowedBy whitespace+  (_, toks) <- withRaw $ many1 $+                  choice [ () <$ symbol '\\' >> anyTok+                         , whitespace >> lookAhead (noneOfToks [Symbol '$'])+                         , noneOfToks [Symbol '$']+                         ]+  symbol '$'+  return $! inlineMath (untokenize toks)++pDisplayMath :: (Monad m, HasMath a) => InlineParser m a+pDisplayMath = try $ do+  count 2 $ symbol '$'+  (_, toks) <- withRaw $ many1 $+                  choice [ () <$ symbol '\\' >> anyTok+                         , noneOfToks [Symbol '$']+                         ]+  count 2 $ symbol '$'+  return $! displayMath (untokenize toks)
+ src/Commonmark/Extensions/PipeTable.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE IncoherentInstances   #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE DeriveDataTypeable    #-}++module Commonmark.Extensions.PipeTable+ ( HasPipeTable(..)+ , ColAlignment(..)+ , pipeTableSpec+ )+where++import Control.Monad (guard)+import Commonmark.Syntax+import Commonmark.Types+import Commonmark.Tokens+import Commonmark.TokParsers+import Commonmark.Blocks+import Commonmark.SourceMap+import Commonmark.Html+import Text.Parsec+import Data.Dynamic+import Data.Tree+import Data.Data+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup(..))+#endif++data ColAlignment = LeftAlignedCol+                  | CenterAlignedCol+                  | RightAlignedCol+                  | DefaultAlignedCol+                  deriving (Show, Eq, Data, Typeable)++data PipeTableData = PipeTableData+     { pipeTableAlignments :: [ColAlignment]+     , pipeTableHeaders    :: [[Tok]]+     , pipeTableRows       :: [[[Tok]]] -- in reverse order+     } deriving (Show, Eq, Data, Typeable)++class HasPipeTable il bl where+  pipeTable :: [ColAlignment] -> [il] -> [[il]] -> bl++instance HasPipeTable (Html a) (Html a) where+  pipeTable aligns headerCells rows =+    htmlBlock "table" $ Just $ htmlRaw "\n" <>+    (if null headerCells+        then mempty+        else htmlBlock "thead" $ Just $ htmlRaw "\n" <>+             toRow "th" aligns headerCells) <>+    (if null rows+        then mempty+        else htmlBlock "tbody" $ Just $ htmlRaw "\n" <>+             mconcat (map (toRow "td" aligns) rows))+    where+      alignToAttr LeftAlignedCol    =+        addAttribute ("style","text-align: left;")+      alignToAttr CenterAlignedCol  =+        addAttribute ("style","text-align: center;")+      alignToAttr RightAlignedCol   =+        addAttribute ("style","text-align: right;")+      alignToAttr DefaultAlignedCol = id+      toRow constructor aligns' cells =+        htmlBlock "tr" $ Just $ htmlRaw "\n" <>+          mconcat (zipWith (toCell constructor) aligns' cells)+      toCell constructor align cell =+        (alignToAttr align $ htmlInline constructor $ Just cell)+          <> htmlRaw "\n"++instance (HasPipeTable i b, Monoid b)+        => HasPipeTable (WithSourceMap i) (WithSourceMap b) where+  pipeTable aligns headerCells rows = do+    (pipeTable aligns <$> sequence headerCells <*> mapM sequence rows)+     <* addName "pipeTable"++pCells :: Monad m => ParsecT [Tok] s m [[Tok]]+pCells = try $ do+  hasPipe <- option False $ True <$ symbol '|'+  pipedCells <- many (try $ pCell <* symbol '|')+  unpipedCell <- option [] $ (:[]) <$> pCell+  let cells = pipedCells ++ unpipedCell+  guard $ not (null cells)+  guard $ hasPipe || not (null pipedCells) -- need at least one |+  lookAhead blankLine+  return $! cells++pCell :: Monad m => ParsecT [Tok] s m [Tok]+pCell = mconcat <$> many1+  ( try+      (do tok' <- symbol '\\'+          tok@(Tok (Symbol c) _ _) <- anySymbol+          if c == '|'+             then return $! [tok]+             else return $! [tok',tok])+  <|> (do tok <- (satisfyTok $ \t -> not (hasType (Symbol '|') t ||+                                       hasType LineEnd t))+          return $! [tok])+  ) <|> ([] <$ lookAhead (symbol '|'))++pDividers :: Monad m => ParsecT [Tok] s m [ColAlignment]+pDividers = try $ do+  hasPipe <- option False $ True <$ symbol '|'+  pipedAligns <- many (try $ pDivider <* symbol '|')+  unpipedAlign <- option [] $ (:[]) <$> pDivider+  let aligns = pipedAligns ++ unpipedAlign+  guard $ not (null aligns)+  guard $ hasPipe || not (null pipedAligns) -- need at least one |+  lookAhead blankLine+  return $! aligns+++pDivider :: Monad m => ParsecT [Tok] s m ColAlignment+pDivider = try $ do+  skipMany $ satisfyTok (hasType Spaces)+  align <- choice+    [ CenterAlignedCol <$+       try (symbol ':' >> many1 (symbol '-') >> symbol ':')+    , LeftAlignedCol <$+       try (symbol ':' >> many1 (symbol '-'))+    , RightAlignedCol <$+       try (many1 (symbol '-') >> symbol ':')+    , DefaultAlignedCol <$+       many1 (symbol '-')+    ]+  skipMany $ satisfyTok (hasType Spaces)+  return $! align++pipeTableSpec :: (Monad m, IsBlock il bl, IsInline il, HasPipeTable il bl)+              => SyntaxSpec m il bl+pipeTableSpec = mempty+  { syntaxBlockSpecs = [pipeTableBlockSpec]+  }++pipeTableBlockSpec :: (Monad m, IsBlock il bl, IsInline il,+                       HasPipeTable il bl)+                   => BlockSpec m il bl+pipeTableBlockSpec = BlockSpec+     { blockType           = "PipeTable" -- :: Text+     , blockStart          = try $ do -- :: BlockParser m il bl ()+         interruptsParagraph >>= guard . not+         nonindentSpaces+         notFollowedBy whitespace+         pos <- getPosition+         (cells, toks) <- withRaw pCells+         nl <- lookAhead lineEnd+         let tabledata = PipeTableData+              { pipeTableAlignments = []+              , pipeTableHeaders    = cells+              , pipeTableRows       = []+              }+         addNodeToStack $+               Node (defBlockData pipeTableBlockSpec){+                         blockStartPos = [pos]+                       , blockData = toDyn tabledata+                       , blockLines = [toks ++ [nl]]+                       } []+         return BlockStartMatch+     , blockCanContain     = \_ -> False -- :: BlockSpec m il bl -> Bool+     , blockContainsLines  = False -- :: Bool+     , blockParagraph      = False -- :: Bool+     , blockContinue       = \(Node ndata children) -> try $ do+         nonindentSpaces+         notFollowedBy blankLine+         let tabledata = fromDyn+                (blockData ndata)+                PipeTableData{ pipeTableAlignments = []+                             , pipeTableHeaders = []+                             , pipeTableRows = [] }+         pos <- getPosition+         if null (blockLines ndata)+           then do+             cells <- pCells+             let tabledata' = tabledata{ pipeTableRows =+                                 cells : pipeTableRows tabledata }+             return $! (pos, Node ndata{ blockData =+                                   toDyn tabledata' } children)+           else+             -- last line was first; check for separators+             -- and if not found, convert to paragraph:+             try (do aligns <- pDividers+                     guard $ length aligns ==+                             length (pipeTableHeaders tabledata)+                     let tabledata' = tabledata{ pipeTableAlignments = aligns }+                     return $! (pos, Node ndata{+                                              blockLines = []+                                            , blockData = toDyn tabledata'+                                            } children))+             <|> (return $! (pos, Node ndata{+                                   blockSpec = paraSpec } children))+     , blockConstructor    = \(Node ndata _) -> do+         let tabledata = fromDyn+                (blockData ndata)+                PipeTableData{ pipeTableAlignments = []+                             , pipeTableHeaders = []+                             , pipeTableRows = [] }+         let aligns = pipeTableAlignments tabledata+         headers <- mapM runInlineParser (pipeTableHeaders tabledata)+         let numcols = length headers+         rows <- mapM (mapM runInlineParser . take numcols . (++ (repeat [])))+                    (reverse $ pipeTableRows tabledata)+         return $! (pipeTable aligns headers rows)+     , blockFinalize       = \(Node ndata children) parent ->+         defaultFinalizer+           (if null (blockLines ndata)+               then Node ndata children+               else Node ndata{ blockSpec = paraSpec } children) parent+     }
+ src/Commonmark/Extensions/Smart.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.Smart+  ( smartPunctuationSpec )+where++import Commonmark.Types+import Commonmark.Syntax+import Commonmark.Inlines+import Commonmark.TokParsers (symbol)+import Text.Parsec+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid+#endif++smartPunctuationSpec :: (Monad m, IsBlock il bl, IsInline il)+                     => SyntaxSpec m il bl+smartPunctuationSpec = mempty+  { syntaxFormattingSpecs = [singleQuotedSpec, doubleQuotedSpec]+  , syntaxInlineParsers = [pEllipses, pDash]+  }++singleQuotedSpec :: IsInline il => FormattingSpec il+singleQuotedSpec = FormattingSpec '\'' False False (Just singleQuoted) Nothing '’'++doubleQuotedSpec :: IsInline il => FormattingSpec il+doubleQuotedSpec = FormattingSpec '"' False False (Just doubleQuoted) Nothing '“'++singleQuoted :: IsInline il => il -> il+singleQuoted x = str "‘" <> x <> str "’"++doubleQuoted :: IsInline il => il -> il+doubleQuoted x = str "“" <> x <> str "”"++pEllipses :: (Monad m, IsInline a) => InlineParser m a+pEllipses = try $ do+  count 3 (symbol '.')+  return $! str "…"++pDash :: (Monad m, IsInline a) => InlineParser m a+pDash = try $ do+  symbol '-'+  numhyphens <- (+1) . length <$> many1 (symbol '-')+  let (emcount, encount) =+        case numhyphens of+             n | n `mod` 3 == 0 -> (n `div` 3, 0)+               | n `mod` 2 == 0 -> (0, n `div` 2)+               | n `mod` 3 == 2 -> ((n - 2) `div` 3, 1)+               | otherwise      -> ((n - 4) `div` 3, 2)+  return $! mconcat $+    replicate emcount (str "—") <>+    replicate encount (str "–")
+ src/Commonmark/Extensions/Strikethrough.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.Strikethrough+  ( HasStrikethrough(..)+  , strikethroughSpec )+where+import Commonmark.Types+import Commonmark.Syntax+import Commonmark.Inlines+import Commonmark.SourceMap+import Commonmark.Html++strikethroughSpec :: (Monad m, IsBlock il bl, IsInline il, HasStrikethrough il)+              => SyntaxSpec m il bl+strikethroughSpec = mempty+  { syntaxFormattingSpecs = [+      FormattingSpec '~' True True Nothing (Just strikethrough) '~'+      ]+  }++class HasStrikethrough a where+  strikethrough :: a -> a++instance HasStrikethrough (Html a) where+  strikethrough x = htmlInline "del" (Just x)++instance (HasStrikethrough i, Monoid i)+        => HasStrikethrough (WithSourceMap i) where+  strikethrough x = (strikethrough <$> x) <* addName "strikethrough"
+ src/Commonmark/Extensions/Subscript.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.Subscript+  ( HasSubscript(..)+  , subscriptSpec )+where+import Commonmark.Types+import Commonmark.Syntax+import Commonmark.Inlines+import Commonmark.SourceMap+import Commonmark.Html++subscriptSpec :: (Monad m, IsBlock il bl, IsInline il, HasSubscript il)+              => SyntaxSpec m il bl+subscriptSpec = mempty+  { syntaxFormattingSpecs = [+      FormattingSpec '~' True True (Just subscript) Nothing '~'+      ]+  }++class HasSubscript a where+  subscript :: a -> a++instance HasSubscript (Html a) where+  subscript x = htmlInline "sub" (Just x)++instance (HasSubscript i, Monoid i)+        => HasSubscript (WithSourceMap i) where+  subscript x = (subscript <$> x) <* addName "subscript"
+ src/Commonmark/Extensions/Superscript.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.Superscript+  ( HasSuperscript(..)+  , superscriptSpec )+where+import Commonmark.Types+import Commonmark.Syntax+import Commonmark.Inlines+import Commonmark.SourceMap+import Commonmark.Html++superscriptSpec :: (Monad m, IsBlock il bl, IsInline il, HasSuperscript il)+              => SyntaxSpec m il bl+superscriptSpec = mempty+  { syntaxFormattingSpecs = [+      FormattingSpec '^' True True (Just superscript) Nothing '^'+      ]+  }++class HasSuperscript a where+  superscript :: a -> a++instance HasSuperscript (Html a) where+  superscript x = htmlInline "sup" (Just x)++instance (HasSuperscript i, Monoid i)+        => HasSuperscript (WithSourceMap i) where+  superscript x = (superscript <$> x) <* addName "superscript"
+ src/Commonmark/Extensions/TaskList.hs view
@@ -0,0 +1,235 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+module Commonmark.Extensions.TaskList+  ( taskListSpec+  , HasTaskList (..)+  )+where+import Commonmark.Tokens+import Commonmark.Types+import Commonmark.Syntax+import Commonmark.Blocks+import Commonmark.SourceMap+import Commonmark.TokParsers+import Commonmark.Html+import Control.Monad (mzero)+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup)+import Data.Monoid ((<>))+#endif+import Control.Monad (when, guard)+import Data.List (sort)+import Data.Dynamic+import Data.Tree+import Text.Parsec+++taskListSpec :: (Monad m, Typeable m, IsBlock il bl, IsInline il,+                       Typeable il, Typeable bl, HasTaskList il bl)+                   => SyntaxSpec m il bl+taskListSpec = mempty+  { syntaxBlockSpecs = [taskListItemBlockSpec]+  }++data ListData = ListData+     { listType    :: !ListType+     , listSpacing :: !ListSpacing+     } deriving (Show, Eq)++data ListItemData = ListItemData+     { listItemType         :: !ListType+     , listItemChecked      :: !Bool+     , listItemIndent       :: !Int+     , listItemBlanksInside :: !Bool+     , listItemBlanksAtEnd  :: !Bool+     } deriving (Show, Eq)++taskListBlockSpec :: (Monad m, IsBlock il bl,+                      HasTaskList il bl) => BlockSpec m il bl+taskListBlockSpec = BlockSpec+     { blockType           = "TaskList"+     , blockStart          = mzero+     , blockCanContain     = \sp -> blockType sp == "TaskListItem"+     , blockContainsLines  = False+     , blockParagraph      = False+     , blockContinue       = \n -> (,n) <$> getPosition+     , blockConstructor    = \node -> do+          let ListData lt ls = fromDyn (blockData (rootLabel node))+                                 (ListData (BulletList '*') TightList)+          let getCheckedStatus n =+               listItemChecked $+                      fromDyn (blockData (rootLabel n))+                         (ListItemData (BulletList '*') False 0 False False)+          let checkedStatus = map getCheckedStatus $ subForest node+          taskList lt ls . zip checkedStatus <$> renderChildren node+     , blockFinalize       = \(Node cdata children) parent -> do+          let ListData lt _ = fromDyn (blockData cdata)+                                 (ListData (BulletList '*') TightList)+          let getListItemData (Node d _) =+                fromDyn (blockData d)+                  (ListItemData (BulletList '*') False 0 False False)+          let childrenData = map getListItemData children+          let ls = case childrenData of+                          c:cs | any listItemBlanksInside (c:cs) ||+                                 (not (null cs) &&+                                  any listItemBlanksAtEnd cs)+                               -> LooseList+                          _    -> TightList+          blockBlanks' <- case childrenData of+                             c:_ | listItemBlanksAtEnd c -> do+                                 curline <- sourceLine <$> getPosition+                                 return $! curline - 1 : blockBlanks cdata+                             _ -> return $! blockBlanks cdata+          let ldata' = toDyn (ListData lt ls)+          -- need to transform paragraphs on tight lists+          let totight (Node nd cs)+                | blockType (blockSpec nd) == "Paragraph"+                            = Node nd{ blockSpec = plainSpec } cs+                | otherwise = Node nd cs+          let childrenToTight (Node nd cs) = Node nd (map totight cs)+          let children' =+                 if ls == TightList+                    then map childrenToTight children+                    else children+          defaultFinalizer (Node cdata{ blockData = ldata'+                                      , blockBlanks = blockBlanks' } children')+                           parent+     }++taskListItemBlockSpec :: (Monad m, IsBlock il bl, HasTaskList il bl)+                      => BlockSpec m il bl+taskListItemBlockSpec = BlockSpec+     { blockType           = "TaskListItem"+     , blockStart          = do+             (pos, lidata) <- itemStart+             let linode = Node (defBlockData taskListItemBlockSpec){+                             blockData = toDyn lidata,+                             blockStartPos = [pos] } []+             let listdata = ListData{+                    listType = listItemType lidata+                  , listSpacing = TightList }+                  -- spacing gets set in finalize+             let listnode = Node (defBlockData taskListBlockSpec){+                              blockData = toDyn listdata,+                              blockStartPos = [pos] } []+             -- list can only interrupt paragraph if bullet+             -- list or ordered list w/ startnum == 1,+             -- and not followed by blank+             (cur:_) <- nodeStack <$> getState+             when (blockParagraph (bspec cur)) $ do+               guard $ case listType listdata of+                            BulletList _            -> True+                            OrderedList 1 Decimal _ -> True+                            _                       -> False+               notFollowedBy blankLine+             let curdata = fromDyn (blockData (rootLabel cur))+                                (ListData (BulletList '*') TightList)+             let matchesList (BulletList c) (BulletList d)       = c == d+                 matchesList (OrderedList _ e1 d1)+                             (OrderedList _ e2 d2) = e1 == e2 && d1 == d2+                 matchesList _ _                                 = False+             case blockType (bspec cur) of+                  "TaskList" | listType curdata `matchesList`+                               listItemType lidata+                    -> addNodeToStack linode+                  _ -> addNodeToStack listnode >> addNodeToStack linode+             return BlockStartMatch+     , blockCanContain     = const True+     , blockContainsLines  = False+     , blockParagraph      = False+     , blockContinue       = \node@(Node ndata children) -> do+             let lidata = fromDyn (blockData ndata)+                             (ListItemData (BulletList '*') False 0+                              False False)+             -- a marker followed by two blanks is just an empty item:+             guard $ null (blockBlanks ndata) ||+                     not (null children)+             pos <- getPosition+             gobbleSpaces (listItemIndent lidata) <|> 0 <$ lookAhead blankLine+             return $! (pos, node)+     , blockConstructor    = fmap mconcat . renderChildren+     , blockFinalize       = \(Node cdata children) parent -> do+          let lidata = fromDyn (blockData cdata)+                                 (ListItemData (BulletList '*') False+                                   0 False False)+          let blanks = removeConsecutive $ sort $+                         concat $ blockBlanks cdata :+                                  map (blockBlanks . rootLabel)+                                  (filter ((== "List") . blockType .+                                   blockSpec . rootLabel) children)+          curline <- sourceLine <$> getPosition+          let blanksAtEnd = case blanks of+                                   (l:_) -> l >= curline - 1+                                   _     -> False+          let blanksInside = case length blanks of+                                n | n > 1     -> True+                                  | n == 1    -> not blanksAtEnd+                                  | otherwise -> False+          let lidata' = toDyn $ lidata{ listItemBlanksInside = blanksInside+                                      , listItemBlanksAtEnd  = blanksAtEnd }+          defaultFinalizer (Node cdata{ blockData = lidata' } children)+                           parent+     }++removeConsecutive :: [Int] -> [Int]+removeConsecutive (x:y:zs)+  | x == y + 1 = removeConsecutive (y:zs)+removeConsecutive xs = xs++itemStart :: Monad m+          => BlockParser m il bl (SourcePos, ListItemData)+itemStart = do+  beforecol <- sourceColumn <$> getPosition+  gobbleUpToSpaces 3+  pos <- getPosition+  ty <- bulletListMarker+  aftercol <- sourceColumn <$> getPosition+  checked <- parseCheckbox+  lookAhead whitespace+  numspaces <- try (gobbleUpToSpaces 4 <* notFollowedBy whitespace)+           <|> gobbleSpaces 1+           <|> 1 <$ lookAhead lineEnd+  return $! (pos, ListItemData{+            listItemType = ty+          , listItemChecked = checked+          , listItemIndent = (aftercol - beforecol) + numspaces+          , listItemBlanksInside = False+          , listItemBlanksAtEnd = False+          })++parseCheckbox :: Monad m => BlockParser m il bl Bool+parseCheckbox = do+  gobbleUpToSpaces 3+  symbol '['+  checked <- (False <$ satisfyTok (hasType Spaces))+         <|> (True  <$ satisfyTok (textIs (\t -> t == "x" || t == "X")))+  symbol ']'+  return checked++class IsBlock il bl => HasTaskList il bl where+  taskList :: ListType -> ListSpacing -> [(Bool, bl)] -> bl++instance Rangeable (Html a) => HasTaskList (Html a) (Html a) where+  taskList lt spacing items =+    addAttribute ("class","task-list")+    $ list lt spacing+    $ map addCheckbox items++addCheckbox :: (Bool, Html a) -> Html a+addCheckbox (checked, x) =+  (addAttribute ("type", "checkbox") $+   addAttribute ("disabled", "") $+   (if checked then addAttribute ("checked","") else id) $+   htmlInline "input" Nothing) <> x++instance (HasTaskList il bl, Semigroup bl, Semigroup il)+        => HasTaskList (WithSourceMap il) (WithSourceMap bl) where+   taskList lt spacing items =+     (do let (checks, xs) = unzip items+         taskList lt spacing . zip checks <$> sequence xs+      ) <* addName "taskList"
+ test/attributes.md view
@@ -0,0 +1,266 @@+Attributes have the following syntax:++    attributes <- '{' whitespace* attribute (whitespace attribute)*+                      whitespace* '}'+    attribute <- id_attribute | class_attribute | kv_attribute+    id_attribute <- '#' letter (alphanum | '-' | '_' | ':' | '.')*+    class_attribute <- '.' letter (alphanum | '-' | '_')*+    kv_attribute <- attrname '=' attrvalue+    attrname <- (asciiletter | '_' | ':')+                (asciialphanum | '_' | '.' | '-' | ':')*+    attrvalue <- unquotedvalue | quotedvalue+    unquotedvalue <- [^"-=<>`:whitespace:]++    quotedvalue <- '"' ([^"] | '\' '"')* '"'++**Attributes that occur at the end of the text of+a Setext or ATX heading (separated by whitespace+from the text) affect the heading element.**++```````````````````````````````` example+# Heading {#ident .class key="value value" key2=value2}+.+<h1 id="ident" class="class" key="value value" key2="value2">Heading</h1>+````````````````````````````````++```````````````````````````````` example+Heading {#ident .class key="value"}+=====+.+<h1 id="ident" class="class" key="value">Heading</h1>+````````````````````````````````++Whitespace is tolerated around the delimiters:++```````````````````````````````` example+# Heading {  #ident  .class key="value" }+.+<h1 id="ident" class="class" key="value">Heading</h1>+````````````````````````````````++Multiple class attributes are combined:++```````````````````````````````` example+# Heading {.class1 .class2 class="class3"}+.+<h1 class="class1 class2 class3">Heading</h1>+````````````````````````````````++Only the last id attribute is used:++```````````````````````````````` example+# Heading {#id1 #id2 id="id3"}+.+<h1 id="id3">Heading</h1>+````````````````````````````````++Heading attributes can be followed by whitespace, but+otherwise must come at the end of the line.++```````````````````````````````` example+# Foo {#bar}   +.+<h1 id="bar">Foo</h1>+````````````````````````````````++Headings should still work without attributes:++```````````````````````````````` example+# ATX++Setext+------+.+<h1>ATX</h1>+<h2>Setext</h2>+````````````````````````````````++**Attributes that occur after the opening fence+in a fenced code block affect the code block element.**++```````````````````````````````` example+``` {#ident .class key="value value" key2=value2} +xyz+```+.+<pre id="ident" class="class" key="value value" key2="value2"><code>xyz+</code></pre>+````````````````````````````````++```````````````````````````````` example+~~~~{#mycode .ruby .number-lines}+xyz+~~~~+.+<pre id="mycode" class="ruby number-lines"><code>xyz+</code></pre>+````````````````````````````````++If any non-space content comes after the attribute spec, the+whole thing is treated as a raw info string.++```````````````````````````````` example+``` {#foo} bar+xyz+```+.+<pre><code class="language-{#foo}">xyz+</code></pre>+````````````````````````````````++Here the attribute spec is at the end, so the+first word provides the info string and the rest is+treated as an attribute.++```````````````````````````````` example+``` bar {#foo}+xyz+```+.+<pre id="foo"><code class="language-bar">xyz+</code></pre>+````````````````````````````````++**Attributes on inline elements must immediately follow the element to+which they belong.**  If they follow a space, then they belong+to the space.++```````````````````````````````` example+`hi`{#ident .class key=value}+.+<p><code id="ident" class="class" key="value">hi</code></p>+````````````````````````````````++```````````````````````````````` example+`hi` {#ident .class key=value}+.+<p><code>hi</code><span id="ident" class="class" key="value"> </span></p>+````````````````````````````````++The attributes can wrap:++```````````````````````````````` example+`hi`{#ident .class+key=value}+.+<p><code id="ident" class="class" key="value">hi</code></p>+````````````````````````````````++**Attributes that occur immediately before a block+element, on a line by themselves, affect that+element.**++```````````````````````````````` example+{.special}+* * * *+.+<hr class="special" />+````````````````````````````````++```````````````````````````````` example+{#foo .special}+bar+.+<p id="foo" class="special">bar</p>+````````````````````````````````++```````````````````````````````` example+{#foo .special}+# Hi+.+<h1 id="foo" class="special">Hi</h1>+````````````````````````````````++When conflicting specifications of the same attribute are given,+the last one takes precedence, except for classes, which are+cumulative.++```````````````````````````````` example+{#id1}+{#id2}+# Heading {#id3}+.+<h1 id="id3">Heading</h1>+````````````````````````````````++```````````````````````````````` example+{#id1}+{#id3}+# Heading+.+<h1 id="id3">Heading</h1>+````````````````````````````````++```````````````````````````````` example+{.class1 k=1}+{.class2 .class3 k=2}+# Heading {.class4}+.+<h1 class="class1 class2 class3 class4" k="2">Heading</h1>+````````````````````````````````+++**Attributes that occur at the end of a reference+link definition affect links that refer to that+definition.**++```````````````````````````````` example+[foo]++[foo]: bar "title" {#ident .centered .big}+.+<p><a id="ident" class="centered big" href="bar" title="title">foo</a></p>+````````````````````````````````++**Attributes that occur immediately after an inline+element affect that element.**++```````````````````````````````` example+[foo](bar){#ident .class key="value value" key2=value2}+.+<p><a id="ident" class="class" key="value value" key2="value2" href="bar">foo</a></p>+````````````````````````````````++```````````````````````````````` example+![foo](bar){#ident .centered .big}+.+<p><img id="ident" class="centered big" src="bar" alt="foo" /></p>+````````````````````````````````++```````````````````````````````` example+[foo]{#ident .centered .big}++[foo]: bar+.+<p><a id="ident" class="centered big" href="bar">foo</a></p>+````````````````````````````````++```````````````````````````````` example+*hi*{.underline}+.+<p><em class="underline">hi</em></p>+````````````````````````````````++**Consecutive attribute specifiers may be used,+either for blocks or for inlines.**++```````````````````````````````` example+*hi*{.underline}{#foo}+.+<p><em class="underline" id="foo">hi</em></p>+````````````````````````````````++```````````````````````````````` example+{.special}+{#foo}+* * * *+.+<hr class="special" id="foo" />+````````````````````````````````++**Entities can be used in attribute values.**++```````````````````````````````` example+# Heading {key="v&#97;lue" }+.+<h1 key="value">Heading</h1>+````````````````````````````````
+ test/auto_identifiers.md view
@@ -0,0 +1,84 @@+## Auto identifiers (extension)++The `auto_identifiers` extension causes identifiers to be+added to headings that lack them.  Identifiers derive their+names from the heading text.  The following recipe is used+(this derives from the practice on GitHub and is slightly+different from legacy pandoc auto identifiers):++- Render the textual content of the heading, without+  any formatting (tags)+- Strip leading and trailing space+- Convert to lowercase+- Convert spaces into hyphens+- Remove all punctuation except `-`, `_`, and punctuation in+  the categories NonSpacingMark, SpacingCombiningMark,+  EnclosingMark, and ConnectorPunctuation.+- Replace emojis with their textual aliases++```````````````````````````````` example+#   Heading  with_two_spaces! +.+<h1 id="heading--with_two_spaces">Heading  with_two_spaces!</h1>+````````````````````````````````++```````````````````````````````` example+Heading  with_two_spaces!+-------------------------+.+<h2 id="heading--with_two_spaces">Heading  with_two_spaces!</h2>+````````````````````````````````++Auto identifiers are not assigned to headings+that have explicit identifiers:++```````````````````````````````` example+# Heading {#foo}+.+<h1 id="foo">Heading</h1>+````````````````````````````````++```````````````````````````````` example+{#foo}+# Heading+.+<h1 id="foo">Heading</h1>+````````````````````````````````++Auto identifiers are not assigned to non-headings:++```````````````````````````````` example+Hi+.+<p>Hi</p>+````````````````````````````````++Numerical suffixes will be added to avoid+duplicate identifiers:++```````````````````````````````` example+# Hi+# Hi+# Hi+.+<h1 id="hi">Hi</h1>+<h1 id="hi-1">Hi</h1>+<h1 id="hi-2">Hi</h1>+````````````````````````````````++Deduplication should work also when auto identifiers+are mixed with explicit identifiers:++```````````````````````````````` example+# Hi+# Hi {#hi}+# Hi++Hi+==+.+<h1 id="hi-1">Hi</h1>+<h1 id="hi">Hi</h1>+<h1 id="hi-2">Hi</h1>+<h1 id="hi-3">Hi</h1>+````````````````````````````````
+ test/auto_identifiers_ascii.md view
@@ -0,0 +1,12 @@+## Auto identifiers ASCII (extension)++The `auto_identifiers_ascii` extension is like+`auto_identifiers` but limits identifiers to ASCII.+Accented Latin characters are converted into the+closest ASCII equivalent.++```````````````````````````````` example+# Heading with &auml;+.+<h1 id="heading-with-a">Heading with &auml;</h1>+````````````````````````````````
+ test/autolinks.md view
@@ -0,0 +1,157 @@+## Autolinks (extension)++GFM enables the `autolink` extension, where autolinks will be recognised in a+greater number of conditions.++[Autolink]s can also be constructed without requiring the use of `<` and to `>`+to delimit them, although they will be recognized under a smaller set of+circumstances.  All such recognized autolinks can only come at the beginning of+a line, after whitespace, or any of the delimiting characters `*`, `_`, `~`,+and `(`.++An [extended www autolink](@) will be recognized when the text `www.` is found+followed by a [valid domain]. A [valid domain](@) consists of alphanumeric+characters, underscores (`_`), hyphens (`-`) and periods (`.`).  There must be+at least one period, and no underscores may be present in the last two segments+of the domain.++The scheme `http` will be inserted automatically:++```````````````````````````````` example+www.commonmark.org+.+<p><a href="http://www.commonmark.org">www.commonmark.org</a></p>+````````````````````````````````++After a [valid domain], zero or more non-space non-`<` characters may follow:++```````````````````````````````` example+Visit www.commonmark.org/help for more information.+.+<p>Visit <a href="http://www.commonmark.org/help">www.commonmark.org/help</a> for more information.</p>+````````````````````````````````++We then apply [extended autolink path validation](@) as follows:++Trailing punctuation (specifically, `?`, `!`, `.`, `,`, `:`, `*`, `_`, and `~`)+will not be considered part of the autolink, though they may be included in the+interior of the link:++```````````````````````````````` example+Visit www.commonmark.org.++Visit www.commonmark.org/a.b.+.+<p>Visit <a href="http://www.commonmark.org">www.commonmark.org</a>.</p>+<p>Visit <a href="http://www.commonmark.org/a.b">www.commonmark.org/a.b</a>.</p>+````````````````````````````````++When an autolink ends in `)`, we scan the entire autolink for the total number+of parentheses.  If there is a greater number of closing parentheses than+opening ones, we don't consider the last character part of the autolink, in+order to facilitate including an autolink inside a parenthesis:++```````````````````````````````` example+www.google.com/search?q=Markup+(business)++(www.google.com/search?q=Markup+(business))+.+<p><a href="http://www.google.com/search?q=Markup+(business)">www.google.com/search?q=Markup+(business)</a></p>+<p>(<a href="http://www.google.com/search?q=Markup+(business)">www.google.com/search?q=Markup+(business)</a>)</p>+````````````````````````````````++This check is only done when the link ends in a closing parentheses `)`, so if+the only parentheses are in the interior of the autolink, no special rules are+applied:++```````````````````````````````` example+www.google.com/search?q=(business))+ok+.+<p><a href="http://www.google.com/search?q=(business))+ok">www.google.com/search?q=(business))+ok</a></p>+````````````````````````````````++If an autolink ends in a semicolon (`;`), we check to see if it appears to+resemble an [entity reference][entity references]; if the preceding text is `&`+followed by one or more alphanumeric characters.  If so, it is excluded from+the autolink:++```````````````````````````````` example+www.google.com/search?q=commonmark&hl=en++www.google.com/search?q=commonmark&hl;+.+<p><a href="http://www.google.com/search?q=commonmark&amp;hl=en">www.google.com/search?q=commonmark&amp;hl=en</a></p>+<p><a href="http://www.google.com/search?q=commonmark">www.google.com/search?q=commonmark</a>&amp;hl;</p>+````````````````````````````````++`<` immediately ends an autolink.++```````````````````````````````` example+www.commonmark.org/he<lp+.+<p><a href="http://www.commonmark.org/he">www.commonmark.org/he</a>&lt;lp</p>+````````````````````````````````++An [extended url autolink](@) will be recognised when one of the schemes+`http://`, `https://`, or `ftp://`, followed by a [valid domain], then zero or+more non-space non-`<` characters according to+[extended autolink path validation]:++```````````````````````````````` example+http://commonmark.org++(Visit https://encrypted.google.com/search?q=Markup+(business))++Anonymous FTP is available at ftp://foo.bar.baz.+.+<p><a href="http://commonmark.org">http://commonmark.org</a></p>+<p>(Visit <a href="https://encrypted.google.com/search?q=Markup+(business)">https://encrypted.google.com/search?q=Markup+(business)</a>)</p>+<p>Anonymous FTP is available at <a href="ftp://foo.bar.baz">ftp://foo.bar.baz</a>.</p>+````````````````````````````````+++An [extended email autolink](@) will be recognised when an email address is+recognised within any text node.  Email addresses are recognised according to+the following rules:++* One ore more characters which are alphanumeric, or `.`, `-`, `_`, or `+`.+* An `@` symbol.+* One or more characters which are alphanumeric, or `.`, `-`, or `_`. At least+  one of the characters here must be a period (`.`).  The last character must+  not be one of `-` or `_`.  If the last character is a period (`.`), it will+  be excluded from the autolink.++The scheme `mailto:` will automatically be added to the generated link:++```````````````````````````````` example+foo@bar.baz+.+<p><a href="mailto:foo@bar.baz">foo@bar.baz</a></p>+````````````````````````````````++`+` can occur before the `@`, but not after.++```````````````````````````````` example+hello@mail+xyz.example isn't valid, but hello+xyz@mail.example is.+.+<p>hello@mail+xyz.example isn't valid, but <a href="mailto:hello+xyz@mail.example">hello+xyz@mail.example</a> is.</p>+````````````````````````````````++`.`, `-`, and `_` can occur on both sides of the `@`, but only `.` may occur at+the end of the email address, in which case it will not be considered part of+the address:++```````````````````````````````` example+a.b-c_d@a.b++a.b-c_d@a.b.++a.b-c_d@a.b-++a.b-c_d@a.b_+.+<p><a href="mailto:a.b-c_d@a.b">a.b-c_d@a.b</a></p>+<p><a href="mailto:a.b-c_d@a.b">a.b-c_d@a.b</a>.</p>+<p>a.b-c_d@a.b-</p>+<p>a.b-c_d@a.b_</p>+````````````````````````````````
+ test/bracketed_spans.md view
@@ -0,0 +1,25 @@+Bracketed spans work like links with attributes, but+without the link destination.++```````````````````````````````` example+[foo]{#ident .class key="value value" key2=value2}+.+<p><span id="ident" class="class" key="value value" key2="value2">foo</span></p>+````````````````````````````````++```````````````````````````````` example+[foo+*bar*]{#ident+.class}+.+<p><span id="ident" class="class">foo+<em>bar</em></span></p>+````````````````````````````````++An attribute is required:++```````````````````````````````` example+[foo]+.+<p>[foo]</p>+````````````````````````````````
+ test/definition_lists.md view
@@ -0,0 +1,283 @@+## Definition lists++The term is given on a line by itself, followed by+one or more definitions. Each definition must begin+with `:` (after 0-2 spaces); subsequent lines must+be indented unless they are lazy paragraph+continuations.++The list is tight if there is no blank line between+the term and the first definition, otherwise loose.++```````````````````````````````` example+apple+:   red fruit++orange+:   orange fruit+.+<dl>+<dt>apple</dt>+<dd>red fruit+</dd>+<dt>orange</dt>+<dd>orange fruit+</dd>+</dl>+````````````````````````````````++Loose:++```````````````````````````````` example+apple++:   red fruit++orange++:   orange fruit+.+<dl>+<dt>apple</dt>+<dd>+<p>red fruit</p>+</dd>+<dt>orange</dt>+<dd>+<p>orange fruit</p>+</dd>+</dl>+````````````````````````````````++Indented marker:++```````````````````````````````` example+apple+  : red fruit++orange+  : orange fruit+.+<dl>+<dt>apple</dt>+<dd>red fruit+</dd>+<dt>orange</dt>+<dd>orange fruit+</dd>+</dl>+````````````````````````````````++```````````````````````````````` example+apple++ : red fruit++orange++ : orange fruit+.+<dl>+<dt>apple</dt>+<dd>+<p>red fruit</p>+</dd>+<dt>orange</dt>+<dd>+<p>orange fruit</p>+</dd>+</dl>+````````````````````````````````++Multiple blocks in a definition:++```````````````````````````````` example+*apple*++:   red fruit++    contains seeds,+    crisp, pleasant to taste++*orange*++:   orange fruit++        { orange code block }++    > orange block quote+.+<dl>+<dt><em>apple</em></dt>+<dd>+<p>red fruit</p>+<p>contains seeds,+crisp, pleasant to taste</p>+</dd>+<dt><em>orange</em></dt>+<dd>+<p>orange fruit</p>+<pre><code>{ orange code block }+</code></pre>+<blockquote>+<p>orange block quote</p>+</blockquote>+</dd>+</dl>+````````````````````````````````++Multiple definitions, tight:++```````````````````````````````` example+apple+:   red fruit+:   computer company++orange+:   orange fruit+:   telecom company+.+<dl>+<dt>apple</dt>+<dd>red fruit+</dd>+<dd>computer company+</dd>+<dt>orange</dt>+<dd>orange fruit+</dd>+<dd>telecom company+</dd>+</dl>+````````````````````````````````++Multiple definitions, loose:++```````````````````````````````` example+apple++:   red fruit++:   computer company++orange++:   orange fruit+:   telecom company+.+<dl>+<dt>apple</dt>+<dd>+<p>red fruit</p>+</dd>+<dd>+<p>computer company</p>+</dd>+<dt>orange</dt>+<dd>+<p>orange fruit</p>+</dd>+<dd>+<p>telecom company</p>+</dd>+</dl>+````````````````````````````````++Lazy line continuations:++```````````````````````````````` example+apple++:   red fruit++:   computer+company++orange++:   orange+fruit+:   telecom company+.+<dl>+<dt>apple</dt>+<dd>+<p>red fruit</p>+</dd>+<dd>+<p>computer+company</p>+</dd>+<dt>orange</dt>+<dd>+<p>orange+fruit</p>+</dd>+<dd>+<p>telecom company</p>+</dd>+</dl>+````````````````````````````````++++`~` may be used as a marker instead of `:`:++```````````````````````````````` example+apple+  ~ red fruit++orange+  ~ orange fruit+.+<dl>+<dt>apple</dt>+<dd>red fruit+</dd>+<dt>orange</dt>+<dd>orange fruit+</dd>+</dl>+````````````````````````````````++Definition terms may span multiple lines:++```````````````````````````````` example+a+b\+c++:   foo+.+<dl>+<dt>a+b<br />+c</dt>+<dd>+<p>foo</p>+</dd>+</dl>+````````````````````````````````++Definition list with preceding paragraph+(<https://github.com/jgm/commonmark-hs/issues/35>):++```````````````````````````````` example+Foo++bar+:   baz++bim+:   bor+.+<p>Foo</p>+<dl>+<dt>bar</dt>+<dd>baz+</dd>+<dt>bim</dt>+<dd>bor+</dd>+</dl>+````````````````````````````````
+ test/emoji.md view
@@ -0,0 +1,19 @@+List of emoji available on GitHub: https://gist.github.com/rxaviers/7360908.++```````````````````````````````` example+:blush:+A:broken_heart:+:smiley_cat:+.+<p><span class="emoji" data-emoji="blush">😊</span>+A<span class="emoji" data-emoji="broken_heart">💔</span>+<span class="emoji" data-emoji="smiley_cat">😺</span></p>+````````````````````````````````++```````````````````````````````` example+:nothing_really:+:broken_heart+.+<p>:nothing_really:+:broken_heart</p>+````````````````````````````````
+ test/fancy_lists.md view
@@ -0,0 +1,223 @@+The `fancy_lists` extension allows various styles of ordered lists:++With period:++```````````````````````````````` example+1. decimal+2. decimal+.+<ol>+<li>decimal</li>+<li>decimal</li>+</ol>+````````````````````````````````++```````````````````````````````` example+A.  upper alpha+B.  upper alpha+.+<ol type="A">+<li>upper alpha</li>+<li>upper alpha</li>+</ol>+````````````````````````````````++```````````````````````````````` example+a. lower alpha+b. lower alpha+.+<ol type="a">+<li>lower alpha</li>+<li>lower alpha</li>+</ol>+````````````````````````````````++```````````````````````````````` example+I.  Upper Roman+II.  Upper Roman+.+<ol type="I">+<li>Upper Roman</li>+<li>Upper Roman</li>+</ol>+````````````````````````````````++```````````````````````````````` example+i. Lower Roman+ii. Lower Roman+.+<ol type="i">+<li>Lower Roman</li>+<li>Lower Roman</li>+</ol>+````````````````````````````````++With one parenthesis:++```````````````````````````````` example+1) decimal+2) decimal+.+<ol>+<li>decimal</li>+<li>decimal</li>+</ol>+````````````````````````````````++```````````````````````````````` example+A)  upper alpha+B)  upper alpha+.+<ol type="A">+<li>upper alpha</li>+<li>upper alpha</li>+</ol>+````````````````````````````````++```````````````````````````````` example+a) lower alpha+b) lower alpha+.+<ol type="a">+<li>lower alpha</li>+<li>lower alpha</li>+</ol>+````````````````````````````````++```````````````````````````````` example+I)  Upper Roman+II)  Upper Roman+.+<ol type="I">+<li>Upper Roman</li>+<li>Upper Roman</li>+</ol>+````````````````````````````````++```````````````````````````````` example+i) Lower Roman+ii) Lower Roman+.+<ol type="i">+<li>Lower Roman</li>+<li>Lower Roman</li>+</ol>+````````````````````````````````++With two parentheses:++```````````````````````````````` example+(1) decimal+(2) decimal+.+<ol>+<li>decimal</li>+<li>decimal</li>+</ol>+````````````````````````````````++```````````````````````````````` example+(A)  upper alpha+(B)  upper alpha+.+<ol type="A">+<li>upper alpha</li>+<li>upper alpha</li>+</ol>+````````````````````````````````++```````````````````````````````` example+(a) lower alpha+(b) lower alpha+.+<ol type="a">+<li>lower alpha</li>+<li>lower alpha</li>+</ol>+````````````````````````````````++```````````````````````````````` example+(I)  Upper Roman+(II)  Upper Roman+.+<ol type="I">+<li>Upper Roman</li>+<li>Upper Roman</li>+</ol>+````````````````````````````````++```````````````````````````````` example+(i) Lower Roman+(ii) Lower Roman+.+<ol type="i">+<li>Lower Roman</li>+<li>Lower Roman</li>+</ol>+````````````````````````````````+++Note that with decimal enumerators and Upper Alpha or Upper+Roman style, we require at least two spaces after the list+marker in order to avoid capturing initials:++```````````````````````````````` example+B.  Russell++B. Russell++I.  J. Good++I. J. Good+.+<ol start="2" type="A">+<li>Russell</li>+</ol>+<p>B. Russell</p>+<ol type="I">+<li>J. Good</li>+</ol>+<p>I. J. Good</p>+````````````````````````````````++A new list starts with any style change:++```````````````````````````````` example+1. one+2) one+.+<ol>+<li>one</li>+</ol>+<ol start="2">+<li>one</li>+</ol>+````````````````````````````````++```````````````````````````````` example+1. one+a. one+.+<ol>+<li>one</li>+</ol>+<ol type="a">+<li>one</li>+</ol>+````````````````````````````````++Variable start numbers should work with all types of lists:++```````````````````````````````` example+b. two++(vi) six+.+<ol start="2" type="a">+<li>two</li>+</ol>+<ol start="6" type="i">+<li>six</li>+</ol>+````````````````````````````````+
+ test/fenced_divs.md view
@@ -0,0 +1,121 @@+Fenced divs are containers for sequences of blocks, to+which an attribute can be attached.++A fenced div begins with an opening fence: a line with three or+more consecutive `:` characters, followed by an attribute+specifier, followed by optional whitespace and the end of the+line.++It ends with a closing fence: a line beginning with at+least as many consecutive `:` characters as in the opening+fence, followed by optional whitespace and the end of the line.++If the end of the input (or enclosing block) is encountered+before a closing fence, the fenced div is implicitly closed.++```````````````````````````````` example+::: {#bar .foo}+Hi++> A block quote.+:::+.+<div id="bar" class="foo">+<p>Hi</p>+<blockquote>+<p>A block quote.</p>+</blockquote>+</div>+````````````````````````````````++```````````````````````````````` example+:::: {#bar .foo} +Hi++> A block quote.+::::::::::::::::::::::::: +.+<div id="bar" class="foo">+<p>Hi</p>+<blockquote>+<p>A block quote.</p>+</blockquote>+</div>+````````````````````````````````++Fenced divs may be nested.++```````````````````````````````` example+::: {#bar .foo}+Hi+::: {.baz}+> A block quote.+:::+:::+.+<div id="bar" class="foo">+<p>Hi</p>+<div class="baz">+<blockquote>+<p>A block quote.</p>+</blockquote>+</div>+</div>+````````````````````````````````++A fenced div can interrupt a paragraph, without+an intervening blank line.++```````````````````````````````` example+Paragraph text+::: {#bar .foo}+Hi+:::+.+<p>Paragraph text</p>+<div id="bar" class="foo">+<p>Hi</p>+</div>+````````````````````````````````++A fenced div *must* have attributes.++```````````````````````````````` example+:::+Hi+:::+.+<p>:::+Hi+:::</p>+````````````````````````````````++The closing fence must be at leats as long as the opening+fence.++```````````````````````````````` example+::::: {.foo}+Hi+:::+::::::+.+<div class="foo">+<p>Hi+:::</p>+</div>+````````````````````````````````++If the end of the input (or enclosing block) is encountered+before a closing fence, the fenced div is implicitly closed.++```````````````````````````````` example+> ::: {.foo}+> Hi+.+<blockquote>+<div class="foo">+<p>Hi</p>+</div>+</blockquote>+````````````````````````````````+
+ test/footnotes.md view
@@ -0,0 +1,90 @@+## Footnotes++TODO: proper spec.+This test is based on the one from gfm.++```````````````````````````````` example+This is some text![^1]. Other text.[^footnote].++Here's a thing[^other-note].++And another thing[^codeblock-note].++This doesn't have a referent[^nope].+++[^1]: Some *bolded* footnote definition.++[^footnote]:+    > Blockquotes can be in a footnote.++        as well as code blocks++    or, naturally, simple paragraphs.++[^other-note]:       no code block here (spaces are stripped away)++[^codeblock-note]:+        this is now a code block (8 spaces indentation)++Hi!++[^unused]: This is unused.+.+<p>This is some text!<sup class="footnote-ref"><a href="#fn-1" id="fnref-1">1</a></sup>. Other text.<sup class="footnote-ref"><a href="#fn-footnote" id="fnref-footnote">2</a></sup>.</p>+<p>Here's a thing<sup class="footnote-ref"><a href="#fn-other-note" id="fnref-other-note">3</a></sup>.</p>+<p>And another thing<sup class="footnote-ref"><a href="#fn-codeblock-note" id="fnref-codeblock-note">4</a></sup>.</p>+<p>This doesn't have a referent[^nope].</p>+<p>Hi!</p>+<section class="footnotes">+<div class="footnote" id="fn-1">+<div class="footnote-number">+<a href="#fnref-1">1</a>+</div>+<div class="footnote-contents">+<p>Some <em>bolded</em> footnote definition.</p>+</div>+</div>+<div class="footnote" id="fn-footnote">+<div class="footnote-number">+<a href="#fnref-footnote">2</a>+</div>+<div class="footnote-contents">+<blockquote>+<p>Blockquotes can be in a footnote.</p>+</blockquote>+<pre><code>as well as code blocks+</code></pre>+<p>or, naturally, simple paragraphs.</p>+</div>+</div>+<div class="footnote" id="fn-other-note">+<div class="footnote-number">+<a href="#fnref-other-note">3</a>+</div>+<div class="footnote-contents">+<pre><code>   no code block here (spaces are stripped away)+</code></pre>+</div>+</div>+<div class="footnote" id="fn-codeblock-note">+<div class="footnote-number">+<a href="#fnref-codeblock-note">4</a>+</div>+<div class="footnote-contents">+<pre><code>this is now a code block (8 spaces indentation)+</code></pre>+</div>+</div>+<div class="footnote" id="fn-unused">+<div class="footnote-number">+<a href="#fnref-unused">5</a>+</div>+<div class="footnote-contents">+<p>This is unused.</p>+</div>+</div>+</section>+````````````````````````````````++
+ test/hard_line_breaks.md view
@@ -0,0 +1,20 @@+# Hard line breaks++This extension causes all newlines to be parsed as hard+line breaks rather than soft breaks.++```````````````````````````````` example+Hello+there+.+<p>Hello<br />+there</p>+````````````````````````````````++```````````````````````````````` example+*Hello +there*+.+<p><em>Hello<br />+there</em></p>+````````````````````````````````
+ test/implicit_heading_references.md view
@@ -0,0 +1,69 @@+## Implicit heading references (extension)++The `implicit_heading_references` causes headings to create+reference links to themselves.  One can use this+with the `auto_identifiers` extension, which should be+put first in the list of extensions, or one can+define identifiers for the headings manually by+putting an attribute block before the heading.++```````````````````````````````` example+# Heading++See the [Heading] above.+.+<h1 id="heading">Heading</h1>+<p>See the <a href="#heading">Heading</a> above.</p>+````````````````````````````````++```````````````````````````````` example+{#foo}+# Heading++See the [Heading] above.+.+<h1 id="foo">Heading</h1>+<p>See the <a href="#foo">Heading</a> above.</p>+````````````````````````````````++Explicitly defined references take precedence:++```````````````````````````````` example+# Heading++See the [Heading] above.++[Heading]: foo+.+<h1 id="heading">Heading</h1>+<p>See the <a href="foo">Heading</a> above.</p>+````````````````````````````````++When there are two headings with the same text,+the first takes precedence:++```````````````````````````````` example+# Heading++# Heading++See the [Heading] above.+.+<h1 id="heading">Heading</h1>+<h1 id="heading-1">Heading</h1>+<p>See the <a href="#heading">Heading</a> above.</p>+````````````````````````````````++Empty headings don't create implicit references:++```````````````````````````````` example+#++##   ++See [] and [   ].+.+<h1 id=""></h1>+<h2 id="-1"></h2>+<p>See [] and [   ].</p>+````````````````````````````````
+ test/math.md view
@@ -0,0 +1,55 @@+# TeX Math++Inline math goes between `$` characters, and display math+goes between `$$`:++```````````````````````````````` example+Let $x$ and $y$ be integers such that+$$x=y + 2$$+.+<p>Let <span class="math inline">\(x\)</span> and <span class="math inline">\(y\)</span> be integers such that+<span class="math display">\[x=y + 2\]</span></p>+````````````````````````````````++In inline math, the opening `$` must not be followed by+a whitespace, and the closing `$` must not be+preceeded by whitespace.++```````````````````````````````` example+This is not math: 2000$.+And neither is this $ 4 $.+.+<p>This is not math: 2000$.+And neither is this $ 4 $.</p>+````````````````````````````````++Display math delimiters can be surrounded by whitespace:++```````````````````````````````` example+This is display math:+$$+e=mc^2+$$+.+<p>This is display math:+<span class="math display">\[+e=mc^2+\]</span></p>+````````````````````````````````++To avoid treating currency signs as math delimiters,+one may occasionally have to backslash-escape them:++```````````````````````````````` example+The cost is between \$10 and 30$.+.+<p>The cost is between $10 and 30$.</p>+````````````````````````````````++Everthing inside the math construction is treated+as math, and not given its normal commonmark meaning.+```````````````````````````````` example+$b<a>c$+.+<p><span class="math inline">\(b&lt;a&gt;c\)</span></p>+````````````````````````````````
+ test/pipe_tables.md view
@@ -0,0 +1,266 @@+## Tables (extension)++GFM enables the `table` extension, where an additional leaf block type is+available.++A [table](@) is an arrangement of data with rows and columns, consisting of a+single header row, a [delimiter row] separating the header from the data, and+zero or more data rows.++Each row consists of cells containing arbitrary text, in which [inlines] are+parsed, separated by pipes (`|`).  A leading and trailing pipe is also+recommended for clarity of reading, and if there's otherwise parsing ambiguity.+Spaces between pipes and cell content are trimmed.  Block-level elements cannot+be inserted in a table.++The [delimiter row](@) consists of cells whose only content are hyphens (`-`),+and optionally, a leading or trailing colon (`:`), or both, to indicate left,+right, or center alignment respectively.++```````````````````````````````` example+| foo | bar |+| --- | --- |+| baz | bim |+.+<table>+<thead>+<tr>+<th>foo</th>+<th>bar</th>+</tr>+</thead>+<tbody>+<tr>+<td>baz</td>+<td>bim</td>+</tr>+</tbody>+</table>+````````````````````````````````++Cells in one column don't need to match length, though it's easier to read if+they are. Likewise, use of leading and trailing pipes may be inconsistent:++```````````````````````````````` example+| abc | defghi |+:-: | -----------:+bar | baz+.+<table>+<thead>+<tr>+<th style="text-align: center;">abc</th>+<th style="text-align: right;">defghi</th>+</tr>+</thead>+<tbody>+<tr>+<td style="text-align: center;">bar</td>+<td style="text-align: right;">baz</td>+</tr>+</tbody>+</table>+````````````````````````````````++Include a pipe in a cell's content by escaping it, including inside other+inline spans:++```````````````````````````````` example+| f\|oo  |+| ------ |+| b `\|` az |+| b **\|** im |+.+<table>+<thead>+<tr>+<th>f|oo</th>+</tr>+</thead>+<tbody>+<tr>+<td>b <code>|</code> az</td>+</tr>+<tr>+<td>b <strong>|</strong> im</td>+</tr>+</tbody>+</table>+````````````````````````````````++The table is broken at the first line not containing an+unescaped `|`:++```````````````````````````````` example+| abc | def |+| --- | --- |+| bar | baz |+> bar+.+<table>+<thead>+<tr>+<th>abc</th>+<th>def</th>+</tr>+</thead>+<tbody>+<tr>+<td>bar</td>+<td>baz</td>+</tr>+</tbody>+</table>+<blockquote>+<p>bar</p>+</blockquote>+````````````````````````````````++```````````````````````````````` example+| abc | def |+| --- | --- |+| bar | baz |++bar+.+<table>+<thead>+<tr>+<th>abc</th>+<th>def</th>+</tr>+</thead>+<tbody>+<tr>+<td>bar</td>+<td>baz</td>+</tr>+</tbody>+</table>+<p>bar</p>+````````````````````````````````++```````````````````````````````` example+| abc | def |+| --- | --- |+| bar | baz |+bar+.+<table>+<thead>+<tr>+<th>abc</th>+<th>def</th>+</tr>+</thead>+<tbody>+<tr>+<td>bar</td>+<td>baz</td>+</tr>+</tbody>+</table>+<p>bar</p>+````````````````````````````````++The header row must match the [delimiter row] in the number of cells.  If not,+a table will not be recognized:++```````````````````````````````` example+| abc | def |+| --- |+| bar |+.+<p>| abc | def |+| --- |+| bar |</p>+````````````````````````````````++The remainder of the table's rows may vary in the number of cells.  If there+are a number of cells fewer than the number of cells in the header row, empty+cells are inserted.  If there are greater, the excess is ignored:++```````````````````````````````` example+| abc | def |+| --- | --- |+| bar |+| bar | baz | boo |+.+<table>+<thead>+<tr>+<th>abc</th>+<th>def</th>+</tr>+</thead>+<tbody>+<tr>+<td>bar</td>+<td></td>+</tr>+<tr>+<td>bar</td>+<td>baz</td>+</tr>+</tbody>+</table>+````````````````````````````````++If there are no rows in the body, no `<tbody>` is generated in HTML output:++```````````````````````````````` example+| abc | def |+| --- | --- |+.+<table>+<thead>+<tr>+<th>abc</th>+<th>def</th>+</tr>+</thead>+</table>+````````````````````````````````++Here are some non-tables:++```````````````````````````````` example+| Not enough table | to be considered table |++| Not enough table | to be considered table |+| Not enough table | to be considered table |++| ---- | --- |+.+<p>| Not enough table | to be considered table |</p>+<p>| Not enough table | to be considered table |+| Not enough table | to be considered table |</p>+<p>| ---- | --- |</p>+````````````````````````````````++A table may be indented up to three spaces:++```````````````````````````````` example+   a | b | c+   - | - | -+.+<table>+<thead>+<tr>+<th>a</th>+<th>b</th>+<th>c</th>+</tr>+</thead>+</table>+````````````````````````````````++```````````````````````````````` example+    a | b | c+    - | - | -+.+<pre><code>a | b | c+- | - | -+</code></pre>+````````````````````````````````+
+ test/raw_attribute.md view
@@ -0,0 +1,41 @@+A "raw attribute" is an `=` plus an alphanumeric string, in+braces, like++    {=html5}++If attached to an inline code span, it causes the span to be+interpreted as raw inline content with the specified format.+If attached to a fenced code block, it causes the block to+be interpreted as raw block content with the specified format.+A raw attribute may not occur together with other attributes.+++```````````````````````````````` example+``` {=html}+<b>foo</b>+```+.+<b>foo</b>+````````````````````````````````++```````````````````````````````` example+`<b>foo</b>`{=html}+.+<p><b>foo</b></p>+````````````````````````````````++You can't mix regular and raw attributes:++```````````````````````````````` example+``` {=html #id}+<b>foo</b>+.+<pre><code class="language-{=html">&lt;b&gt;foo&lt;/b&gt;+</code></pre>+````````````````````````````````++```````````````````````````````` example+`<b>foo</b>`{=html .bar}+.+<p><code>&lt;b&gt;foo&lt;/b&gt;</code>{=html .bar}</p>+````````````````````````````````
+ test/smart.md view
@@ -0,0 +1,185 @@+## Smart punctuation++Open quotes are matched with closed quotes.+The same method is used for matching openers and closers+as is used in emphasis parsing:++```````````````````````````````` example+"Hello," said the spider.+"'Shelob' is my name."+.+<p>“Hello,” said the spider.+“‘Shelob’ is my name.”</p>+````````````````````````````````++```````````````````````````````` example+'A', 'B', and 'C' are letters.+.+<p>‘A’, ‘B’, and ‘C’ are letters.</p>+````````````````````````````````++```````````````````````````````` example+'Oak,' 'elm,' and 'beech' are names of trees.+So is 'pine.'+.+<p>‘Oak,’ ‘elm,’ and ‘beech’ are names of trees.+So is ‘pine.’</p>+````````````````````````````````++```````````````````````````````` example+'He said, "I want to go."'+.+<p>‘He said, “I want to go.”’</p>+````````````````````````````````++A single quote that isn't an open quote matched+with a close quote will be treated as an+apostrophe:++```````````````````````````````` example+Were you alive in the 70's?+.+<p>Were you alive in the 70’s?</p>+````````````````````````````````++```````````````````````````````` example+Here is some quoted '`code`' and a "[quoted link](url)".+.+<p>Here is some quoted ‘<code>code</code>’ and a “<a href="url">quoted link</a>”.</p>+````````````````````````````````++Here the first `'` is treated as an apostrophe, not+an open quote, because the final single quote is matched+by the single quote before `jolly`:++```````````````````````````````` example+'tis the season to be 'jolly'+.+<p>’tis the season to be ‘jolly’</p>+````````````````````````````````++Multiple apostrophes should not be marked as open/closing quotes.++```````````````````````````````` example+'We'll use Jane's boat and John's truck,' Jenna said.+.+<p>‘We’ll use Jane’s boat and John’s truck,’ Jenna said.</p>+````````````````````````````````++An unmatched double quote will be interpreted as a+left double quote, to facilitate this style:++```````````````````````````````` example+"A paragraph with no closing quote.++"Second paragraph by same speaker, in fiction."+.+<p>“A paragraph with no closing quote.</p>+<p>“Second paragraph by same speaker, in fiction.”</p>+````````````````````````````````++A quote following a `]` or `)` character cannot+be an open quote:++```````````````````````````````` example+[a]'s b'+.+<p>[a]’s b’</p>+````````````````````````````````++Quotes that are escaped come out as literal straight+quotes:++```````````````````````````````` example+\"This is not smart.\"+This isn\'t either.+5\'8\"+.+<p>&quot;This is not smart.&quot;+This isn't either.+5'8&quot;</p>+````````````````````````````````++Doubled quotes are treated as nested:++```````````````````````````````` example+''hi''+.+<p>‘‘hi’’</p>+````````````````````````````````++Two hyphens form an en-dash, three an em-dash.++```````````````````````````````` example+Some dashes:  em---em+en--en+em --- em+en -- en+2--3+.+<p>Some dashes:  em—em+en–en+em — em+en – en+2–3</p>+````````````````````````````````++A sequence of more than three hyphens is+parsed as a sequence of em and/or en dashes,+with no hyphens. If possible, a homogeneous+sequence of dashes is used (so, 10 hyphens+= 5 en dashes, and 9 hyphens = 3 em dashes).+When a heterogeneous sequence must be used,+the em dashes come first, followed by the en+dashes, and as few en dashes as possible are+used (so, 7 hyphens = 2 em dashes an 1 en+dash).++```````````````````````````````` example+one-+two--+three---+four----+five-----+six------+seven-------+eight--------+nine---------+thirteen-------------.+.+<p>one-+two–+three—+four––+five—–+six——+seven—––+eight––––+nine———+thirteen———––.</p>+````````````````````````````````++Hyphens can be escaped:++```````````````````````````````` example+Escaped hyphens: \-- \-\-\-.+.+<p>Escaped hyphens: -- ---.</p>+````````````````````````````````++Three periods form an ellipsis:++```````````````````````````````` example+Ellipses...and...and....+.+<p>Ellipses…and…and….</p>+````````````````````````````````++Periods can be escaped if ellipsis-formation+is not wanted:++```````````````````````````````` example+No ellipses\.\.\.+.+<p>No ellipses...</p>+````````````````````````````````
+ test/strikethrough.md view
@@ -0,0 +1,50 @@+## Strikethrough++Basic strikethrough is between two tildes:++```````````````````````````````` example+~~This is *stricken out*~~+.+<p><del>This is <em>stricken out</em></del></p>+````````````````````````````````++One tilde does nothing:++```````````````````````````````` example+~This is nothing~+.+<p>~This is nothing~</p>+````````````````````````````````++Backslash escapes:++```````````````````````````````` example+~~This is \~\~stricken~~+.+<p><del>This is ~~stricken</del></p>+````````````````````````````````++Intraword strikeout:++```````````````````````````````` example+This~~is~~stricken+.+<p>This<del>is</del>stricken</p>+````````````````````````````````++```````````````````````````````` example+~~This~~is~~stricken~~+.+<p><del>This</del>is<del>stricken</del></p>+````````````````````````````````++Punctuation is ignored for purposes of determining+flankingness:++```````````````````````````````` example+Here I strike out an exclamation point~~!~~.+.+<p>Here I strike out an exclamation point<del>!</del>.</p>+````````````````````````````````++
+ test/subscript.md view
@@ -0,0 +1,49 @@+## Subscript++Basic subscript is between `~`s:++```````````````````````````````` example+E=mc~2~.+.+<p>E=mc<sub>2</sub>.</p>+````````````````````````````````++Backslash escapes:++```````````````````````````````` example+E=mc\~2\~.+.+<p>E=mc~2~.</p>+````````````````````````````````++Spaces and formatting are allowed:++```````````````````````````````` example+E=mc~2 or *3*~.+.+<p>E=mc<sub>2 or <em>3</em></sub>.</p>+````````````````````````````````++Punctuation is ignored for purposes of determining+flankingness:++```````````````````````````````` example+E=mc~!~.+.+<p>E=mc<sub>!</sub>.</p>+````````````````````````````````++Subscript can't begin or end with a space:++```````````````````````````````` example+E=mc~ 2~.++E=mc~2 ~.++~ ~+.+<p>E=mc~ 2~.</p>+<p>E=mc~2 ~.</p>+<p>~ ~</p>+````````````````````````````````+
+ test/superscript.md view
@@ -0,0 +1,48 @@+## Superscript++Basic superscript is between `^`s:++```````````````````````````````` example+E=mc^2^.+.+<p>E=mc<sup>2</sup>.</p>+````````````````````````````````++Backslash escapes:++```````````````````````````````` example+E=mc\^2\^.+.+<p>E=mc^2^.</p>+````````````````````````````````++Spaces and formatting are allowed:++```````````````````````````````` example+E=mc^2 or *3*^.+.+<p>E=mc<sup>2 or <em>3</em></sup>.</p>+````````````````````````````````++Punctuation is ignored for purposes of determining+flankingness:++```````````````````````````````` example+E=mc^!^.+.+<p>E=mc<sup>!</sup>.</p>+````````````````````````````````++Superscript can't begin or end with a space:++```````````````````````````````` example+E=mc^ 2^.++E=mc^2 ^.++^ ^+.+<p>E=mc^ 2^.</p>+<p>E=mc^2 ^.</p>+<p>^ ^</p>+````````````````````````````````
+ test/test-commonmark-extensions.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++import           Commonmark+import           Commonmark.Extensions+import           Control.Monad         (when)+import           Data.Functor.Identity+import           Data.List             (groupBy)+import           Data.Text             (Text)+import qualified Data.Text             as T+import qualified Data.Text.IO          as T+import           System.IO             (hSetEncoding, utf8, openFile,+                                        IOMode(..))+import qualified Data.Text.Lazy        as TL+import           Test.Tasty+import           Test.Tasty.HUnit+import           Text.Parsec+import           Text.Parsec.Pos+#if !MIN_VERSION_base(4,11,0)+import           Data.Semigroup+#endif++readTextFile :: FilePath -> IO Text+readTextFile fp = do+  h <- openFile fp ReadMode+  hSetEncoding h utf8+  T.hGetContents h++main :: IO ()+main = do+  tests <- mapM (uncurry getSpecTestTree)+             [ ("test/smart.md", smartPunctuationSpec)+             , ("test/hard_line_breaks.md", hardLineBreaksSpec)+             , ("test/strikethrough.md", strikethroughSpec)+             , ("test/superscript.md", superscriptSpec)+             , ("test/subscript.md", subscriptSpec)+             , ("test/pipe_tables.md", pipeTableSpec)+             , ("test/footnotes.md", footnoteSpec)+             , ("test/math.md", mathSpec)+             , ("test/emoji.md", emojiSpec)+             , ("test/autolinks.md", autolinkSpec)+             , ("test/definition_lists.md", definitionListSpec)+             , ("test/fancy_lists.md", fancyListSpec)+             , ("test/task_lists.md", taskListSpec)+             , ("test/attributes.md", attributesSpec)+             , ("test/raw_attribute.md", rawAttributeSpec)+             , ("test/bracketed_spans.md", bracketedSpanSpec)+             , ("test/fenced_divs.md", fencedDivSpec)+             , ("test/auto_identifiers.md", autoIdentifiersSpec <> attributesSpec)+             , ("test/implicit_heading_references.md",+                 autoIdentifiersSpec <> attributesSpec <> implicitHeadingReferencesSpec)+             ]+  defaultMain $ testGroup "Tests" tests++getSpecTestTree :: FilePath+                -> SyntaxSpec Identity (Html ()) (Html ())+                -> IO TestTree+getSpecTestTree fp syntaxspec = do+  spectests <- getSpecTests fp+  let spectestgroups = groupBy (\t1 t2 -> section t1 == section t2)+                          spectests+  let spectestsecs = [(section (head xs), xs) | xs <- spectestgroups]+  let parser = runIdentity . parseCommonmarkWith+                   (syntaxspec <> defaultSyntaxSpec)+  return $ testGroup fp $+    map (\(secname, tests) ->+           testGroup (T.unpack secname) $+             map (toSpecTest parser) tests)+        spectestsecs++getSpecTests :: FilePath -> IO [SpecTest]+getSpecTests fp = do+  speclines <- zip [1..] . T.lines . T.replace "→" "\t"+                <$> readTextFile fp+  return $ either (error . show) id $ runParser+             (many (try (skipMany normalLine *> parseSpecTest))+                <* skipMany normalLine <* eof) ("",1) fp+                speclines++data SpecTest = SpecTest+     { section    :: Text+     , example    :: Int+     , markdown   :: Text+     , end_line   :: Int+     , start_line :: Int+     , html       :: Text }+  deriving (Show)++toSpecTest :: ([Tok] -> Either ParseError (Html ()))+           -> SpecTest -> TestTree+toSpecTest parser st =+  testCase name (actual @?= expected)+    where name = T.unpack (section st) ++ " example " ++ show (example st) +++                 " (" ++ show (start_line st) ++ "-" +++                 show (end_line st) ++ ")"+          expected = normalizeHtml $ html st+          actual = normalizeHtml .  TL.toStrict . renderHtml .+                   fromRight mempty $+                     (parser (tokenize "" (markdown st))+                      :: Either ParseError (Html ()))++normalizeHtml :: Text -> Text+normalizeHtml = T.replace "\n</li>" "</li>" .+                T.replace "<li>\n" "<li>"++fromRight :: b -> Either a b ->  b+fromRight fallback (Left _) = fallback+fromRight _ (Right x)       = x++--- parser for spec test cases++satisfyLine :: (Text -> Bool)+            -> Parsec [(Int, Text)] (Text, Int) Text+satisfyLine f = token showTok posFromTok testTok+  where+     showTok (_,t)       = T.unpack t+     posFromTok (pos,_)  = newPos "" pos 1+     testTok (_,t)       = if f t then Just t else Nothing++parseSpecTest :: Parsec [(Int, Text)] (Text, Int) SpecTest+parseSpecTest = do+  startpos <- getPosition+  () <$ satisfyLine (== "```````````````````````````````` example")+  markdownTxt <- T.unlines <$> manyTill (satisfyLine (const True))+                                 (satisfyLine (=="."))+  htmlTxt <- T.unlines <$> manyTill (satisfyLine (const True))+              (satisfyLine (== "````````````````````````````````"))+  endline <- (\x -> x - 1) . sourceLine <$> getPosition+  (sectionName, exampleNumber) <- getState+  putState (sectionName, exampleNumber + 1)+  return SpecTest{+       section = sectionName+     , example = exampleNumber+     , markdown = markdownTxt+     , end_line = endline+     , start_line = sourceLine startpos+     , html = htmlTxt+   }++normalLine :: Parsec [(Int, Text)] (Text, Int) ()+normalLine = do+  t <- satisfyLine (/= "```````````````````````````````` example")+  when ("#" `T.isPrefixOf` t) $ updateState $ \(_secname, exampnum) ->+           (T.strip $ T.dropWhile (=='#') t, exampnum)++---