{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE BangPatterns          #-}
module Commonmark.Blocks
  ( mkBlockParser
  , defaultBlockSpecs
  , BlockStartResult(..)
  , BlockSpec(..)
  , BlockData(..)
  , defBlockData
  , BlockNode
  , BPState(..)
  , BlockParser
  , LinkInfo(..)
  , defaultFinalizer
  , runInlineParser
  , addNodeToStack
  , collapseNodeStack
  , getBlockText
  , removeIndent
  , bspec
  , endOfBlock
  , interruptsParagraph
  , linkReferenceDef
  , renderChildren
  , reverseSubforests
  , getParentListType
  -- * BlockSpecs
  , docSpec
  , indentedCodeSpec
  , fencedCodeSpec
  , blockQuoteSpec
  , atxHeadingSpec
  , setextHeadingSpec
  , thematicBreakSpec
  , listItemSpec
  , bulletListMarker
  , orderedListMarker
  , rawHtmlSpec
  , attributeSpec
  , paraSpec
  , plainSpec
  )
where

import           Commonmark.Tag
import           Commonmark.TokParsers
import           Commonmark.ReferenceMap
import           Commonmark.Inlines        (pEscaped, pLinkDestination,
                                            pLinkLabel, pLinkTitle)
import           Commonmark.Entity         (unEntity)
import           Commonmark.Tokens
import           Commonmark.Types
import           Control.Monad             (foldM, guard, mzero, void, unless,
                                            when)
import           Control.Monad.Trans.Class (lift)
import           Data.Foldable             (foldrM)
import           Unicode.Char              (isAsciiUpper, isDigit)
import           Unicode.Char.General.Compat (isSpace)
import           Data.Dynamic
import           Data.Text                 (Text)
import qualified Data.Map.Strict           as M
import qualified Data.Text                 as T
import qualified Data.Text.Read            as TR
import           Data.Tree
import           Text.Parsec

mkBlockParser
  :: (Monad m, IsBlock il bl)
  => [BlockSpec m il bl] -- ^ Defines block syntax
  -> [BlockParser m il bl bl] -- ^ Parsers to run at end
  -> (ReferenceMap -> [Tok] -> m (Either ParseError il)) -- ^ Inline parser
  -> [BlockParser m il bl Attributes] -- ^ attribute parsers
  -> [Tok] -- ^ Tokenized commonmark input
  -> m (Either ParseError bl)  -- ^ Result or error
mkBlockParser :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl]
-> [BlockParser m il bl bl]
-> (ReferenceMap -> [Tok] -> m (Either ParseError il))
-> [BlockParser m il bl Attributes]
-> [Tok]
-> m (Either ParseError bl)
mkBlockParser [BlockSpec m il bl]
specs [BlockParser m il bl bl]
finalParsers ReferenceMap -> [Tok] -> m (Either ParseError il)
ilParser [BlockParser m il bl Attributes]
attrParsers [Tok]
ts =
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
runParserT (do case [Tok]
ts of
                   (Tok
t:[Tok]
_) -> forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (Tok -> SourcePos
tokPos Tok
t)
                   []    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                 forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl]
-> [BlockParser m il bl bl] -> BlockParser m il bl bl
processLines [BlockSpec m il bl]
specs [BlockParser m il bl bl]
finalParsers)
          BPState{ referenceMap :: ReferenceMap
referenceMap     = ReferenceMap
emptyReferenceMap
                 , inlineParser :: ReferenceMap -> [Tok] -> m (Either ParseError il)
inlineParser     = ReferenceMap -> [Tok] -> m (Either ParseError il)
ilParser
                 , nodeStack :: [BlockNode m il bl]
nodeStack        = [forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, Monoid bl) =>
BlockSpec m il bl
docSpec) []]
                 , blockMatched :: Bool
blockMatched     = Bool
False
                 , maybeLazy :: Bool
maybeLazy        = Bool
True
                 , maybeBlank :: Bool
maybeBlank       = Bool
True
                 , counters :: Map Text Dynamic
counters         = forall k a. Map k a
M.empty
                 , failurePositions :: Map Text SourcePos
failurePositions = forall k a. Map k a
M.empty
                 , attributeParsers :: [BlockParser m il bl Attributes]
attributeParsers = [BlockParser m il bl Attributes]
attrParsers
                 , nextAttributes :: Attributes
nextAttributes   = forall a. Monoid a => a
mempty
                 }
          SourceName
"source" (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts seq :: forall a b. a -> b -> b
`seq` [Tok]
ts)
          -- we evaluate length ts to make sure the list is
          -- fully evaluated; this helps performance.  note that
          -- we can't use deepseq because there's no instance for SourcePos.

processLines :: (Monad m, IsBlock il bl)
             => [BlockSpec m il bl]
             -> [BlockParser m il bl bl] -- ^ Parsers to run at end
             -> BlockParser m il bl bl
processLines :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl]
-> [BlockParser m il bl bl] -> BlockParser m il bl bl
processLines [BlockSpec m il bl]
specs [BlockParser m il bl bl]
finalParsers = {-# SCC processLines #-} do
  let go :: ParsecT [Tok] (BPState m il bl) m ()
go = forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl] -> BlockParser m il bl ()
processLine [BlockSpec m il bl]
specs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] (BPState m il bl) m ()
go) in ParsecT [Tok] (BPState m il bl) m ()
go
  BlockNode m il bl
tree <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) il bl.
[BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
collapseNodeStack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack = [forall a. Tree a -> Tree a
reverseSubforests BlockNode m il bl
tree] }
  bl
endContent <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [BlockParser m il bl bl]
finalParsers
  BlockNode m il bl
tree':[BlockNode m il bl]
_ <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  bl
body <- forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
blockConstructor (forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec (forall a. Tree a -> a
rootLabel BlockNode m il bl
tree')) BlockNode m il bl
tree'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! bl
body forall a. Semigroup a => a -> a -> a
<> bl
endContent

reverseSubforests :: Tree a -> Tree a
reverseSubforests :: forall a. Tree a -> Tree a
reverseSubforests (Node a
x [Tree a]
cs) = forall a. a -> [Tree a] -> Tree a
Node a
x forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Tree a -> Tree a
reverseSubforests forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Tree a]
cs

processLine :: (Monad m, IsBlock il bl)
            => [BlockSpec m il bl] -> BlockParser m il bl ()
processLine :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl] -> BlockParser m il bl ()
processLine [BlockSpec m il bl]
specs = do
  -- check block continuations for each node in stack
  BPState m il bl
st' <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState forall a b. (a -> b) -> a -> b
$  BPState m il bl
st'{ blockMatched :: Bool
blockMatched = Bool
True
                 , maybeLazy :: Bool
maybeLazy = Bool
True
                 , maybeBlank :: Bool
maybeBlank = Bool
True
                 , failurePositions :: Map Text SourcePos
failurePositions = forall k a. Map k a
M.empty }
  ([BlockNode m il bl]
matched, [BlockNode m il bl]
unmatched) <-  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> ([BlockNode m il bl], [BlockNode m il bl])
-> BlockParser m il bl ([BlockNode m il bl], [BlockNode m il bl])
checkContinue ([],[]) (forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack BPState m il bl
st')

  -- if not everything matched, and last unmatched is paragraph,
  -- then we may have a lazy paragraph continuation
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ maybeLazy :: Bool
maybeLazy = forall (m :: * -> *) il bl. BPState m il bl -> Bool
maybeLazy BPState m il bl
st Bool -> Bool -> Bool
&&
     case [BlockNode m il bl]
unmatched of
          BlockNode m il bl
m:[BlockNode m il bl]
_ -> forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
m)
          [BlockNode m il bl]
_   -> Bool
False }

  -- close unmatched blocks
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BlockNode m il bl]
unmatched
    then forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack = [BlockNode m il bl]
matched }
         -- this update is needed or we lose startpos information
    else case [BlockNode m il bl]
matched of
              []   -> forall a. HasCallStack => SourceName -> a
error SourceName
"no blocks matched"
              BlockNode m il bl
m:[BlockNode m il bl]
ms -> do
                BlockNode m il bl
m' <- forall (m :: * -> *) il bl.
[BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
collapseNodeStack ([BlockNode m il bl]
unmatched forall a. [a] -> [a] -> [a]
++ [BlockNode m il bl
m])
                forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack = BlockNode m il bl
m'forall a. a -> [a] -> [a]
:[BlockNode m il bl]
ms }

  Bool
restBlank <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False forall a b. (a -> b) -> a -> b
$ Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine

  {-# SCC block_starts #-} forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
restBlank forall a b. (a -> b) -> a -> b
$
    (do forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (forall (m :: * -> *) il bl.
Monad m =>
[BlockSpec m il bl] -> BlockParser m il bl ()
doBlockStarts [BlockSpec m il bl]
specs)
        forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockParser m il bl BlockStartResult
blockStart forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec)))
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
    (do forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) il bl. BPState m il bl -> Bool
maybeLazy
        -- lazy line
        SourcePos
sp <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
        forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack =
             forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *) il bl.
SourcePos -> BlockNode m il bl -> BlockNode m il bl
addStartPos SourcePos
sp) ([BlockNode m il bl]
unmatched forall a. [a] -> [a] -> [a]
++ [BlockNode m il bl]
matched) })
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
    forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockParser m il bl BlockStartResult
blockStart forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec))
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

  (BlockNode m il bl
cur:[BlockNode m il bl]
rest) <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  -- add line contents
  let curdata :: BlockData m il bl
curdata = forall a. Tree a -> a
rootLabel BlockNode m il bl
cur
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
cur)) forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
spaceTok
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  [Tok]
toks <- {-# SCC restOfLine #-} forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
restOfLine
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{
      nodeStack :: [BlockNode m il bl]
nodeStack =
        BlockNode m il bl
cur{ rootLabel :: BlockData m il bl
rootLabel =
               if forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockContainsLines (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
cur)
                  then BlockData m il bl
curdata{ blockLines :: [[Tok]]
blockLines = [Tok]
toks forall a. a -> [a] -> [a]
: forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
curdata }
                  else
                    if forall (m :: * -> *) il bl. BPState m il bl -> Bool
maybeBlank BPState m il bl
st Bool -> Bool -> Bool
&& Bool
restBlank
                       then BlockData m il bl
curdata{ blockBlanks :: [Int]
blockBlanks = SourcePos -> Int
sourceLine SourcePos
pos forall a. a -> [a] -> [a]
:
                                        forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
curdata }
                       else BlockData m il bl
curdata
           } forall a. a -> [a] -> [a]
: [BlockNode m il bl]
rest
      }
  -- showNodeStack

addStartPos :: SourcePos -> BlockNode m il bl -> BlockNode m il bl
addStartPos :: forall (m :: * -> *) il bl.
SourcePos -> BlockNode m il bl -> BlockNode m il bl
addStartPos SourcePos
sp (Node BlockData m il bl
bd [Tree (BlockData m il bl)]
cs) = forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
bd{ blockStartPos :: [SourcePos]
blockStartPos = SourcePos
sp forall a. a -> [a] -> [a]
: forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos BlockData m il bl
bd } [Tree (BlockData m il bl)]
cs

doBlockStarts :: Monad m => [BlockSpec m il bl] -> BlockParser m il bl ()
doBlockStarts :: forall (m :: * -> *) il bl.
Monad m =>
[BlockSpec m il bl] -> BlockParser m il bl ()
doBlockStarts [BlockSpec m il bl]
specs = do
  BPState m il bl
st' <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  SourcePos
initPos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let failurePosMap :: Map Text SourcePos
failurePosMap = forall (m :: * -> *) il bl. BPState m il bl -> Map Text SourcePos
failurePositions BPState m il bl
st'
  let specs' :: [BlockSpec m il bl]
specs' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\BlockSpec m il bl
spec [BlockSpec m il bl]
sps ->
                        case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
spec) Map Text SourcePos
failurePosMap of
                          Just SourcePos
pos' | SourcePos
initPos forall a. Ord a => a -> a -> Bool
< SourcePos
pos' -> [BlockSpec m il bl]
sps
                          Maybe SourcePos
_ -> BlockSpec m il bl
specforall a. a -> [a] -> [a]
:[BlockSpec m il bl]
sps) [] [BlockSpec m il bl]
specs
  forall {m :: * -> *} {il} {bl}.
Monad m =>
SourcePos
-> [BlockSpec m il bl] -> ParsecT [Tok] (BPState m il bl) m ()
go SourcePos
initPos [BlockSpec m il bl]
specs'
 where
  go :: SourcePos
-> [BlockSpec m il bl] -> ParsecT [Tok] (BPState m il bl) m ()
go SourcePos
_ [] = forall (m :: * -> *) a. MonadPlus m => m a
mzero
  go SourcePos
initPos (BlockSpec m il bl
spec:[BlockSpec m il bl]
otherSpecs) = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
    State [Tok] (BPState m il bl)
pst <- forall (m :: * -> *) s u. Monad m => ParsecT s u m (State s u)
getParserState
    BlockStartResult
res <- forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockParser m il bl BlockStartResult
blockStart BlockSpec m il bl
spec
    case BlockStartResult
res of
      BlockStartResult
BlockStartMatch -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      BlockStartNoMatchBefore SourcePos
pos -> do
        forall (m :: * -> *) s u.
Monad m =>
State s u -> ParsecT s u m (State s u)
setParserState State [Tok] (BPState m il bl)
pst
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SourcePos
pos forall a. Eq a => a -> a -> Bool
== SourcePos
initPos) forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st ->
             BPState m il bl
st{ failurePositions :: Map Text SourcePos
failurePositions =
                  forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
spec)
                  SourcePos
pos (forall (m :: * -> *) il bl. BPState m il bl -> Map Text SourcePos
failurePositions BPState m il bl
st) }
        SourcePos
-> [BlockSpec m il bl] -> ParsecT [Tok] (BPState m il bl) m ()
go SourcePos
initPos [BlockSpec m il bl]
otherSpecs) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> SourcePos
-> [BlockSpec m il bl] -> ParsecT [Tok] (BPState m il bl) m ()
go SourcePos
initPos [BlockSpec m il bl]
otherSpecs

checkContinue :: Monad m
              => BlockNode m il bl
              -> ([BlockNode m il bl],[BlockNode m il bl])
              -> BlockParser m il bl ([BlockNode m il bl],[BlockNode m il bl])
checkContinue :: forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> ([BlockNode m il bl], [BlockNode m il bl])
-> BlockParser m il bl ([BlockNode m il bl], [BlockNode m il bl])
checkContinue BlockNode m il bl
nd ([BlockNode m il bl]
matched, [BlockNode m il bl]
unmatched) = do
  Bool
ismatched <- forall (m :: * -> *) il bl. BPState m il bl -> Bool
blockMatched forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  if Bool
ismatched
     then
       {-# SCC blockContinues #-}
       (do (SourcePos
startpos, Node BlockData m il bl
bdata [BlockNode m il bl]
children) <- forall (m :: * -> *) il bl.
BlockSpec m il bl
-> BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
nd) BlockNode m il bl
nd
           Bool
matched' <- forall (m :: * -> *) il bl. BPState m il bl -> Bool
blockMatched forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
           -- if blockContinue set blockMatched to False, it's
           -- because of characters on the line closing the block,
           -- so it's not to be counted as blank:
           forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
matched' forall a b. (a -> b) -> a -> b
$
             forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ maybeBlank :: Bool
maybeBlank = Bool
False,
                                      maybeLazy :: Bool
maybeLazy = Bool
False }
           let new :: BlockNode m il bl
new = forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
bdata{ blockStartPos :: [SourcePos]
blockStartPos =
                      SourcePos
startpos forall a. a -> [a] -> [a]
: forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos BlockData m il bl
bdata
                      } [BlockNode m il bl]
children
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$!
             if Bool
matched'
                then (BlockNode m il bl
newforall a. a -> [a] -> [a]
:[BlockNode m il bl]
matched, [BlockNode m il bl]
unmatched)
                else ([BlockNode m il bl]
matched, BlockNode m il bl
newforall a. a -> [a] -> [a]
:[BlockNode m il bl]
unmatched))
       forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([BlockNode m il bl]
matched, BlockNode m il bl
ndforall a. a -> [a] -> [a]
:[BlockNode m il bl]
unmatched) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\BPState m il bl
st -> BPState m il bl
st{
                                         blockMatched :: Bool
blockMatched = Bool
False })
     else forall (m :: * -> *) a. Monad m => a -> m a
return ([BlockNode m il bl]
matched, BlockNode m il bl
ndforall a. a -> [a] -> [a]
:[BlockNode m il bl]
unmatched)


{-
--- for debugging
showNodeStack :: Monad m => BlockParser m il bl a
showNodeStack = do
  ns <- nodeStack <$> getState
  trace (unlines ("NODESTACK:" : map showNode ns)) (return $! ())
  return undefined
 where
 showNode (Node bdata children) =
   unlines [ "-----"
           , show (blockSpec bdata)
           , show (blockStartPos bdata)
           , show (length  children) ]
-}

data BlockStartResult =
    BlockStartMatch
  | BlockStartNoMatchBefore !SourcePos
  deriving (Int -> BlockStartResult -> ShowS
[BlockStartResult] -> ShowS
BlockStartResult -> SourceName
forall a.
(Int -> a -> ShowS)
-> (a -> SourceName) -> ([a] -> ShowS) -> Show a
showList :: [BlockStartResult] -> ShowS
$cshowList :: [BlockStartResult] -> ShowS
show :: BlockStartResult -> SourceName
$cshow :: BlockStartResult -> SourceName
showsPrec :: Int -> BlockStartResult -> ShowS
$cshowsPrec :: Int -> BlockStartResult -> ShowS
Show, BlockStartResult -> BlockStartResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockStartResult -> BlockStartResult -> Bool
$c/= :: BlockStartResult -> BlockStartResult -> Bool
== :: BlockStartResult -> BlockStartResult -> Bool
$c== :: BlockStartResult -> BlockStartResult -> Bool
Eq)

-- | Defines a block-level element type.
data BlockSpec m il bl = BlockSpec
     { forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType           :: !Text  -- ^ Descriptive name of block type
     , forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockParser m il bl BlockStartResult
blockStart          :: BlockParser m il bl BlockStartResult
                           -- ^ Parses beginning
                           -- of block.  The parser should verify any
                           -- preconditions, parse the opening of the block,
                           -- and add the new block to the block stack using
                           -- 'addNodeToStack', returning 'BlockStartMatch' on
                           -- success. If the match fails, the parser can
                           -- either fail or return 'BlockStartNoMatchBefore' and a
                           -- 'SourcePos' before which the parser is known
                           -- not to succeed (this will be stored in
                           -- 'failurePositions' for the line, to ensure
                           -- that future matches won't be attempted until
                           -- after that position).
     , forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockSpec m il bl -> Bool
blockCanContain     :: BlockSpec m il bl -> Bool -- ^ Returns True if
                           -- this kind of block can contain the specified
                           -- block type.
     , forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockContainsLines  :: !Bool -- ^ True if this kind of block
                           -- can contain text lines.
     , forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph      :: !Bool -- ^ True if this kind of block
                           -- is paragraph.
     , forall (m :: * -> *) il bl.
BlockSpec m il bl
-> BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       :: BlockNode m il bl
                           -> BlockParser m il bl (SourcePos, BlockNode m il bl)
                           -- ^ Parser that checks to see if the current
                           -- block (the 'BlockNode') can be kept open.
                           -- If it fails, the block will be closed, unless
                           -- we have a lazy paragraph continuation within
                           -- the block.
     , forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    :: BlockNode m il bl -> BlockParser m il bl bl
                           -- ^ Renders the node into its target format,
                           -- possibly after rendering inline content.
     , forall (m :: * -> *) il bl.
BlockSpec m il bl
-> BlockNode m il bl
-> BlockNode m il bl
-> BlockParser m il bl (BlockNode m il bl)
blockFinalize       :: BlockNode m il bl -> BlockNode m il bl
                           -> BlockParser m il bl (BlockNode m il bl)
                           -- ^ Runs when the block is closed, but prior
                           -- to rendering.  The first parameter is the
                           -- child, the second the parent.
     }

instance Show (BlockSpec m il bl) where
  show :: BlockSpec m il bl -> SourceName
show BlockSpec m il bl
bs = SourceName
"<BlockSpec " forall a. [a] -> [a] -> [a]
++ Text -> SourceName
T.unpack (forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
bs) forall a. [a] -> [a] -> [a]
++ SourceName
">"

defaultBlockSpecs :: (Monad m, IsBlock il bl) => [BlockSpec m il bl]
defaultBlockSpecs :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl]
defaultBlockSpecs =
    [ forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
indentedCodeSpec
    , forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
fencedCodeSpec
    , forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
blockQuoteSpec
    , forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
atxHeadingSpec
    , forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
setextHeadingSpec
    , forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
thematicBreakSpec
    , forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockParser m il bl ListType -> BlockSpec m il bl
listItemSpec (forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
bulletListMarker forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
orderedListMarker)
    , forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
rawHtmlSpec
    , forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
attributeSpec
    ]

defaultFinalizer :: Monad m
                 => BlockNode m il bl
                 -> BlockNode m il bl
                 -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer :: forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer !BlockNode m il bl
child !BlockNode m il bl
parent = do
  -- ensure that 'counters' carries information about all
  -- the block identifiers used, so that auto_identifiers works properly.
  case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" (forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
blockAttributes (forall a. Tree a -> a
rootLabel BlockNode m il bl
child)) of
    Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just !Text
ident -> forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st ->
      BPState m il bl
st{ counters :: Map Text Dynamic
counters = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text
"identifier:" forall a. Semigroup a => a -> a -> a
<> Text
ident)
          (forall a. Typeable a => a -> Dynamic
toDyn (Int
0 :: Int)) (forall (m :: * -> *) il bl. BPState m il bl -> Map Text Dynamic
counters BPState m il bl
st) }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! BlockNode m il bl
parent{ subForest :: [BlockNode m il bl]
subForest = BlockNode m il bl
child forall a. a -> [a] -> [a]
: forall a. Tree a -> [Tree a]
subForest BlockNode m il bl
parent }

data BlockData m il bl = BlockData
     { forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec       :: BlockSpec m il bl
     , forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines      :: [[Tok]]  -- in reverse order
     , forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos   :: [SourcePos]  -- in reverse order
     , forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData       :: !Dynamic
     , forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks     :: [Int]  -- non-content blank lines in block
     , forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
blockAttributes :: !Attributes
     }
  deriving Int -> BlockData m il bl -> ShowS
forall a.
(Int -> a -> ShowS)
-> (a -> SourceName) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) il bl. Int -> BlockData m il bl -> ShowS
forall (m :: * -> *) il bl. [BlockData m il bl] -> ShowS
forall (m :: * -> *) il bl. BlockData m il bl -> SourceName
showList :: [BlockData m il bl] -> ShowS
$cshowList :: forall (m :: * -> *) il bl. [BlockData m il bl] -> ShowS
show :: BlockData m il bl -> SourceName
$cshow :: forall (m :: * -> *) il bl. BlockData m il bl -> SourceName
showsPrec :: Int -> BlockData m il bl -> ShowS
$cshowsPrec :: forall (m :: * -> *) il bl. Int -> BlockData m il bl -> ShowS
Show

defBlockData :: BlockSpec m il bl -> BlockData m il bl
defBlockData :: forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
spec = BlockData
    { blockSpec :: BlockSpec m il bl
blockSpec     = BlockSpec m il bl
spec
    , blockLines :: [[Tok]]
blockLines    = []
    , blockStartPos :: [SourcePos]
blockStartPos = []
    , blockData :: Dynamic
blockData     = forall a. Typeable a => a -> Dynamic
toDyn ()
    , blockBlanks :: [Int]
blockBlanks   = []
    , blockAttributes :: Attributes
blockAttributes = forall a. Monoid a => a
mempty
    }

type BlockNode m il bl = Tree (BlockData m il bl)

data BPState m il bl = BPState
     { forall (m :: * -> *) il bl. BPState m il bl -> ReferenceMap
referenceMap     :: !ReferenceMap
     , forall (m :: * -> *) il bl.
BPState m il bl
-> ReferenceMap -> [Tok] -> m (Either ParseError il)
inlineParser     :: ReferenceMap -> [Tok] -> m (Either ParseError il)
     , forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack        :: [BlockNode m il bl]   -- reverse order, head is tip
     , forall (m :: * -> *) il bl. BPState m il bl -> Bool
blockMatched     :: !Bool
     , forall (m :: * -> *) il bl. BPState m il bl -> Bool
maybeLazy        :: !Bool
     , forall (m :: * -> *) il bl. BPState m il bl -> Bool
maybeBlank       :: !Bool
     , forall (m :: * -> *) il bl. BPState m il bl -> Map Text Dynamic
counters         :: M.Map Text Dynamic
     , forall (m :: * -> *) il bl. BPState m il bl -> Map Text SourcePos
failurePositions :: M.Map Text SourcePos  -- record known positions
                           -- where parsers fail to avoid repetition
     , forall (m :: * -> *) il bl.
BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
attributeParsers :: [ParsecT [Tok] (BPState m il bl) m Attributes]
     , forall (m :: * -> *) il bl. BPState m il bl -> Attributes
nextAttributes   :: !Attributes
     }

type BlockParser m il bl = ParsecT [Tok] (BPState m il bl) m

data ListData = ListData
     { ListData -> ListType
listType    :: !ListType
     , ListData -> ListSpacing
listSpacing :: !ListSpacing
     } deriving (Int -> ListData -> ShowS
[ListData] -> ShowS
ListData -> SourceName
forall a.
(Int -> a -> ShowS)
-> (a -> SourceName) -> ([a] -> ShowS) -> Show a
showList :: [ListData] -> ShowS
$cshowList :: [ListData] -> ShowS
show :: ListData -> SourceName
$cshow :: ListData -> SourceName
showsPrec :: Int -> ListData -> ShowS
$cshowsPrec :: Int -> ListData -> ShowS
Show, ListData -> ListData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListData -> ListData -> Bool
$c/= :: ListData -> ListData -> Bool
== :: ListData -> ListData -> Bool
$c== :: ListData -> ListData -> Bool
Eq)

data ListItemData = ListItemData
     { ListItemData -> ListType
listItemType         :: !ListType
     , ListItemData -> Int
listItemIndent       :: !Int
     , ListItemData -> Bool
listItemBlanksInside :: !Bool
     , ListItemData -> Bool
listItemBlanksAtEnd  :: !Bool
     } deriving (Int -> ListItemData -> ShowS
[ListItemData] -> ShowS
ListItemData -> SourceName
forall a.
(Int -> a -> ShowS)
-> (a -> SourceName) -> ([a] -> ShowS) -> Show a
showList :: [ListItemData] -> ShowS
$cshowList :: [ListItemData] -> ShowS
show :: ListItemData -> SourceName
$cshow :: ListItemData -> SourceName
showsPrec :: Int -> ListItemData -> ShowS
$cshowsPrec :: Int -> ListItemData -> ShowS
Show, ListItemData -> ListItemData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListItemData -> ListItemData -> Bool
$c/= :: ListItemData -> ListItemData -> Bool
== :: ListItemData -> ListItemData -> Bool
$c== :: ListItemData -> ListItemData -> Bool
Eq)

-- | Get type of the enclosing List block. If the parent isn't
-- a List block, return Nothing.
getParentListType :: Monad m => BlockParser m il bl (Maybe ListType)
getParentListType :: forall (m :: * -> *) il bl.
Monad m =>
BlockParser m il bl (Maybe ListType)
getParentListType = do
  (BlockNode m il bl
cur:[BlockNode m il bl]
_) <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  if forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
cur) forall a. Eq a => a -> a -> Bool
== Text
"List"
     then do
       let ListData ListType
lt ListSpacing
_ = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
cur))
                            (ListType -> ListSpacing -> ListData
ListData (Char -> ListType
BulletList Char
'*') ListSpacing
TightList)
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ListType
lt
     else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

runInlineParser :: Monad m
                => [Tok]
                -> BlockParser m il bl il
runInlineParser :: forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser [Tok]
toks = {-# SCC runInlineParser #-} do
  ReferenceMap
refmap <- forall (m :: * -> *) il bl. BPState m il bl -> ReferenceMap
referenceMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  ReferenceMap -> [Tok] -> m (Either ParseError il)
ilParser <- forall (m :: * -> *) il bl.
BPState m il bl
-> ReferenceMap -> [Tok] -> m (Either ParseError il)
inlineParser forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Either ParseError il
res <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ ReferenceMap -> [Tok] -> m (Either ParseError il)
ilParser ReferenceMap
refmap [Tok]
toks
  case Either ParseError il
res of
       Right il
ils -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! il
ils
       Left ParseError
err  -> forall (m :: * -> *) s u a.
Monad m =>
(State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT (\State [Tok] (BPState m il bl)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Consumed a
Empty (forall (m :: * -> *) a. Monad m => a -> m a
return (forall s u a. ParseError -> Reply s u a
Error ParseError
err))))
                    -- pass up ParseError

addRange :: (Monad m, IsBlock il bl)
         => BlockNode m il bl -> bl -> bl
addRange :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> bl -> bl
addRange (Node BlockData m il bl
b [Tree (BlockData m il bl)]
_)
 = forall a. Rangeable a => SourceRange -> a -> a
ranged ([(SourcePos, SourcePos)] -> SourceRange
SourceRange
            (forall {a}. Eq a => [(a, a)] -> [(a, a)]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\SourcePos
pos ->
                                  (SourcePos
pos, SourcePos -> Int -> SourcePos
setSourceColumn
                                         (SourcePos -> Int -> SourcePos
incSourceLine SourcePos
pos Int
1) Int
1))
                                (forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos BlockData m il bl
b)))
   where
     go :: [(a, a)] -> [(a, a)]
go [] = []
     go ((!a
startpos1, !a
endpos1):(!a
startpos2, !a
endpos2):[(a, a)]
rest)
       | a
startpos1 forall a. Eq a => a -> a -> Bool
== a
startpos2
       , a
endpos1 forall a. Eq a => a -> a -> Bool
== a
endpos2   = [(a, a)] -> [(a, a)]
go ((a
startpos1, a
endpos2)forall a. a -> [a] -> [a]
:[(a, a)]
rest)
       | a
endpos1 forall a. Eq a => a -> a -> Bool
== a
startpos2 = [(a, a)] -> [(a, a)]
go ((a
startpos1, a
endpos2)forall a. a -> [a] -> [a]
:[(a, a)]
rest)
     go ((a, a)
x:[(a, a)]
xs) = (a, a)
x forall a. a -> [a] -> [a]
: [(a, a)] -> [(a, a)]
go [(a, a)]
xs

-- Add a new node to the block stack.  If current tip can contain
-- it, add it there; otherwise, close the tip and repeat til we get
-- to a block that can contain this node.
addNodeToStack :: Monad m => BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack :: forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m bl il
node = do
  (BlockNode m bl il
cur:[BlockNode m bl il]
rest) <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m bl il
cur) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockContainsLines (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m bl il
cur))
  if forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockSpec m il bl -> Bool
blockCanContain (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m bl il
cur) (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m bl il
node)
     then do
       Attributes
nextAttr <- forall (m :: * -> *) il bl. BPState m il bl -> Attributes
nextAttributes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
       let node' :: BlockNode m bl il
node' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Attributes
nextAttr
                      then BlockNode m bl il
node
                      else
                        let rl :: BlockData m bl il
rl = forall a. Tree a -> a
rootLabel BlockNode m bl il
node
                        in  BlockNode m bl il
node{ rootLabel :: BlockData m bl il
rootLabel = BlockData m bl il
rl{
                                  blockAttributes :: Attributes
blockAttributes = Attributes
nextAttr
                                }}
       forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m bl il
st ->
            BPState m bl il
st{ nextAttributes :: Attributes
nextAttributes = forall a. Monoid a => a
mempty
              , nodeStack :: [BlockNode m bl il]
nodeStack = BlockNode m bl il
node' forall a. a -> [a] -> [a]
: BlockNode m bl il
cur forall a. a -> [a] -> [a]
: [BlockNode m bl il]
rest
              , maybeLazy :: Bool
maybeLazy = Bool
False }
     else case [BlockNode m bl il]
rest of
              (BlockNode m bl il
x:[BlockNode m bl il]
xs) -> do
                [BlockNode m bl il]
stack <- (forall a. a -> [a] -> [a]
:[BlockNode m bl il]
xs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) il bl.
[BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
collapseNodeStack [BlockNode m bl il
cur,BlockNode m bl il
x]
                forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m bl il
st -> BPState m bl il
st{ nodeStack :: [BlockNode m bl il]
nodeStack = [BlockNode m bl il]
stack }
                forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m bl il
node
              [BlockNode m bl il]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

interruptsParagraph :: Monad m => BlockParser m bl il Bool
interruptsParagraph :: forall (m :: * -> *) bl il. Monad m => BlockParser m bl il Bool
interruptsParagraph = do
  (BlockNode m bl il
cur:[BlockNode m bl il]
_) <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m bl il
cur)

renderChildren :: (Monad m, IsBlock il bl)
               => BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren BlockNode m il bl
node = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *} {il} {b}.
(Monad m, IsBlock il b) =>
Tree (BlockData m il b) -> ParsecT [Tok] (BPState m il b) m b
renderC forall a b. (a -> b) -> a -> b
$ forall a. Tree a -> [Tree a]
subForest BlockNode m il bl
node
  where
    renderC :: Tree (BlockData m il b) -> ParsecT [Tok] (BPState m il b) m b
renderC Tree (BlockData m il b)
n = do
      let attrs :: Attributes
attrs = forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
blockAttributes (forall a. Tree a -> a
rootLabel Tree (BlockData m il b)
n)
      (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Attributes
attrs
          then forall a. a -> a
id
          else forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> bl -> bl
addRange Tree (BlockData m il b)
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
blockConstructor (forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec (forall a. Tree a -> a
rootLabel Tree (BlockData m il b)
n)) Tree (BlockData m il b)
n

docSpec :: (Monad m, IsBlock il bl, Monoid bl) => BlockSpec m il bl
docSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, Monoid bl) =>
BlockSpec m il bl
docSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"Doc"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
True
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \BlockNode m il bl
n -> (,BlockNode m il bl
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer
     }

refLinkDefSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
refLinkDefSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
refLinkDefSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"ReferenceLinkDefinition"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
False
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
node -> do
         let linkdefs :: [((SourceRange, Text), LinkInfo)]
linkdefs = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                  forall a. HasCallStack => a
undefined :: [((SourceRange, Text), LinkInfo)]
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\((SourceRange
range, Text
lab), LinkInfo
linkinfo) ->
            forall a. Rangeable a => SourceRange -> a -> a
ranged SourceRange
range
              (forall a. HasAttributes a => Attributes -> a -> a
addAttributes (LinkInfo -> Attributes
linkAttributes LinkInfo
linkinfo)
                (forall il b. IsBlock il b => Text -> (Text, Text) -> b
referenceLinkDefinition Text
lab (LinkInfo -> Text
linkDestination LinkInfo
linkinfo,
                                            LinkInfo -> Text
linkTitle LinkInfo
linkinfo)))) [((SourceRange, Text), LinkInfo)]
linkdefs
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer
     }

-- Parse reference links from beginning of block text;
-- update reference map and block text; return maybe altered node
-- (if it still contains lines) and maybe ref link node.
extractReferenceLinks :: (Monad m, IsBlock il bl)
                      => BlockNode m il bl
                      -> BlockParser m il bl (Maybe (BlockNode m il bl),
                                              Maybe (BlockNode m il bl))
extractReferenceLinks :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl
-> BlockParser
     m il bl (Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
extractReferenceLinks BlockNode m il bl
node = do
  BPState m il bl
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Either ParseError ([((SourceRange, Text), LinkInfo)], [Tok])
res <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
runParserT ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> SourcePos
tokPos) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                        forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s m Attributes
-> ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
linkReferenceDef (forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl.
BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
attributeParsers BPState m il bl
st)))
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput) BPState m il bl
st SourceName
"" (forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node)
  case Either ParseError ([((SourceRange, Text), LinkInfo)], [Tok])
res of
        Left ParseError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just BlockNode m il bl
node, forall a. Maybe a
Nothing)
        Right ([((SourceRange, Text), LinkInfo)]
linkdefs, [Tok]
toks') -> do
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
            (\((SourceRange
_,Text
lab),LinkInfo
linkinfo) ->
             forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
s -> BPState m il bl
s{
              referenceMap :: ReferenceMap
referenceMap = forall a. Typeable a => Text -> a -> ReferenceMap -> ReferenceMap
insertReference Text
lab LinkInfo
linkinfo
                (forall (m :: * -> *) il bl. BPState m il bl -> ReferenceMap
referenceMap BPState m il bl
s) }) [((SourceRange, Text), LinkInfo)]
linkdefs
          let isRefPos :: SourcePos -> Bool
isRefPos = case [Tok]
toks' of
                           (Tok
t:[Tok]
_) -> (forall a. Ord a => a -> a -> Bool
< Tok -> SourcePos
tokPos Tok
t)
                           [Tok]
_     -> forall a b. a -> b -> a
const Bool
False
          let node' :: Maybe (BlockNode m il bl)
node' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tok]
toks'
                         then forall a. Maybe a
Nothing
                         else forall a. a -> Maybe a
Just BlockNode m il bl
node{ rootLabel :: BlockData m il bl
rootLabel =
                              (forall a. Tree a -> a
rootLabel BlockNode m il bl
node){
                                blockLines :: [[Tok]]
blockLines = [[Tok]
toks'],
                                blockStartPos :: [SourcePos]
blockStartPos = forall a. (a -> Bool) -> [a] -> [a]
dropWhile SourcePos -> Bool
isRefPos
                                   (forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                                }
                           }
          let refnode :: BlockNode m il bl
refnode = BlockNode m il bl
node{ rootLabel :: BlockData m il bl
rootLabel =
                 (forall a. Tree a -> a
rootLabel BlockNode m il bl
node){
                     blockLines :: [[Tok]]
blockLines = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (SourcePos -> Bool
isRefPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> SourcePos
tokPos))
                       (forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                   , blockStartPos :: [SourcePos]
blockStartPos = forall a. (a -> Bool) -> [a] -> [a]
takeWhile SourcePos -> Bool
isRefPos
                       (forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                   , blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn [((SourceRange, Text), LinkInfo)]
linkdefs
                   , blockSpec :: BlockSpec m il bl
blockSpec = forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
refLinkDefSpec
                 }}
          forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (BlockNode m il bl)
node', forall a. a -> Maybe a
Just BlockNode m il bl
refnode)

attributeSpec :: (Monad m, IsBlock il bl)
              => BlockSpec m il bl
attributeSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
attributeSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"Attribute"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
         [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers <- forall (m :: * -> *) il bl.
BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
attributeParsers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
         forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers)
         forall (m :: * -> *) bl il. Monad m => BlockParser m bl il Bool
interruptsParagraph forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
         forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
         SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         Attributes
attrs <- forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers
         forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
         forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
         forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack forall a b. (a -> b) -> a -> b
$
           forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
attributeSpec){
                     blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn Attributes
attrs,
                     blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
         forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
False
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \BlockNode m il bl
n -> do
         [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers <- forall (m :: * -> *) il bl.
BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
attributeParsers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
         forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers)
         forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
         SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         Attributes
attrs <- forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers
         forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
         forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
         let oldattrs :: Attributes
oldattrs = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
n)) forall a. Monoid a => a
mempty :: Attributes
         let attrs' :: Attributes
attrs' = Attributes
oldattrs forall a. Semigroup a => a -> a -> a
<> Attributes
attrs
         forall (m :: * -> *) a. Monad m => a -> m a
return  (SourcePos
pos, BlockNode m il bl
n{ rootLabel :: BlockData m il bl
rootLabel = (forall a. Tree a -> a
rootLabel BlockNode m il bl
n){
                          blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn Attributes
attrs' }})
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => a
mempty
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = \BlockNode m il bl
node BlockNode m il bl
parent -> do
         let attrs :: Attributes
attrs = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node)) forall a. Monoid a => a
mempty :: Attributes
         forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ nextAttributes :: Attributes
nextAttributes = Attributes
attrs }
         forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer BlockNode m il bl
node BlockNode m il bl
parent
     }

paraSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
paraSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"Paragraph"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             forall (m :: * -> *) bl il. Monad m => BlockParser m bl il Bool
interruptsParagraph forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
             forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
             forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack forall a b. (a -> b) -> a -> b
$
               forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec){
                       blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
False
     , blockContainsLines :: Bool
blockContainsLines  = Bool
True
     , blockParagraph :: Bool
blockParagraph      = Bool
True
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \BlockNode m il bl
n -> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
             forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
n)
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
node ->
         forall il b. IsBlock il b => il -> b
paragraph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node)
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = \BlockNode m il bl
child BlockNode m il bl
parent -> do
         (Maybe (BlockNode m il bl)
mbchild, Maybe (BlockNode m il bl)
mbrefdefs) <- forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl
-> BlockParser
     m il bl (Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
extractReferenceLinks BlockNode m il bl
child
         case (Maybe (BlockNode m il bl)
mbchild, Maybe (BlockNode m il bl)
mbrefdefs) of
           (Maybe (BlockNode m il bl)
_, Maybe (BlockNode m il bl)
Nothing) -> forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer BlockNode m il bl
child BlockNode m il bl
parent
           (Maybe (BlockNode m il bl)
Nothing, Just BlockNode m il bl
refnode)
                        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! BlockNode m il bl
parent{ subForest :: [BlockNode m il bl]
subForest =
                                          BlockNode m il bl
refnode forall a. a -> [a] -> [a]
: forall a. Tree a -> [Tree a]
subForest BlockNode m il bl
parent }
           (Just BlockNode m il bl
child', Just BlockNode m il bl
refnode)
                        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! BlockNode m il bl
parent{ subForest :: [BlockNode m il bl]
subForest =
                                        BlockNode m il bl
child' forall a. a -> [a] -> [a]
: BlockNode m il bl
refnode forall a. a -> [a] -> [a]
: forall a. Tree a -> [Tree a]
subForest BlockNode m il bl
parent }
     }

plainSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
plainSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
plainSpec = forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec{
    blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
node ->
         forall il b. IsBlock il b => il -> b
plain forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node)
  }


linkReferenceDef :: Monad m
                 => ParsecT [Tok] s m Attributes
                 -> ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
linkReferenceDef :: forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s m Attributes
-> ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
linkReferenceDef ParsecT [Tok] s m Attributes
attrParser = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  SourcePos
startpos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Text
lab <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Text
pLinkLabel
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
lab
  forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':'
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  SourcePos
linkpos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  [Tok]
dest <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pLinkDestination
  ([Tok]
title, Attributes
attrs) <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
             [Tok]
tit <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pLinkTitle)
             forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             Attributes
as <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Monoid a => a
mempty ParsecT [Tok] s m Attributes
attrParser
             forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
             forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
tit, Attributes
as)
  SourcePos
endpos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  forall (m :: * -> *) a. Monad m => a -> m a
return (([(SourcePos, SourcePos)] -> SourceRange
SourceRange [(SourcePos
startpos, SourcePos
endpos)], Text
lab),
                LinkInfo{ linkDestination :: Text
linkDestination = [Tok] -> Text
unEntity [Tok]
dest
                        , linkTitle :: Text
linkTitle = [Tok] -> Text
unEntity [Tok]
title
                        , linkAttributes :: Attributes
linkAttributes = Attributes
attrs
                        , linkPos :: Maybe SourcePos
linkPos = forall a. a -> Maybe a
Just SourcePos
linkpos })

atxHeadingSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
atxHeadingSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
atxHeadingSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"ATXHeading"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             [Tok]
hashes <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'#')
             let level :: Int
level = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
hashes
             forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
level forall a. Ord a => a -> a -> Bool
<= Int
6
             (forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
spaceTok forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
spaceTok)
                forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd)
                forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
             [Tok]
raw <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType TokType
LineEnd))
             -- trim off closing ###
             let removeClosingHash :: Int -> [Tok] -> [Tok]
removeClosingHash (Int
_ :: Int) [] = []
                 removeClosingHash Int
0 (Tok TokType
Spaces SourcePos
_ Text
_ : [Tok]
xs) =
                   Int -> [Tok] -> [Tok]
removeClosingHash Int
0 [Tok]
xs
                 removeClosingHash Int
_ (Tok (Symbol Char
'#') SourcePos
_ Text
_ :
                                      Tok (Symbol Char
'\\') SourcePos
_ Text
_ : [Tok]
_) =
                   forall a. [a] -> [a]
reverse [Tok]
raw
                 removeClosingHash Int
_ (Tok (Symbol Char
'#') SourcePos
_ Text
_ : [Tok]
xs) =
                   Int -> [Tok] -> [Tok]
removeClosingHash Int
1 [Tok]
xs
                 removeClosingHash Int
1 (Tok TokType
Spaces SourcePos
_ Text
_ : [Tok]
xs) = [Tok]
xs
                 removeClosingHash Int
1 (Tok
x:[Tok]
_)
                  | Tok -> TokType
tokType Tok
x forall a. Eq a => a -> a -> Bool
/= Char -> TokType
Symbol Char
'#' = forall a. [a] -> [a]
reverse [Tok]
raw
                 removeClosingHash Int
_ [Tok]
xs = [Tok]
xs
             let raw' :: [Tok]
raw' = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Tok] -> [Tok]
removeClosingHash Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [Tok]
raw
             forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
atxHeadingSpec){
                            blockLines :: [[Tok]]
blockLines = [[Tok]
raw'],
                            blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn Int
level,
                            blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
False
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
node -> do
         let level :: Int
level = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node)) Int
1
         il
ils <- forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node)
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall il b. IsBlock il b => Int -> il -> b
heading Int
level il
ils
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = \node :: BlockNode m il bl
node@(Node BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode m il bl
parent -> do
         let oldAttr :: Attributes
oldAttr = forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
blockAttributes BlockData m il bl
cdata
         let toks :: [Tok]
toks = forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node
         ([Tok]
newtoks, Attributes
attr) <- forall (m :: * -> *) il bl.
Monad m =>
Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
parseFinalAttributes Bool
True [Tok]
toks
                        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
toks, forall a. Monoid a => a
mempty))
         forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
cdata{ blockAttributes :: Attributes
blockAttributes = Attributes
oldAttr forall a. Semigroup a => a -> a -> a
<> Attributes
attr
                                     , blockLines :: [[Tok]]
blockLines = [[Tok]
newtoks] }
                                [BlockNode m il bl]
children) BlockNode m il bl
parent
     }

setextHeadingSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
setextHeadingSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
setextHeadingSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"SetextHeading"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             (BlockNode m il bl
cur:[BlockNode m il bl]
rest) <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
             forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
cur)
             forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             Int
level <- (Int
2 :: Int) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-')
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Int
1 :: Int) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'=')
             forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd)
             -- process any reference links, make sure there's some
             -- content left
             (Maybe (BlockNode m il bl)
mbcur, Maybe (BlockNode m il bl)
mbrefdefs) <- forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl
-> BlockParser
     m il bl (Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
extractReferenceLinks BlockNode m il bl
cur
             forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st ->
                BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack = case Maybe (BlockNode m il bl)
mbrefdefs of
                                  Maybe (BlockNode m il bl)
Nothing -> [BlockNode m il bl]
rest
                                  Just BlockNode m il bl
rd -> case [BlockNode m il bl]
rest of
                                                (BlockNode m il bl
x:[BlockNode m il bl]
xs) ->
                                                  BlockNode m il bl
x{ subForest :: [BlockNode m il bl]
subForest =
                                                      BlockNode m il bl
rd forall a. a -> [a] -> [a]
: forall a. Tree a -> [Tree a]
subForest BlockNode m il bl
x }forall a. a -> [a] -> [a]
:[BlockNode m il bl]
xs
                                                [] -> [BlockNode m il bl
rd] }
             case Maybe (BlockNode m il bl)
mbcur of
               Maybe (BlockNode m il bl)
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero -- should not happen
               Just BlockNode m il bl
cur' -> do
                 -- replace cur with new setext heading node
                 forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack forall a b. (a -> b) -> a -> b
$
                      forall a. a -> [Tree a] -> Tree a
Node (forall a. Tree a -> a
rootLabel BlockNode m il bl
cur'){
                              blockSpec :: BlockSpec m il bl
blockSpec  = forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
setextHeadingSpec,
                              blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn Int
level,
                              blockStartPos :: [SourcePos]
blockStartPos =
                                   forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (forall a. Tree a -> a
rootLabel BlockNode m il bl
cur') forall a. [a] -> [a] -> [a]
++ [SourcePos
pos] }
                                    []
                 forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
False
     , blockContainsLines :: Bool
blockContainsLines  = Bool
True
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
node -> do
         let level :: Int
level = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node)) Int
1
         il
ils <- forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node)
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall il b. IsBlock il b => Int -> il -> b
heading Int
level il
ils
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = \node :: BlockNode m il bl
node@(Node BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode m il bl
parent -> do
         let oldAttr :: Attributes
oldAttr = forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
blockAttributes BlockData m il bl
cdata
         let toks :: [Tok]
toks = forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node
         ([Tok]
newtoks, Attributes
attr) <- forall (m :: * -> *) il bl.
Monad m =>
Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
parseFinalAttributes Bool
True [Tok]
toks
                        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
toks, forall a. Monoid a => a
mempty))
         forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
cdata{ blockAttributes :: Attributes
blockAttributes = Attributes
oldAttr forall a. Semigroup a => a -> a -> a
<> Attributes
attr
                                     , blockLines :: [[Tok]]
blockLines = [[Tok]
newtoks] }
                                [BlockNode m il bl]
children) BlockNode m il bl
parent
     }

parseFinalAttributes :: Monad m
                     => Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
parseFinalAttributes :: forall (m :: * -> *) il bl.
Monad m =>
Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
parseFinalAttributes Bool
requireWhitespace [Tok]
ts = do
  [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers <- forall (m :: * -> *) il bl.
BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
attributeParsers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let pAttr' :: ParsecT [Tok] (BPState m il bl) m Attributes
pAttr' = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ (if Bool
requireWhitespace
                         then () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
                         else forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace)
                     forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  BPState m il bl
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Either ParseError ([Tok], Attributes)
res <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
runParserT
       ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Tok] (BPState m il bl) m Attributes
pAttr' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [Tok] (BPState m il bl) m Attributes
pAttr') BPState m il bl
st SourceName
"heading contents" [Tok]
ts
  case Either ParseError ([Tok], Attributes)
res of
    Left ParseError
_         -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Right ([Tok]
xs, Attributes
ys) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
xs, Attributes
ys)

blockQuoteSpec :: (Monad m, IsBlock il bl) => BlockSpec m il bl
blockQuoteSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
blockQuoteSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"BlockQuote"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             Tok
_ <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
             Int
_ <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
1)
             forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack forall a b. (a -> b) -> a -> b
$
                forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
blockQuoteSpec){
                          blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
True
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \BlockNode m il bl
n -> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
             forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             Tok
_ <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
             Int
_ <- forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
1
             forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
pos, BlockNode m il bl
n)
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall il b. IsBlock il b => b -> b
blockQuote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer
     }

listItemSpec :: (Monad m, IsBlock il bl)
             => BlockParser m il bl ListType
             -> BlockSpec m il bl
listItemSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockParser m il bl ListType -> BlockSpec m il bl
listItemSpec BlockParser m il bl ListType
parseListMarker = BlockSpec
     { blockType :: Text
blockType           = Text
"ListItem"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             (SourcePos
pos, ListItemData
lidata) <- forall (m :: * -> *) il bl.
Monad m =>
BlockParser m il bl ListType
-> BlockParser m il bl (SourcePos, ListItemData)
itemStart BlockParser m il bl ListType
parseListMarker
             let linode :: Tree (BlockData m il bl)
linode = forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockParser m il bl ListType -> BlockSpec m il bl
listItemSpec BlockParser m il bl ListType
parseListMarker){
                             blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn ListItemData
lidata,
                             blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             let listdata :: ListData
listdata = ListData{
                    listType :: ListType
listType = ListItemData -> ListType
listItemType ListItemData
lidata
                  , listSpacing :: ListSpacing
listSpacing = ListSpacing
TightList }
                  -- spacing gets set in finalize
             let listnode :: Tree (BlockData m il bl)
listnode = forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
listSpec){
                              blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn ListData
listdata,
                              blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             -- list can only interrupt paragraph if bullet
             -- list or ordered list w/ startnum == 1,
             -- and not followed by blank
             (Tree (BlockData m il bl)
cur:[Tree (BlockData m il bl)]
_) <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
             forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec Tree (BlockData m il bl)
cur)) forall a b. (a -> b) -> a -> b
$ do
               forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ case ListData -> ListType
listType ListData
listdata of
                            BulletList Char
_            -> Bool
True
                            OrderedList Int
1 EnumeratorType
Decimal DelimiterType
_ -> Bool
True
                            ListType
_                       -> Bool
False
               forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
             let curdata :: ListData
curdata = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel Tree (BlockData m il bl)
cur))
                                (ListType -> ListSpacing -> ListData
ListData (Char -> ListType
BulletList Char
'*') ListSpacing
TightList)
             let isSingleRomanDigit :: a -> Bool
isSingleRomanDigit a
n = a
n forall a. Eq a => a -> a -> Bool
== a
1 Bool -> Bool -> Bool
|| a
n forall a. Eq a => a -> a -> Bool
== a
5 Bool -> Bool -> Bool
|| a
n forall a. Eq a => a -> a -> Bool
== a
10 Bool -> Bool -> Bool
||
                                        a
n forall a. Eq a => a -> a -> Bool
== a
50 Bool -> Bool -> Bool
|| a
n forall a. Eq a => a -> a -> Bool
== a
100 Bool -> Bool -> Bool
|| a
n forall a. Eq a => a -> a -> Bool
== a
500 Bool -> Bool -> Bool
||
                                        a
n forall a. Eq a => a -> a -> Bool
== a
1000
             let matchesOrderedListStyle :: ListType -> ListType -> Bool
matchesOrderedListStyle
                  (OrderedList Int
_s1 EnumeratorType
e1 DelimiterType
d1) (OrderedList Int
s2 EnumeratorType
e2 DelimiterType
d2) =
                    DelimiterType
d1 forall a. Eq a => a -> a -> Bool
== DelimiterType
d2 Bool -> Bool -> Bool
&& -- roman can match alphabetic if single-digit:
                      case (EnumeratorType
e1, EnumeratorType
e2) of
                        (EnumeratorType
LowerAlpha, EnumeratorType
LowerRoman) -> forall {a}. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
                        (EnumeratorType
UpperAlpha, EnumeratorType
UpperRoman) -> forall {a}. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
                        (EnumeratorType
LowerRoman, EnumeratorType
LowerAlpha) -> forall {a}. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
                        (EnumeratorType
UpperRoman, EnumeratorType
UpperAlpha) -> forall {a}. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
                        (EnumeratorType, EnumeratorType)
_ -> EnumeratorType
e1 forall a. Eq a => a -> a -> Bool
== EnumeratorType
e2
                 matchesOrderedListStyle ListType
_ ListType
_ = Bool
False

             let matchesList :: ListType -> ListType -> Bool
matchesList (BulletList Char
c) (BulletList Char
d)       = Char
c forall a. Eq a => a -> a -> Bool
== Char
d
                 matchesList x :: ListType
x@OrderedList{}
                             y :: ListType
y@OrderedList{} = ListType -> ListType -> Bool
matchesOrderedListStyle ListType
x ListType
y
                 matchesList ListType
_ ListType
_                                 = Bool
False
             case forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec Tree (BlockData m il bl)
cur) of
                  Text
"List" | ListData -> ListType
listType ListData
curdata ListType -> ListType -> Bool
`matchesList`
                           ListItemData -> ListType
listItemType ListItemData
lidata
                    -> forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack Tree (BlockData m il bl)
linode
                  Text
_ -> forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack Tree (BlockData m il bl)
listnode forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack Tree (BlockData m il bl)
linode
             forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
True
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: Tree (BlockData m il bl)
-> BlockParser m il bl (SourcePos, Tree (BlockData m il bl))
blockContinue       = \node :: Tree (BlockData m il bl)
node@(Node BlockData m il bl
ndata [Tree (BlockData m il bl)]
children) -> do
             let lidata :: ListItemData
lidata = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
ndata)
                             (ListType -> Int -> Bool -> Bool -> ListItemData
ListItemData (Char -> ListType
BulletList Char
'*') Int
0 Bool
False Bool
False)
             -- a marker followed by two blanks is just an empty item:
             forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
ndata) Bool -> Bool -> Bool
||
                     Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree (BlockData m il bl)]
children)
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces (ListItemData -> Int
listItemIndent ListItemData
lidata) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
0 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
             forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
pos, Tree (BlockData m il bl)
node)
     , blockConstructor :: Tree (BlockData m il bl) -> BlockParser m il bl bl
blockConstructor    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren
     , blockFinalize :: Tree (BlockData m il bl)
-> Tree (BlockData m il bl)
-> BlockParser m il bl (Tree (BlockData m il bl))
blockFinalize       = \(Node BlockData m il bl
cdata [Tree (BlockData m il bl)]
children) Tree (BlockData m il bl)
parent -> do
          let lidata :: ListItemData
lidata = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
cdata)
                                 (ListType -> Int -> Bool -> Bool -> ListItemData
ListItemData (Char -> ListType
BulletList Char
'*')
                                   Int
0 Bool
False Bool
False)
          let allblanks :: [Int]
allblanks = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
cdata forall a. a -> [a] -> [a]
:
                                  forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
rootLabel)
                                  (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Text
"List") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
rootLabel) [Tree (BlockData m il bl)]
children)
          Int
curline <- SourcePos -> Int
sourceLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
          let blanksAtEnd :: Bool
blanksAtEnd = case [Int]
allblanks of
                                   (Int
l:[Int]
_) -> Int
l forall a. Ord a => a -> a -> Bool
>= Int
curline forall a. Num a => a -> a -> a
- Int
1
                                   [Int]
_     -> Bool
False
          let blanksInside :: Bool
blanksInside = case forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> [Int]
removeConsecutive [Int]
allblanks) of
                                Int
n | Int
n forall a. Ord a => a -> a -> Bool
> Int
1     -> Bool
True
                                  | Int
n forall a. Eq a => a -> a -> Bool
== Int
1    -> Bool -> Bool
not Bool
blanksAtEnd
                                  | Bool
otherwise -> Bool
False
          let lidata' :: Dynamic
lidata' = forall a. Typeable a => a -> Dynamic
toDyn forall a b. (a -> b) -> a -> b
$ ListItemData
lidata{ listItemBlanksInside :: Bool
listItemBlanksInside = Bool
blanksInside
                                      , listItemBlanksAtEnd :: Bool
listItemBlanksAtEnd  = Bool
blanksAtEnd }
          forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
cdata{ blockData :: Dynamic
blockData = Dynamic
lidata' } [Tree (BlockData m il bl)]
children)
                           Tree (BlockData m il bl)
parent
     }

itemStart :: Monad m
          => BlockParser m il bl ListType
          -> BlockParser m il bl (SourcePos, ListItemData)
itemStart :: forall (m :: * -> *) il bl.
Monad m =>
BlockParser m il bl ListType
-> BlockParser m il bl (SourcePos, ListItemData)
itemStart BlockParser m il bl ListType
parseListMarker = do
  Int
beforecol <- SourcePos -> Int
sourceColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
3
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ListType
ty <- BlockParser m il bl ListType
parseListMarker
  Int
aftercol <- SourcePos -> Int
sourceColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  Int
numspaces <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
4 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace)
           forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
1
           forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
  forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
pos, ListItemData{
           listItemType :: ListType
listItemType = ListType
ty
          , listItemIndent :: Int
listItemIndent = (Int
aftercol forall a. Num a => a -> a -> a
- Int
beforecol) forall a. Num a => a -> a -> a
+ Int
numspaces
          , listItemBlanksInside :: Bool
listItemBlanksInside = Bool
False
          , listItemBlanksAtEnd :: Bool
listItemBlanksAtEnd = Bool
False
          })

bulletListMarker :: Monad m => BlockParser m il bl ListType
bulletListMarker :: forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
bulletListMarker = do
  Tok (Symbol Char
c) SourcePos
_ Text
_ <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'*' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'+'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Char -> ListType
BulletList Char
c

orderedListMarker :: Monad m => BlockParser m il bl ListType
orderedListMarker :: forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
orderedListMarker = do
  Tok TokType
WordChars SourcePos
_ Text
ds <- forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\Text
t -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
t Bool -> Bool -> Bool
&& Text -> Int
T.length Text
t forall a. Ord a => a -> a -> Bool
< Int
10)
  (Int
start :: Int) <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => SourceName -> m a
fail (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a. Integral a => Reader a
TR.decimal Text
ds)
  DelimiterType
delimtype <- DelimiterType
Period forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'.' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> DelimiterType
OneParen forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
')'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int -> EnumeratorType -> DelimiterType -> ListType
OrderedList Int
start EnumeratorType
Decimal DelimiterType
delimtype

listSpec :: (Monad m, IsBlock il bl) => BlockSpec m il bl
listSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
listSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"List"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = \BlockSpec m il bl
sp -> forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
sp forall a. Eq a => a -> a -> Bool
== Text
"ListItem"
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \BlockNode m il bl
n -> (,BlockNode m il bl
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
node -> do
          let ListData ListType
lt ListSpacing
ls = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                                 (ListType -> ListSpacing -> ListData
ListData (Char -> ListType
BulletList Char
'*') ListSpacing
TightList)
          forall il b. IsBlock il b => ListType -> ListSpacing -> [b] -> b
list ListType
lt ListSpacing
ls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren BlockNode m il bl
node
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = \(Node BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode m il bl
parent -> do
          let ListData ListType
lt ListSpacing
_ = forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
cdata)
                                 (ListType -> ListSpacing -> ListData
ListData (Char -> ListType
BulletList Char
'*') ListSpacing
TightList)
          let getListItemData :: Tree (BlockData m il bl) -> ListItemData
getListItemData (Node BlockData m il bl
d [Tree (BlockData m il bl)]
_) =
                forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
d)
                  (ListType -> Int -> Bool -> Bool -> ListItemData
ListItemData (Char -> ListType
BulletList Char
'*') Int
0 Bool
False Bool
False)
          let childrenData :: [ListItemData]
childrenData = forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {il} {bl}.
Tree (BlockData m il bl) -> ListItemData
getListItemData [BlockNode m il bl]
children
          let ls :: ListSpacing
ls = case [ListItemData]
childrenData of
                          ListItemData
c:[ListItemData]
cs | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ListItemData -> Bool
listItemBlanksInside (ListItemData
cforall a. a -> [a] -> [a]
:[ListItemData]
cs) Bool -> Bool -> Bool
||
                                 (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ListItemData]
cs) Bool -> Bool -> Bool
&&
                                  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ListItemData -> Bool
listItemBlanksAtEnd [ListItemData]
cs)
                               -> ListSpacing
LooseList
                          [ListItemData]
_    -> ListSpacing
TightList
          [Int]
blockBlanks' <- case [ListItemData]
childrenData of
                             ListItemData
c:[ListItemData]
_ | ListItemData -> Bool
listItemBlanksAtEnd ListItemData
c -> do
                                 Int
curline <- SourcePos -> Int
sourceLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
curline forall a. Num a => a -> a -> a
- Int
1 forall a. a -> [a] -> [a]
: forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
cdata
                             [ListItemData]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
cdata
          let ldata' :: Dynamic
ldata' = forall a. Typeable a => a -> Dynamic
toDyn (ListType -> ListSpacing -> ListData
ListData ListType
lt ListSpacing
ls)
          -- need to transform paragraphs on tight lists
          let totight :: Tree (BlockData m il bl) -> Tree (BlockData m il bl)
totight (Node BlockData m il bl
nd [Tree (BlockData m il bl)]
cs)
                | forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec BlockData m il bl
nd) forall a. Eq a => a -> a -> Bool
== Text
"Paragraph"
                            = forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd{ blockSpec :: BlockSpec m il bl
blockSpec = forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
plainSpec } [Tree (BlockData m il bl)]
cs
                | Bool
otherwise = forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd [Tree (BlockData m il bl)]
cs
          let childrenToTight :: Tree (BlockData m il bl) -> Tree (BlockData m il bl)
childrenToTight (Node BlockData m il bl
nd [Tree (BlockData m il bl)]
cs) = forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd (forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {il} {bl}.
(Monad m, IsBlock il bl) =>
Tree (BlockData m il bl) -> Tree (BlockData m il bl)
totight [Tree (BlockData m il bl)]
cs)
          let children' :: [BlockNode m il bl]
children' =
                 if ListSpacing
ls forall a. Eq a => a -> a -> Bool
== ListSpacing
TightList
                    then forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {il} {bl}.
(Monad m, IsBlock il bl) =>
Tree (BlockData m il bl) -> Tree (BlockData m il bl)
childrenToTight [BlockNode m il bl]
children
                    else [BlockNode m il bl]
children
          forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
cdata{ blockData :: Dynamic
blockData = Dynamic
ldata'
                                      , blockBlanks :: [Int]
blockBlanks = [Int]
blockBlanks' } [BlockNode m il bl]
children')
                           BlockNode m il bl
parent
     }

thematicBreakSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
thematicBreakSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
thematicBreakSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"ThematicBreak"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
            forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
            SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
            Tok (Symbol Char
c) SourcePos
_ Text
_ <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
                              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'_'
                              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'*'
            forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
            let tbchar :: ParsecT [Tok] s m Tok
tbchar = forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
            forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
2 forall {s}. ParsecT [Tok] s m Tok
tbchar
            forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall {s}. ParsecT [Tok] s m Tok
tbchar
            (do forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
                forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack (forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
thematicBreakSpec){
                                   blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } [])
                forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              (SourcePos -> BlockStartResult
BlockStartNoMatchBefore forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition)
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
False
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall il b. IsBlock il b => b
thematicBreak
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer
     }

indentedCodeSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
indentedCodeSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
indentedCodeSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"IndentedCode"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             forall (m :: * -> *) bl il. Monad m => BlockParser m bl il Bool
interruptsParagraph forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
             forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) il bl. BPState m il bl -> Bool
maybeLazy
             Int
_ <- forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
4
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
             forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
indentedCodeSpec){
                          blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
False
     , blockContainsLines :: Bool
blockContainsLines  = Bool
True
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \BlockNode m il bl
node -> do
             forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
4)
               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd)
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
pos, BlockNode m il bl
node)

     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
node ->
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall il b. IsBlock il b => Text -> Text -> b
codeBlock forall a. Monoid a => a
mempty ([Tok] -> Text
untokenize (forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node))
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = \(Node BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode m il bl
parent -> do
         -- strip off blank lines at end:
         let blanks :: [[Tok]]
blanks = forall a. (a -> Bool) -> [a] -> [a]
takeWhile [Tok] -> Bool
isblankLine forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
cdata
         let numblanks :: Int
numblanks = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Tok]]
blanks
         let cdata' :: BlockData m il bl
cdata' = BlockData m il bl
cdata{ blockLines :: [[Tok]]
blockLines =
                                forall a. Int -> [a] -> [a]
drop Int
numblanks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
cdata
                           , blockStartPos :: [SourcePos]
blockStartPos =
                                forall a. Int -> [a] -> [a]
drop Int
numblanks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos BlockData m il bl
cdata
                           }
         forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
cdata' [BlockNode m il bl]
children) BlockNode m il bl
parent
     }

isblankLine :: [Tok] -> Bool
isblankLine :: [Tok] -> Bool
isblankLine []                    = Bool
True
isblankLine [Tok TokType
LineEnd SourcePos
_ Text
_]     = Bool
True
isblankLine (Tok TokType
Spaces SourcePos
_ Text
_ : [Tok]
xs) = [Tok] -> Bool
isblankLine [Tok]
xs
isblankLine [Tok]
_                     = Bool
False

fencedCodeSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
fencedCodeSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
fencedCodeSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"FencedCode"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             SourcePos
prepos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             let indentspaces :: Int
indentspaces = SourcePos -> Int
sourceColumn SourcePos
pos forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceColumn SourcePos
prepos
             (Char
c, [Tok]
ticks) <-  ((Char
'`',) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'`'))
                        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Char
'~',) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'~'))
             let fencelength :: Int
fencelength = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ticks
             forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
fencelength forall a. Ord a => a -> a -> Bool
>= Int
3
             forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             let infoTok :: ParsecT [Tok] s m Tok
infoTok = forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
noneOfToks (TokType
LineEnd forall a. a -> [a] -> [a]
: [Char -> TokType
Symbol Char
'`' | Char
c forall a. Eq a => a -> a -> Bool
== Char
'`'])
             Text
info <- Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
unEntity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
pEscaped forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {s}. ParsecT [Tok] s m Tok
infoTok)
             forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

             let infotoks :: [Tok]
infotoks = SourceName -> Text -> [Tok]
tokenize SourceName
"info string" Text
info
             ([Tok]
content, Attributes
attrs) <- forall (m :: * -> *) il bl.
Monad m =>
Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
parseFinalAttributes Bool
False [Tok]
infotoks
                                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
infotoks, forall a. Monoid a => a
mempty))
             forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack forall a b. (a -> b) -> a -> b
$
                forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
fencedCodeSpec){
                          blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn
                               (Char
c, Int
fencelength, Int
indentspaces,
                               [Tok] -> Text
untokenize [Tok]
content, Attributes
attrs),
                          blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
False
     , blockContainsLines :: Bool
blockContainsLines  = Bool
True
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \BlockNode m il bl
node -> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
             let ((Char
c, Int
fencelength, Int
_, Text
_, Attributes
_)
                    :: (Char, Int, Int, Text, Attributes)) = forall a. Typeable a => Dynamic -> a -> a
fromDyn
                                   (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                                   (Char
'`', Int
3, Int
0, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
             forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             [Tok]
ts <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
c)
             forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts forall a. Ord a => a -> a -> Bool
>= Int
fencelength
             forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
             forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ()
endOfBlock
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node))
               forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do let ((Char
_, Int
_, Int
indentspaces, Text
_, Attributes
_)
                              :: (Char, Int, Int, Text, Attributes)) = forall a. Typeable a => Dynamic -> a -> a
fromDyn
                                   (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                                   (Char
'`', Int
3, Int
0, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
                       SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                       Int
_ <- forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
indentspaces
                       forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
pos, BlockNode m il bl
node))
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
node -> do
           let ((Char
_, Int
_, Int
_, Text
info, Attributes
attrs) :: (Char, Int, Int, Text, Attributes)) =
                   forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node)) (Char
'`', Int
3, Int
0, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
           let codetext :: Text
codetext = [Tok] -> Text
untokenize forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 (forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node)
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$!
              if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Attributes
attrs
                 then forall il b. IsBlock il b => Text -> Text -> b
codeBlock Text
info Text
codetext
                 else forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs forall a b. (a -> b) -> a -> b
$ forall il b. IsBlock il b => Text -> Text -> b
codeBlock Text
info Text
codetext
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer
     }

rawHtmlSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
rawHtmlSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
rawHtmlSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"RawHTML"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
         SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         (Int
rawHtmlType, [Tok]
toks) <- forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw forall a b. (a -> b) -> a -> b
$
           do forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
              forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'<'
              Int
ty <- forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> Int
n forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) il bl.
Monad m =>
Int -> BlockParser m il bl ()
startCond Int
n) [Int
1..Int
7]
              -- some blocks can end on same line
              Bool
finished <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False forall a b. (a -> b) -> a -> b
$ do
                 forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
ty forall a. Eq a => a -> a -> Bool
/= Int
6 Bool -> Bool -> Bool
&& Int
ty forall a. Eq a => a -> a -> Bool
/= Int
7)
                 forall (m :: * -> *) il bl.
Monad m =>
Int -> BlockParser m il bl ()
endCond Int
ty
                 forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ty forall a. Eq a => a -> a -> Bool
== Int
7) forall a b. (a -> b) -> a -> b
$ do
                 -- type 7 blocks can't interrupt a paragraph
                 (BlockNode m il bl
n:[BlockNode m il bl]
_) <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                 forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
n)
              forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType TokType
LineEnd)
              -- we use 0 as a code to indicate that the block is closed
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! if Bool
finished then Int
0 else Int
ty
         forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
rawHtmlSpec){
                      blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn Int
rawHtmlType,
                      blockLines :: [[Tok]]
blockLines = [[Tok]
toks],
                      blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
         forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = forall a b. a -> b -> a
const Bool
False
     , blockContainsLines :: Bool
blockContainsLines  = Bool
True
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \node :: BlockNode m il bl
node@(Node BlockData m il bl
ndata [BlockNode m il bl]
children) -> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
         SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         case forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node)) (Int
0 :: Int) of
              Int
0 -> forall (m :: * -> *) a. MonadPlus m => m a
mzero  -- 0 means that the block start already closed
              Int
6 -> (SourcePos
pos, BlockNode m il bl
node) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
              Int
7 -> (SourcePos
pos, BlockNode m il bl
node) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
              Int
n ->
                (do SourcePos
pos' <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                    forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *) il bl.
Monad m =>
Int -> BlockParser m il bl ()
endCond Int
n)
                    forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ()
endOfBlock
                    [Tok]
toks <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType TokType
LineEnd))
                    [Tok]
le <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (SourcePos
pos', forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
ndata{
                                    blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn (Int
0 :: Int)
                                  , blockLines :: [[Tok]]
blockLines = ([Tok]
toks forall a. [a] -> [a] -> [a]
++ [Tok]
le) forall a. a -> [a] -> [a]
: forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
ndata
                                  } [BlockNode m il bl]
children)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
pos, BlockNode m il bl
node))
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \BlockNode m il bl
node ->
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall il b. IsBlock il b => Format -> Text -> b
rawBlock (Text -> Format
Format Text
"html")
                           ([Tok] -> Text
untokenize (forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node))
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer
     }

---------------- for raw html:

startCond :: Monad m => Int -> BlockParser m il bl ()
startCond :: forall (m :: * -> *) il bl.
Monad m =>
Int -> BlockParser m il bl ()
startCond Int
1 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ([Text] -> Text -> Bool
isOneOfCI [Text
"script",Text
"pre",Text
"style",Text
"textarea"])
  forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
spaceTok
     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
     forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
startCond Int
2 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'!'
  forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
  forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
startCond Int
3 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'?'
startCond Int
4 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'!'
  forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\Text
t -> case Text -> Maybe (Char, Text)
T.uncons Text
t of
                          Just (Char
c, Text
_) -> Char -> Bool
isAsciiUpper Char
c
                          Maybe (Char, Text)
_           -> Bool
False)
startCond Int
5 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'!'
  forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'['
  forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (forall a. Eq a => a -> a -> Bool
== Text
"CDATA")
  forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'['
startCond Int
6 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/')
  forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ([Text] -> Text -> Bool
isOneOfCI [Text
"address", Text
"article", Text
"aside", Text
"base",
    Text
"basefont", Text
"blockquote", Text
"body", Text
"caption", Text
"center", Text
"col",
    Text
"colgroup", Text
"dd", Text
"details", Text
"dialog", Text
"dir", Text
"div", Text
"dl",
    Text
"dt", Text
"fieldset", Text
"figcaption", Text
"figure", Text
"footer", Text
"form", Text
"frame",
    Text
"frameset", Text
"h1", Text
"h2", Text
"h3", Text
"h4", Text
"h5", Text
"h6", Text
"head", Text
"header",
    Text
"hr", Text
"html", Text
"iframe", Text
"legend", Text
"li", Text
"link", Text
"main", Text
"menu",
    Text
"menuitem", Text
"nav", Text
"noframes", Text
"ol", Text
"optgroup", Text
"option",
    Text
"p", Text
"param", Text
"section", Text
"source", Text
"summary", Text
"table", Text
"tbody",
    Text
"td", Text
"tfoot", Text
"th", Text
"thead", Text
"title", Text
"tr", Text
"track", Text
"ul"])
  forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
spaceTok
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>')
startCond Int
7 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  [Tok]
toks <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlOpenTag forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlClosingTag
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TokType -> Tok -> Bool
hasType TokType
LineEnd) [Tok]
toks
  forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
startCond Int
n = forall (m :: * -> *) a. MonadFail m => SourceName -> m a
fail forall a b. (a -> b) -> a -> b
$ SourceName
"Unknown HTML block type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> SourceName
show Int
n

endCond :: Monad m => Int -> BlockParser m il bl ()
endCond :: forall (m :: * -> *) il bl.
Monad m =>
Int -> BlockParser m il bl ()
endCond Int
1 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  let closer :: ParsecT [Tok] u m Tok
closer = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'<'
        forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/'
        forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ([Text] -> Text -> Bool
isOneOfCI [Text
"script",Text
"pre",Text
"style",Text
"textarea"])
        forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
  forall s u (m :: * -> *) a b.
ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m ()
skipManyTill (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType TokType
LineEnd)) forall {u}. ParsecT [Tok] u m Tok
closer
endCond Int
2 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  let closer :: ParsecT [Tok] u m Tok
closer = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
  forall s u (m :: * -> *) a b.
ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m ()
skipManyTill (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType TokType
LineEnd)) forall {u}. ParsecT [Tok] u m Tok
closer
endCond Int
3 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  let closer :: ParsecT [Tok] u m Tok
closer = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'?' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
  forall s u (m :: * -> *) a b.
ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m ()
skipManyTill (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType TokType
LineEnd)) forall {u}. ParsecT [Tok] u m Tok
closer
endCond Int
4 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$
  forall s u (m :: * -> *) a b.
ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m ()
skipManyTill (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType TokType
LineEnd)) (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>')
endCond Int
5 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  let closer :: ParsecT [Tok] u m Tok
closer = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
']' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
  forall s u (m :: * -> *) a b.
ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m ()
skipManyTill (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType TokType
LineEnd)) forall {u}. ParsecT [Tok] u m Tok
closer
endCond Int
6 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
endCond Int
7 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
endCond Int
n = forall (m :: * -> *) a. MonadFail m => SourceName -> m a
fail forall a b. (a -> b) -> a -> b
$ SourceName
"Unknown HTML block type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> SourceName
show Int
n

--------------------------------

getBlockText :: BlockNode m il bl -> [Tok]
getBlockText :: forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
rootLabel

removeIndent :: [Tok] -> [Tok]
removeIndent :: [Tok] -> [Tok]
removeIndent = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)

removeConsecutive :: [Int] -> [Int]
removeConsecutive :: [Int] -> [Int]
removeConsecutive (Int
x:Int
y:[Int]
zs)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
y forall a. Num a => a -> a -> a
+ Int
1 = [Int] -> [Int]
removeConsecutive (Int
yforall a. a -> [a] -> [a]
:[Int]
zs)
removeConsecutive [Int]
xs = [Int]
xs

-------------------------------------------------------------------------

collapseNodeStack :: [BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
collapseNodeStack :: forall (m :: * -> *) il bl.
[BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
collapseNodeStack [] = forall a. HasCallStack => SourceName -> a
error SourceName
"Empty node stack!"  -- should not happen
collapseNodeStack (BlockNode m il bl
n:[BlockNode m il bl]
ns) = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *} {il} {bl}.
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
go BlockNode m il bl
n [BlockNode m il bl]
ns
  where go :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
go BlockNode m il bl
child BlockNode m il bl
parent
         = if forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockSpec m il bl -> Bool
blockCanContain (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
parent) (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
child)
              then forall (m :: * -> *) il bl.
BlockSpec m il bl
-> BlockNode m il bl
-> BlockNode m il bl
-> BlockParser m il bl (BlockNode m il bl)
blockFinalize (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
child) BlockNode m il bl
child BlockNode m il bl
parent
              else forall a. HasCallStack => SourceName -> a
error forall a b. (a -> b) -> a -> b
$ SourceName
"collapseNodeStack: " forall a. [a] -> [a] -> [a]
++
                     Text -> SourceName
T.unpack (forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
parent)) forall a. [a] -> [a] -> [a]
++
                     SourceName
" cannot contain " forall a. [a] -> [a] -> [a]
++ Text -> SourceName
T.unpack (forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
child))

bspec :: BlockNode m il bl -> BlockSpec m il bl
bspec :: forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec = forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
rootLabel

endOfBlock :: Monad m => BlockParser m il bl ()
endOfBlock :: forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ()
endOfBlock = forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st -> BPState m il bl
st{ blockMatched :: Bool
blockMatched = Bool
False }