commonmark-extensions-0.2.3.6/ 0000755 0000000 0000000 00000000000 07346545000 014411 5 ustar 00 0000000 0000000 commonmark-extensions-0.2.3.6/LICENSE 0000644 0000000 0000000 00000002771 07346545000 015425 0 ustar 00 0000000 0000000 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. commonmark-extensions-0.2.3.6/README.md 0000644 0000000 0000000 00000004346 07346545000 015677 0 ustar 00 0000000 0000000 # commonmark-extensions [](http://hackage.haskell.org/package/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) - [`wikilinks_title_before_pipe`] and [`wikilinks_title_after_pipe`] (wikilink syntax) [`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 [`wikilinks_title_before_pipe`]: test/wikilinks_title_before_pipe.md [`wikilinks_title_after_pipe`]: test/wikilinks_title_before_pipe.md commonmark-extensions-0.2.3.6/benchmark/ 0000755 0000000 0000000 00000000000 07346545000 016343 5 ustar 00 0000000 0000000 commonmark-extensions-0.2.3.6/benchmark/benchmark.hs 0000644 0000000 0000000 00000002162 07346545000 020632 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} import Test.Tasty.Bench 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 main :: IO () main = do sample <- T.replicate 10 <$> TIO.readFile "benchmark/sample.md" defaultMain [ 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 commonmark-extensions-0.2.3.6/changelog.md 0000644 0000000 0000000 00000007070 07346545000 016666 0 ustar 00 0000000 0000000 # Changelog for commonmark-extensions ## 0.2.3.6 * Fix pipe table parser so that `|`s don't interfere with other block structures (Michael Howell, #111, fixing #52 and #95). This parser is structured as a system that parses the *second* line first, then parses the first line. That is, if it detects a delimiter row as the second line of a paragraph, it converts the paragraph into a table. This seems counterintuitive, but it works better than trying to convert a table into a paragraph, since it might need to be something else. * Improve parsing of inline math (#110). ## 0.2.3.5 - Resolve entities inside wikilinks (#105, Michał Kukieła). ## 0.2.3.4 - Require whitespace after definition list marker (#104). Otherwise we can inadvertently clobber strikeout or subscript. ## 0.2.3.3 - Fix definition_lists extension (#96). We were not properly consuming indentation in definitions, which caused problems when the definitions themselves contained lists. ## 0.2.3.2 - Update lower version bounds for commonmark (#93, David Thrane Christiansen). ## 0.2.3.1 - `math` extension: don't fail when display math contains embedded inline math. See jgm/pandoc#7942. - Make math parsing more sophisticated. Count embeddings inside `{..}`, since math can contain e.g. `\text{...}` which itself contains math delimiters. - Small improvement in pipe table parsing. The old parser failed on some edge cases with extra whitespace after pipes (which we should just ignore). - `fancy_list` extension: improve list type ambiguity resolution (#89). ## 0.2.3 - Allow bare word attribute in fenced_divs (#84). This follows a similar change in pandoc (jgm/pandoc#7242). ## 0.2.2.1 - Fix commonmark-extensions to build with GHC 9.2 (#81, Joseph C. Sible). Currently `--allow-newer` is needed. ## 0.2.2 - Add footnote to gfmExtensions. Note that this also requires additional type constraints on gfmExtensions [API change]. ## 0.2.1.2 - Fix bug with absolute paths in rebase_relative_paths extension on Windows. ## 0.2.1.1 - Fix bug in wikilinks extensions. ## 0.2.1 - Add `rebase_relative_paths` extension. New exported module Commonmark.Extensions.RebaseRelativePaths [API change]. - Add `wikilinks_title_before_pipe` and `wikilinks_title_after_pipe` extensions (#69). New exported module Commonmark.Extensions.Wikilinks [API change]. ## 0.2.0.4 - Add a test for autolinks (#66). - Require commonmark 0.1.1.2 (otherwise autolinks don't work properly). ## 0.2.0.3 - Add some new test examples to the autolinks extension spec (#65). - Allow interior `~` characters in autolinks (#65). ## 0.2.0.2 - Remove unnecessary Typeable constraint on `TaskList` and `gfmExtensions` (#58). - Fix bug in `footnote` extension: multiple blocks in a block container (e.g. block quote or list) inside a footnote were being rendered in reverse order (#63, Harald Gliebe). ## 0.2.0.1 - Added a missing test file to extra-source-files (#55). ## 0.2.0.0 - Add HasQuoted class in Smart extension, with singleQuoted and doubleQuoted methods. This gives more fleibility in supporting smart quotes, and allows us to use pandoc's Quoted elements. - Add advice to haddocks for pipeTableSpec (#52). If a line could be a candidate pipe table heading, but the following line of separators is not encountered, the line is treated as a paragraph, even if it has indications of other block-level formatting. Putting the pipeTableSpec AFTER parsers for lists, headings, etc. causes the latter to take priority. ## 0.1.0.0 - Initial release commonmark-extensions-0.2.3.6/commonmark-extensions.cabal 0000644 0000000 0000000 00000006640 07346545000 021743 0 ustar 00 0000000 0000000 name: commonmark-extensions version: 0.2.3.6 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-2021 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/wikilinks_title_before_pipe.md test/wikilinks_title_after_pipe.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/rebase_relative_paths.md test/strikethrough.md test/superscript.md test/subscript.md test/hard_line_breaks.md test/task_lists.md source-repository head type: git location: https://github.com/jgm/commonmark-hs library hs-source-dirs: src build-depends: base >= 4.9 && <5 , text , parsec , containers , transformers , filepath , network-uri , commonmark >= 0.2.2 && < 0.3 -- for extensions: , emojis >= 0.1 && < 0.2 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 Commonmark.Extensions.RebaseRelativePaths Commonmark.Extensions.Wikilinks ghc-options: -Wall -fno-warn-unused-do-bind -funbox-small-strict-fields if impl(ghc >= 8.10) ghc-options: -Wunused-packages 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 if impl(ghc >= 8.10) ghc-options: -Wunused-packages ghc-options: -threaded -rtsopts -with-rtsopts=-K40K build-depends: base >= 4.9 && <5 , commonmark >= 0.2 && < 0.3 , commonmark-extensions , text , tasty , tasty-hunit , 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.2 && < 0.3 , commonmark-extensions , base >= 4.9 && < 5 , text , tasty-bench if impl(ghc >= 8.10) ghc-options: -Wunused-packages ghc-options: -threaded -rtsopts -with-rtsopts=-K10K default-language: Haskell2010 commonmark-extensions-0.2.3.6/src/Commonmark/ 0000755 0000000 0000000 00000000000 07346545000 017303 5 ustar 00 0000000 0000000 commonmark-extensions-0.2.3.6/src/Commonmark/Extensions.hs 0000644 0000000 0000000 00000005550 07346545000 022003 0 ustar 00 0000000 0000000 {- | 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 , module Commonmark.Extensions.Wikilinks , module Commonmark.Extensions.RebaseRelativePaths , 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.Extensions.Wikilinks import Commonmark.Extensions.RebaseRelativePaths import Commonmark import Data.Typeable -- | Standard extensions for GitHub-flavored Markdown. gfmExtensions :: (Monad m, Typeable m, Typeable il, Typeable bl, IsBlock il bl, IsInline il, HasFootnote il bl, HasEmoji il, HasStrikethrough il, HasPipeTable il bl, HasTaskList il bl, ToPlainText il) => SyntaxSpec m il bl gfmExtensions = emojiSpec <> strikethroughSpec <> pipeTableSpec <> autolinkSpec <> autoIdentifiersSpec <> taskListSpec <> footnoteSpec commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/ 0000755 0000000 0000000 00000000000 07346545000 021442 5 ustar 00 0000000 0000000 commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/Attributes.hs 0000644 0000000 0000000 00000024200 07346545000 024122 0 ustar 00 0000000 0000000 {-# 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 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 <|> (do bareWordToks <- many1 (satisfyWord (const True) <|> anySymbol) return [("class", untokenize bareWordToks)]) 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') commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/AutoIdentifiers.hs 0000644 0000000 0000000 00000022061 07346545000 025075 0 ustar 00 0000000 0000000 {-# 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 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','>') ] commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/Autolink.hs 0000644 0000000 0000000 00000005642 07346545000 023573 0 ustar 00 0000000 0000000 {-# 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) 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:" commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/DefinitionList.hs 0000644 0000000 0000000 00000020716 07346545000 024730 0 ustar 00 0000000 0000000 {-# LANGUAGE TupleSections #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# 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) 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 initcol <- sourceColumn <$> getPosition gobbleUpToSpaces 3 pos <- getPosition symbol ':' <|> symbol '~' lookAhead whitespace try (gobbleUpToSpaces 4 <* notFollowedBy whitespace) <|> gobbleSpaces 1 <|> 1 <$ lookAhead lineEnd finalcol <- sourceColumn <$> getPosition (Node bdata children : rest) <- nodeStack <$> getState let definitionIndent :: Int definitionIndent = finalcol - initcol let defnode = Node (defBlockData definitionListDefinitionBlockSpec){ blockStartPos = [pos], blockData = toDyn definitionIndent } [] 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@(Node ndata _cs) -> do pos <- getPosition let definitionIndent = fromDyn (blockData ndata) 0 gobbleSpaces definitionIndent <|> 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 commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/Emoji.hs 0000644 0000000 0000000 00000002473 07346545000 023047 0 ustar 00 0000000 0000000 {-# 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 commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/FancyList.hs 0000644 0000000 0000000 00000013436 07346545000 023701 0 ustar 00 0000000 0000000 {-# 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 mbListType <- getParentListType -- first try to parse an item like the parent let pInSeries = case mbListType of Just (OrderedList _ e d) -> try (pMarker e d) _ -> mzero pInSeries <|> do initialParen <- option False $ True <$ symbol '(' (start, enumtype) <- pDecimal <|> (case mbListType of Nothing -> pLowerRomanOne <|> pUpperRomanOne _ -> mzero) <|> pLowerAlpha <|> pUpperAlpha <|> pLowerRoman <|> pUpperRoman delimtype <- if initialParen then TwoParens <$ symbol ')' else Period <$ symbol '.' <|> OneParen <$ symbol ')' when (delimtype == Period && (enumtype == UpperRoman || enumtype == UpperAlpha)) $ checkSpace return $! OrderedList start enumtype delimtype where checkSpace = do Tok tt _ t <- lookAhead anyTok guard $ case tt of Spaces -> T.length t > 1 LineEnd -> True _ -> False pMarker e d = do when (d == TwoParens) $ () <$ symbol '(' (start, enumtype) <- case e of Decimal -> pDecimal LowerRoman -> pLowerRoman UpperRoman -> pUpperRoman LowerAlpha -> pLowerAlpha UpperAlpha -> pUpperAlpha delimtype <- case d of TwoParens -> TwoParens <$ symbol ')' OneParen -> OneParen <$ symbol ')' Period -> Period <$ symbol '.' when (delimtype == Period && (enumtype == UpperRoman || enumtype == UpperAlpha)) $ checkSpace return $! OrderedList start enumtype delimtype 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) pLowerRomanOne = (1, LowerRoman) <$ satisfyWord (== "i") pUpperRomanOne = (1, UpperRoman) <$ satisfyWord (== "I") 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 commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/Footnote.hs 0000644 0000000 0000000 00000014504 07346545000 023577 0 ustar 00 0000000 0000000 {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# 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) 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) (subForest (reverseSubforests 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" commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/HardLineBreaks.hs 0000644 0000000 0000000 00000001115 07346545000 024612 0 ustar 00 0000000 0000000 {-# 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) commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/ImplicitHeadingReferences.hs 0000644 0000000 0000000 00000003411 07346545000 027031 0 ustar 00 0000000 0000000 {-# 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 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 , linkPos = Nothing } (referenceMap s) } | otherwise = return () commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/Math.hs 0000644 0000000 0000000 00000004202 07346545000 022665 0 ustar 00 0000000 0000000 {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} module Commonmark.Extensions.Math ( HasMath(..) , mathSpec ) where import Control.Monad (mzero) 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) import qualified Data.Text as T 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 = try $ do symbol '$' display <- (True <$ symbol '$') <|> (False <$ notFollowedBy whitespace) contents <- try $ untokenize <$> pDollarsMath 0 let isWs c = c == ' ' || c == '\t' || c == '\r' || c == '\n' if display then displayMath contents <$ symbol '$' else if T.null contents || isWs (T.last contents) -- don't allow math to end with SPACE + $ then mzero else return $ inlineMath contents -- Int is number of embedded groupings pDollarsMath :: Monad m => Int -> InlineParser m [Tok] pDollarsMath n = do tk@(Tok toktype _ _) <- anyTok case toktype of Symbol '$' | n == 0 -> return [] Symbol '\\' -> do tk' <- anyTok (tk :) . (tk' :) <$> pDollarsMath n Symbol '{' -> (tk :) <$> pDollarsMath (n+1) Symbol '}' | n > 0 -> (tk :) <$> pDollarsMath (n-1) | otherwise -> mzero _ -> (tk :) <$> pDollarsMath n commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/PipeTable.hs 0000644 0000000 0000000 00000020562 07346545000 023650 0 ustar 00 0000000 0000000 {-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} module Commonmark.Extensions.PipeTable ( HasPipeTable(..) , ColAlignment(..) , pipeTableSpec ) where import Control.Monad (guard, void, mzero) import Control.Monad.Trans.Class (lift) 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 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 '|') skipMany $ satisfyTok (hasType Spaces) 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 '|') skipMany $ satisfyTok (hasType Spaces) 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 -- | Syntax for pipe tables. Note that this should generally be -- placed AFTER the syntax spec for lists, headings, and other block-level -- constructs, to avoid bad results when non-table lines contain pipe -- characters: use @defaultSyntaxSpec <> pipeTableSpec@ rather -- than @pipeTableSpec <> defaultSyntaxSpec@. pipeTableSpec :: (Monad m, IsBlock il bl, IsInline il, HasPipeTable il bl) => SyntaxSpec m il bl pipeTableSpec = mempty { syntaxBlockSpecs = [pipeTableBlockSpec] } -- This parser is structured as a system that parses the *second* line first, -- then parses the first line. That is, if it detects a delimiter row as the -- second line of a paragraph, it converts the paragraph into a table. This seems -- counterintuitive, but it works better than trying to convert a table into -- a paragraph, since it might need to be something else. -- -- See GH-52 and GH-95 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 () (cur:rest) <- nodeStack <$> getState guard $ blockParagraph (bspec cur) nonindentSpaces pos <- getPosition aligns <- pDividers skipWhile (hasType Spaces) lookAhead (eof <|> void lineEnd) st <- getState let headerLine = case blockLines $ rootLabel cur of [onlyLine] -> onlyLine _ -> [] cellsR <- lift $ runParserT pCells st "" headerLine case cellsR of Right cells -> if length cells /= length aligns then mzero -- parse fail: not a table else do updateState $ \st' -> st'{ nodeStack = rest } let tabledata = PipeTableData { pipeTableAlignments = aligns , pipeTableHeaders = cells , pipeTableRows = [] } addNodeToStack $ Node (defBlockData pipeTableBlockSpec){ blockStartPos = blockStartPos (rootLabel cur) ++ [pos] , blockData = toDyn tabledata , blockAttributes = blockAttributes (rootLabel cur) } [] _ -> mzero -- parse fail: not a table 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 cells <- pCells let tabledata' = tabledata{ pipeTableRows = cells : pipeTableRows tabledata } return $! (pos, Node ndata{ blockData = toDyn tabledata' } 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 (Node ndata children) parent } commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/RebaseRelativePaths.hs 0000644 0000000 0000000 00000014061 07346545000 025675 0 ustar 00 0000000 0000000 {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} module Commonmark.Extensions.RebaseRelativePaths ( rebaseRelativePathsSpec ) where import Commonmark.Types import Commonmark.Syntax import Commonmark.Inlines import Data.Text (Text) import qualified Data.Text as T import Data.Maybe (fromMaybe) import Text.Parsec (getPosition) import System.FilePath import qualified System.FilePath.Windows as Windows import qualified System.FilePath.Posix as Posix import Network.URI (URI (uriScheme), parseURI) import qualified Data.Set as Set rebaseRelativePathsSpec :: forall m bl il . (Monad m , IsInline il , IsBlock il bl) => SyntaxSpec m il bl rebaseRelativePathsSpec = defaultSyntaxSpec { syntaxBracketedSpecs = [rebasedImageSpec, rebasedLinkSpec] } where rebasedImageSpec :: BracketedSpec il rebasedImageSpec =BracketedSpec { bracketedName = "Image" , bracketedNests = True , bracketedPrefix = Just '!' , bracketedSuffixEnd = Just ')' , bracketedSuffix = newImageSuffix } rebasedLinkSpec :: BracketedSpec il rebasedLinkSpec = BracketedSpec { bracketedName = "Link" , bracketedNests = False -- links don't nest inside links , bracketedPrefix = Nothing , bracketedSuffixEnd = Just ')' , bracketedSuffix = newLinkSuffix } newImageSuffix rm key = do pos <- getPosition LinkInfo target title attrs mbpos <- pLink rm key let pos' = fromMaybe pos mbpos return $! addAttributes attrs . image (rebasePath pos' target) title newLinkSuffix rm key = do pos <- getPosition LinkInfo target title attrs mbpos <- pLink rm key let pos' = fromMaybe pos mbpos return $! addAttributes attrs . link (rebasePath pos' target) title -- | Rebase a relative path, by adding the (relative) directory -- of the containing source position. Absolute links and URLs -- are untouched. rebasePath :: SourcePos -> Text -> Text rebasePath pos path = do let fp = sourceName pos isFragment = T.take 1 path == "#" path' = T.unpack path isAbsolutePath = Posix.isAbsolute path' || Windows.isAbsolute path' in if T.null path || isFragment || isAbsolutePath || isURI path then path else case takeDirectory fp of "" -> path "." -> path d -> T.pack d <> "/" <> path -- | Schemes from http://www.iana.org/assignments/uri-schemes.html plus -- the unofficial schemes doi, javascript, isbn, pmid. schemes :: Set.Set T.Text schemes = Set.fromList -- Official IANA schemes [ "aaa", "aaas", "about", "acap", "acct", "acr", "adiumxtra", "afp", "afs" , "aim", "appdata", "apt", "attachment", "aw", "barion", "beshare", "bitcoin" , "blob", "bolo", "browserext", "callto", "cap", "chrome", "chrome-extension" , "cid", "coap", "coaps", "com-eventbrite-attendee", "content", "crid", "cvs" , "data", "dav", "dict", "dis", "dlna-playcontainer", "dlna-playsingle" , "dns", "dntp", "dtn", "dvb", "ed2k", "example", "facetime", "fax", "feed" , "feedready", "file", "filesystem", "finger", "fish", "ftp", "geo", "gg" , "git", "gizmoproject", "go", "gopher", "graph", "gtalk", "h323", "ham" , "hcp", "http", "https", "hxxp", "hxxps", "hydrazone", "iax", "icap", "icon" , "im", "imap", "info", "iotdisco", "ipn", "ipp", "ipps", "irc", "irc6" , "ircs", "iris", "iris.beep", "iris.lwz", "iris.xpc", "iris.xpcs" , "isostore", "itms", "jabber", "jar", "jms", "keyparc", "lastfm", "ldap" , "ldaps", "lvlt", "magnet", "mailserver", "mailto", "maps", "market" , "message", "mid", "mms", "modem", "mongodb", "moz", "ms-access" , "ms-browser-extension", "ms-drive-to", "ms-enrollment", "ms-excel" , "ms-gamebarservices", "ms-getoffice", "ms-help", "ms-infopath" , "ms-media-stream-id", "ms-officeapp", "ms-project", "ms-powerpoint" , "ms-publisher", "ms-search-repair", "ms-secondary-screen-controller" , "ms-secondary-screen-setup", "ms-settings", "ms-settings-airplanemode" , "ms-settings-bluetooth", "ms-settings-camera", "ms-settings-cellular" , "ms-settings-cloudstorage", "ms-settings-connectabledevices" , "ms-settings-displays-topology", "ms-settings-emailandaccounts" , "ms-settings-language", "ms-settings-location", "ms-settings-lock" , "ms-settings-nfctransactions", "ms-settings-notifications" , "ms-settings-power", "ms-settings-privacy", "ms-settings-proximity" , "ms-settings-screenrotation", "ms-settings-wifi", "ms-settings-workplace" , "ms-spd", "ms-sttoverlay", "ms-transit-to", "ms-virtualtouchpad" , "ms-visio", "ms-walk-to", "ms-whiteboard", "ms-whiteboard-cmd", "ms-word" , "msnim", "msrp", "msrps", "mtqp", "mumble", "mupdate", "mvn", "news", "nfs" , "ni", "nih", "nntp", "notes", "ocf", "oid", "onenote", "onenote-cmd" , "opaquelocktoken", "pack", "palm", "paparazzi", "pkcs11", "platform", "pop" , "pres", "prospero", "proxy", "pwid", "psyc", "qb", "query", "redis" , "rediss", "reload", "res", "resource", "rmi", "rsync", "rtmfp", "rtmp" , "rtsp", "rtsps", "rtspu", "secondlife", "service", "session", "sftp", "sgn" , "shttp", "sieve", "sip", "sips", "skype", "smb", "sms", "smtp", "snews" , "snmp", "soap.beep", "soap.beeps", "soldat", "spotify", "ssh", "steam" , "stun", "stuns", "submit", "svn", "tag", "teamspeak", "tel", "teliaeid" , "telnet", "tftp", "things", "thismessage", "tip", "tn3270", "tool", "turn" , "turns", "tv", "udp", "unreal", "urn", "ut2004", "v-event", "vemmi" , "ventrilo", "videotex", "vnc", "view-source", "wais", "webcal", "wpid" , "ws", "wss", "wtai", "wyciwyg", "xcon", "xcon-userid", "xfire" , "xmlrpc.beep", "xmlrpc.beeps", "xmpp", "xri", "ymsgr", "z39.50", "z39.50r" , "z39.50s" -- Unofficial schemes , "doi", "isbn", "javascript", "pmid" ] -- | Check if the string is a valid URL with a IANA or frequently used but -- unofficial scheme (see @schemes@). isURI :: T.Text -> Bool isURI = maybe False hasKnownScheme . parseURI . T.unpack where hasKnownScheme = (`Set.member` schemes) . T.toLower . T.filter (/= ':') . T.pack . uriScheme commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/Smart.hs 0000644 0000000 0000000 00000004062 07346545000 023066 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} module Commonmark.Extensions.Smart ( HasQuoted(..) , smartPunctuationSpec ) where import Commonmark.Types import Commonmark.Syntax import Commonmark.Inlines import Commonmark.Html import Commonmark.SourceMap import Commonmark.TokParsers (symbol) import Text.Parsec class IsInline il => HasQuoted il where singleQuoted :: il -> il doubleQuoted :: il -> il instance Rangeable (Html a) => HasQuoted (Html a) where singleQuoted x = htmlText "‘" <> x <> htmlText "’" doubleQuoted x = htmlText "“" <> x <> htmlText "”" instance (HasQuoted i, Monoid i, Semigroup i) => HasQuoted (WithSourceMap i) where singleQuoted x = (singleQuoted <$> x) <* addName "singleQuoted" doubleQuoted x = (doubleQuoted <$> x) <* addName "doubleQuoted" smartPunctuationSpec :: (Monad m, IsBlock il bl, IsInline il, HasQuoted il) => SyntaxSpec m il bl smartPunctuationSpec = mempty { syntaxFormattingSpecs = [singleQuotedSpec, doubleQuotedSpec] , syntaxInlineParsers = [pEllipses, pDash] } singleQuotedSpec :: (IsInline il, HasQuoted il) => FormattingSpec il singleQuotedSpec = FormattingSpec '\'' False False (Just singleQuoted) Nothing '’' doubleQuotedSpec :: (IsInline il, HasQuoted il) => FormattingSpec il doubleQuotedSpec = FormattingSpec '"' False False (Just doubleQuoted) Nothing '“' 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 "–") commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/Strikethrough.hs 0000644 0000000 0000000 00000001530 07346545000 024637 0 ustar 00 0000000 0000000 {-# 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" commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/Subscript.hs 0000644 0000000 0000000 00000001430 07346545000 023752 0 ustar 00 0000000 0000000 {-# 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" commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/Superscript.hs 0000644 0000000 0000000 00000001470 07346545000 024323 0 ustar 00 0000000 0000000 {-# 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" commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/TaskList.hs 0000644 0000000 0000000 00000023042 07346545000 023535 0 ustar 00 0000000 0000000 {-# LANGUAGE TupleSections #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# 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) import Control.Monad (when, guard) import Data.List (sort) import Data.Dynamic import Data.Tree import Text.Parsec taskListSpec :: (Monad m, IsBlock il bl, IsInline il, 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" commonmark-extensions-0.2.3.6/src/Commonmark/Extensions/Wikilinks.hs 0000644 0000000 0000000 00000003666 07346545000 023755 0 ustar 00 0000000 0000000 {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Commonmark.Extensions.Wikilinks ( wikilinksSpec , TitlePosition(..) , HasWikilinks(..) ) where import Commonmark.Entity import Commonmark.Types import Commonmark.Tokens import Commonmark.Syntax import Commonmark.SourceMap import Commonmark.TokParsers import Commonmark.Html import Text.Parsec import Data.Text (Text, strip) class HasWikilinks il where wikilink :: Text -> il -> il instance Rangeable (Html a) => HasWikilinks (Html a) where wikilink url il = link url "wikilink" il instance (HasWikilinks il, Semigroup il, Monoid il) => HasWikilinks (WithSourceMap il) where wikilink url il = (wikilink url <$> il) <* addName "wikilink" -- | Determines whether @[[foo|bar]]@ is a link to page @bar@ -- with title (description) @foo@ ('TitleBeforePipe'), as in -- GitHub wikis, or a link to page @foo@ with title @bar@ -- ('TitleAfterPipe'), as in Obsidian and Foam. data TitlePosition = TitleBeforePipe | TitleAfterPipe deriving (Show, Eq) wikilinksSpec :: (Monad m, IsInline il, HasWikilinks il) => TitlePosition -> SyntaxSpec m il bl wikilinksSpec titlepos = mempty { syntaxInlineParsers = [ pWikilink ] } where pWikilink = try $ do symbol '[' symbol '[' notFollowedBy (symbol '[') toks <- many (satisfyTok (not . hasType (Symbol ']'))) let isPipe (Tok (Symbol '|') _ _) = True isPipe _ = False let (title, url) = case break isPipe toks of (xs, []) -> (unEntity xs, unEntity xs) (xs, _:ys) -> case titlepos of TitleBeforePipe -> (unEntity xs, unEntity ys) TitleAfterPipe -> (unEntity ys, unEntity xs) symbol ']' symbol ']' return $ wikilink (strip url) (str (strip title)) commonmark-extensions-0.2.3.6/test/ 0000755 0000000 0000000 00000000000 07346545000 015370 5 ustar 00 0000000 0000000 commonmark-extensions-0.2.3.6/test/attributes.md 0000644 0000000 0000000 00000015027 07346545000 020105 0 ustar 00 0000000 0000000 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} .
xyz
````````````````````````````````
```````````````````````````````` example
~~~~{#mycode .ruby .number-lines}
xyz
~~~~
.
xyz
````````````````````````````````
If any non-space content comes after the attribute spec, the
whole thing is treated as a raw info string.
```````````````````````````````` example
``` {#foo} bar
xyz
```
.
xyz
````````````````````````````````
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
```
.
xyz
````````````````````````````````
**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}
.
hi
hi
hi
bar
```````````````````````````````` ```````````````````````````````` example {#foo .special} # Hi .hi
```````````````````````````````` **Consecutive attribute specifiers may be used, either for blocks or for inlines.** ```````````````````````````````` example *hi*{.underline}{#foo} .hi
```````````````````````````````` ```````````````````````````````` example {.special} {#foo} * * * * .Hi
```````````````````````````````` Numerical suffixes will be added to avoid duplicate identifiers: ```````````````````````````````` example # Hi # Hi # Hi .Visit www.commonmark.org/help for more information.
```````````````````````````````` 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. Visit www.commonmark.org/~jm/foo/bar.pdf. .Visit www.commonmark.org.
Visit www.commonmark.org/a.b.
Visit www.commonmark.org/~jm/foo/bar.pdf.
```````````````````````````````` 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)) .www.google.com/search?q=Markup+(business)
(www.google.com/search?q=Markup+(business))
```````````````````````````````` 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 .www.google.com/search?q=(business))+ok
```````````````````````````````` 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; .www.google.com/search?q=commonmark&hl=en
www.google.com/search?q=commonmark&hl;
```````````````````````````````` `<` immediately ends an autolink. ```````````````````````````````` example www.commonmark.org/he(Visit https://encrypted.google.com/search?q=Markup+(business))
Anonymous FTP is available at ftp://foo.bar.baz.
```````````````````````````````` 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 . ```````````````````````````````` `+` can occur before the `@`, but not after. ```````````````````````````````` example hello@mail+xyz.example isn't valid, but hello+xyz@mail.example is. .hello@mail+xyz.example isn't valid, but hello+xyz@mail.example is.
```````````````````````````````` `.`, `-`, 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_ .a.b-c_d@a.b-
a.b-c_d@a.b_
```````````````````````````````` The autolinks extension should not interfere with regular links (#65). ```````````````````````````````` example [a link](http://www.google.com/)stuff? .a linkstuff?
```````````````````````````````` commonmark-extensions-0.2.3.6/test/bracketed_spans.md 0000644 0000000 0000000 00000001117 07346545000 021042 0 ustar 00 0000000 0000000 Bracketed spans work like links with attributes, but without the link destination. ```````````````````````````````` example [foo]{#ident .class key="value value" key2=value2} .foo
```````````````````````````````` ```````````````````````````````` example [foo *bar*]{#ident .class} .foo bar
```````````````````````````````` An attribute is required: ```````````````````````````````` example [foo] .[foo]
```````````````````````````````` commonmark-extensions-0.2.3.6/test/definition_lists.md 0000644 0000000 0000000 00000007261 07346545000 021266 0 ustar 00 0000000 0000000 ## 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 .red fruit
orange fruit
red fruit
orange fruit
red fruit
contains seeds, crisp, pleasant to taste
orange fruit
{ orange code block }
orange block quote
Para one
Para two
red fruit
computer company
orange fruit
telecom company
red fruit
computer company
orange fruit
telecom company
foo
Foo
😊 A💔 😺
```````````````````````````````` ```````````````````````````````` example :nothing_really: :broken_heart .:nothing_really: :broken_heart
```````````````````````````````` commonmark-extensions-0.2.3.6/test/fancy_lists.md 0000644 0000000 0000000 00000011055 07346545000 020232 0 ustar 00 0000000 0000000 The `fancy_lists` extension allows various styles of ordered lists: With period: ```````````````````````````````` example 1. decimal 2. decimal .B. Russell
I. J. Good
```````````````````````````````` A new list starts with any style change: ```````````````````````````````` example 1. one 2) one .Hi
A block quote.
Hi
A block quote.
Hi
A block quote.
Paragraph text
Hi
::: Hi :::
```````````````````````````````` The closing fence must be at leats as long as the opening fence. ```````````````````````````````` example ::::: {.foo} Hi ::: :::::: .Hi :::
```````````````````````````````` Instead of a normal attribute specifier in curly braces, a single bare word may be used; it will be treated as a "class" attribute: ```````````````````````````````` example ::: c_d Hi ::: .Hi
Hi
This is some text!1. Other text.2.
Here's a thing3.
And another thing4.
This doesn't have a referent[^nope].
Hi!
Some bolded footnote definition.
Blockquotes can be in a footnote.
as well as code blocks
or, naturally, simple paragraphs.
no code block here (spaces are stripped away)
this is now a code block (8 spaces indentation)
This is unused.
Hello1
Footnote containing a list2
first
second
third
Hello
there
Hello
there
See the Heading above.
```````````````````````````````` ```````````````````````````````` example {#foo} # Heading See the [Heading] above. .See the Heading above.
```````````````````````````````` Explicitly defined references take precedence: ```````````````````````````````` example # Heading See the [Heading] above. [Heading]: foo .See the Heading above.
```````````````````````````````` When there are two headings with the same text, the first takes precedence: ```````````````````````````````` example # Heading # Heading See the [Heading] above. .See the Heading above.
```````````````````````````````` Empty headings don't create implicit references: ```````````````````````````````` example # ## See [] and [ ]. .See [] and [ ].
```````````````````````````````` commonmark-extensions-0.2.3.6/test/math.md 0000644 0000000 0000000 00000004156 07346545000 016651 0 ustar 00 0000000 0000000 # TeX Math Inline math goes between `$` characters, and display math goes between `$$`: ```````````````````````````````` example Let $x$ and $y$ be integers such that $$x=y + 2$$ .Let \(x\) and \(y\) be integers such that \[x=y + 2\]
```````````````````````````````` 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 $. Or this $4 $. .This is not math: 2000$. And neither is this $ 4 $. Or this $4 $.
```````````````````````````````` Display math delimiters can be surrounded by whitespace: ```````````````````````````````` example This is display math: $$ e=mc^2 $$ .This is display math: \[ e=mc^2 \]
```````````````````````````````` Note that math can contain embedded math. In scanning for a closing delimiter, we skip material in balanced curly braces: ```````````````````````````````` example This is display math: $$ \text{Hello $x^2$} $$ And this is inline math: $\text{Hello $x$ there!}$ .This is display math: \[ \text{Hello $x^2$} \] And this is inline math: \(\text{Hello $x$ there!}\)
```````````````````````````````` To avoid treating currency signs as math delimiters, one may occasionally have to backslash-escape them: ```````````````````````````````` example The cost is between \$10 and 30$. .The cost is between $10 and 30$.
```````````````````````````````` Dollar signs must also be backslash-escaped if they occur within math: ```````````````````````````````` example $\text{\$}$ .\(\text{\$}\)
```````````````````````````````` Everthing inside the math construction is treated as math, and not given its normal commonmark meaning. ```````````````````````````````` example $bc$ .\(b<a>c\)
```````````````````````````````` commonmark-extensions-0.2.3.6/test/pipe_tables.md 0000644 0000000 0000000 00000013052 07346545000 020202 0 ustar 00 0000000 0000000 ## 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 | .foo | bar |
---|---|
baz | bim |
abc | defghi |
---|---|
bar | baz |
f|oo |
---|
b | az |
b | im |
abc | def |
---|---|
bar | baz |
```````````````````````````````` ```````````````````````````````` example | abc | def | | --- | --- | | bar | baz | bar .bar
abc | def |
---|---|
bar | baz |
bar
```````````````````````````````` ```````````````````````````````` example | abc | def | | --- | --- | | bar | baz | bar .abc | def |
---|---|
bar | baz |
bar
```````````````````````````````` 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 | .| abc | def | | --- | | bar |
```````````````````````````````` 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 | .abc | def |
---|---|
bar | |
bar | baz |
abc | def |
---|
| Not enough table | to be considered table |
| Not enough table | to be considered table | | Not enough table | to be considered table |
| ---- | --- |
```````````````````````````````` A table may be indented up to three spaces: ```````````````````````````````` example a | b | c - | - | - .a | b | c |
---|
a | b | c
- | - | -
````````````````````````````````
Pipe tables have exactly one header row, and do not interrupt paragraphs.
```````````````````````````````` example
| Too much table | to be considered table |
| Too much table | to be considered table |
|----------------|------------------------|
| Too much table | to be considered table |
.
| Too much table | to be considered table | | Too much table | to be considered table | |----------------|------------------------| | Too much table | to be considered table |
```````````````````````````````` Other block structures, like headers, have higher priority than tables. Tables can be nested in other elements, but don't benefit from laziness. ```````````````````````````````` example # abc | def ------|----- > abc | def > ----|----- > abc | def ----|----- .------|-----
abc def
```````````````````````````````` commonmark-extensions-0.2.3.6/test/raw_attribute.md 0000644 0000000 0000000 00000001751 07346545000 020572 0 ustar 00 0000000 0000000 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} foo ``` . foo ```````````````````````````````` ```````````````````````````````` example `foo`{=html} .abc | def ----|-----
foo
```````````````````````````````` You can't mix regular and raw attributes: ```````````````````````````````` example ``` {=html #id} foo .<b>foo</b>
````````````````````````````````
```````````````````````````````` example
`foo`{=html .bar}
.
<b>foo</b>
{=html .bar}
“Hello,” said the spider. “‘Shelob’ is my name.”
```````````````````````````````` ```````````````````````````````` example 'A', 'B', and 'C' are letters. .‘A’, ‘B’, and ‘C’ are letters.
```````````````````````````````` ```````````````````````````````` example 'Oak,' 'elm,' and 'beech' are names of trees. So is 'pine.' .‘Oak,’ ‘elm,’ and ‘beech’ are names of trees. So is ‘pine.’
```````````````````````````````` ```````````````````````````````` example 'He said, "I want to go."' .‘He said, “I want to go.”’
```````````````````````````````` 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? .Were you alive in the 70’s?
```````````````````````````````` ```````````````````````````````` example Here is some quoted '`code`' and a "[quoted link](url)". .Here is some quoted ‘code
’ and a “quoted link”.
’tis the season to be ‘jolly’
```````````````````````````````` Multiple apostrophes should not be marked as open/closing quotes. ```````````````````````````````` example 'We'll use Jane's boat and John's truck,' Jenna said. .‘We’ll use Jane’s boat and John’s truck,’ Jenna said.
```````````````````````````````` 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." .“A paragraph with no closing quote.
“Second paragraph by same speaker, in fiction.”
```````````````````````````````` A quote following a `]` or `)` character cannot be an open quote: ```````````````````````````````` example [a]'s b' .[a]’s b’
```````````````````````````````` Quotes that are escaped come out as literal straight quotes: ```````````````````````````````` example \"This is not smart.\" This isn\'t either. 5\'8\" ."This is not smart." This isn't either. 5'8"
```````````````````````````````` Doubled quotes are treated as nested: ```````````````````````````````` example ''hi'' .‘‘hi’’
```````````````````````````````` Two hyphens form an en-dash, three an em-dash. ```````````````````````````````` example Some dashes: em---em en--en em --- em en -- en 2--3 .Some dashes: em—em en–en em — em en – en 2–3
```````````````````````````````` 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-------------. .one- two– three— four–– five—– six—— seven—–– eight–––– nine——— thirteen———––.
```````````````````````````````` Hyphens can be escaped: ```````````````````````````````` example Escaped hyphens: \-- \-\-\-. .Escaped hyphens: -- ---.
```````````````````````````````` Three periods form an ellipsis: ```````````````````````````````` example Ellipses...and...and.... .Ellipses…and…and….
```````````````````````````````` Periods can be escaped if ellipsis-formation is not wanted: ```````````````````````````````` example No ellipses\.\.\. .No ellipses...
```````````````````````````````` commonmark-extensions-0.2.3.6/test/strikethrough.md 0000644 0000000 0000000 00000002045 07346545000 020615 0 ustar 00 0000000 0000000 ## Strikethrough Basic strikethrough is between two tildes: ```````````````````````````````` example ~~This is *stricken out*~~ .This is stricken out
~This is nothing~
```````````````````````````````` Backslash escapes: ```````````````````````````````` example ~~This is \~\~stricken~~ .This is ~~stricken
Thisisstricken
Thisisstricken
Here I strike out an exclamation point!.
E=mc2.
```````````````````````````````` Backslash escapes: ```````````````````````````````` example E=mc\~2\~. .E=mc~2~.
```````````````````````````````` Spaces and formatting are allowed: ```````````````````````````````` example E=mc~2 or *3*~. .E=mc2 or 3.
```````````````````````````````` Punctuation is ignored for purposes of determining flankingness: ```````````````````````````````` example E=mc~!~. .E=mc!.
```````````````````````````````` Subscript can't begin or end with a space: ```````````````````````````````` example E=mc~ 2~. E=mc~2 ~. ~ ~ .E=mc~ 2~.
E=mc~2 ~.
~ ~
```````````````````````````````` commonmark-extensions-0.2.3.6/test/superscript.md 0000644 0000000 0000000 00000001471 07346545000 020300 0 ustar 00 0000000 0000000 ## Superscript Basic superscript is between `^`s: ```````````````````````````````` example E=mc^2^. .E=mc2.
```````````````````````````````` Backslash escapes: ```````````````````````````````` example E=mc\^2\^. .E=mc^2^.
```````````````````````````````` Spaces and formatting are allowed: ```````````````````````````````` example E=mc^2 or *3*^. .E=mc2 or 3.
```````````````````````````````` Punctuation is ignored for purposes of determining flankingness: ```````````````````````````````` example E=mc^!^. .E=mc!.
```````````````````````````````` Superscript can't begin or end with a space: ```````````````````````````````` example E=mc^ 2^. E=mc^2 ^. ^ ^ .E=mc^ 2^.
E=mc^2 ^.
^ ^
```````````````````````````````` commonmark-extensions-0.2.3.6/test/task_lists.md 0000644 0000000 0000000 00000001321 07346545000 020067 0 ustar 00 0000000 0000000 ## Task lists As in GitHub-flavored Markdown. ```````````````````````````````` example - [ ] an unchecked task list item - [x] checked item .an unchecked task list item
with two paragraphs
checked item