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 +30/−0
- README.md +47/−0
- benchmark/benchmark.hs +37/−0
- changelog.md +3/−0
- commonmark-extensions.cabal +117/−0
- src/Commonmark/Extensions.hs +76/−0
- src/Commonmark/Extensions/Attributes.hs +288/−0
- src/Commonmark/Extensions/AutoIdentifiers.hs +470/−0
- src/Commonmark/Extensions/Autolink.hs +97/−0
- src/Commonmark/Extensions/DefinitionList.hs +193/−0
- src/Commonmark/Extensions/Emoji.hs +49/−0
- src/Commonmark/Extensions/FancyList.hs +129/−0
- src/Commonmark/Extensions/Footnote.hs +175/−0
- src/Commonmark/Extensions/HardLineBreaks.hs +20/−0
- src/Commonmark/Extensions/ImplicitHeadingReferences.hs +56/−0
- src/Commonmark/Extensions/Math.hs +64/−0
- src/Commonmark/Extensions/PipeTable.hs +210/−0
- src/Commonmark/Extensions/Smart.hs +52/−0
- src/Commonmark/Extensions/Strikethrough.hs +29/−0
- src/Commonmark/Extensions/Subscript.hs +29/−0
- src/Commonmark/Extensions/Superscript.hs +29/−0
- src/Commonmark/Extensions/TaskList.hs +235/−0
- test/attributes.md +266/−0
- test/auto_identifiers.md +84/−0
- test/auto_identifiers_ascii.md +12/−0
- test/autolinks.md +157/−0
- test/bracketed_spans.md +25/−0
- test/definition_lists.md +283/−0
- test/emoji.md +19/−0
- test/fancy_lists.md +223/−0
- test/fenced_divs.md +121/−0
- test/footnotes.md +90/−0
- test/hard_line_breaks.md +20/−0
- test/implicit_heading_references.md +69/−0
- test/math.md +55/−0
- test/pipe_tables.md +266/−0
- test/raw_attribute.md +41/−0
- test/smart.md +185/−0
- test/strikethrough.md +50/−0
- test/subscript.md +49/−0
- test/superscript.md +48/−0
- test/test-commonmark-extensions.hs +147/−0
+ 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+{#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="value" }+.+<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 ä+.+<h1 id="heading-with-a">Heading with ä</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&hl=en">www.google.com/search?q=commonmark&hl=en</a></p>+<p><a href="http://www.google.com/search?q=commonmark">www.google.com/search?q=commonmark</a>&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><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<a>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"><b>foo</b>+</code></pre>+````````````````````````````````++```````````````````````````````` example+`<b>foo</b>`{=html .bar}+.+<p><code><b>foo</b></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>"This is not smart."+This isn't either.+5'8"</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)++---