{-# 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 :: [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 specs :: [BlockSpec m il bl]
specs finalParsers :: [BlockParser m il bl bl]
finalParsers ilParser :: ReferenceMap -> [Tok] -> m (Either ParseError il)
ilParser attrParsers :: [BlockParser m il bl Attributes]
attrParsers ts :: [Tok]
ts =
  BlockParser m il bl bl
-> BPState m il bl
-> SourceName
-> [Tok]
-> m (Either ParseError bl)
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
                   (t :: Tok
t:_) -> SourcePos -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (Tok -> SourcePos
tokPos Tok
t)
                   []    -> () -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                 [BlockSpec m il bl]
-> [BlockParser m il bl bl] -> BlockParser m il bl bl
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)
          $WBPState :: forall (m :: * -> *) il bl.
ReferenceMap
-> (ReferenceMap -> [Tok] -> m (Either ParseError il))
-> [BlockNode m il bl]
-> Bool
-> Bool
-> Bool
-> Map Text Dynamic
-> Map Text SourcePos
-> [ParsecT [Tok] (BPState m il bl) m Attributes]
-> Attributes
-> BPState m il bl
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        = [BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
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         = Map Text Dynamic
forall k a. Map k a
M.empty
                 , failurePositions :: Map Text SourcePos
failurePositions = Map Text SourcePos
forall k a. Map k a
M.empty
                 , attributeParsers :: [BlockParser m il bl Attributes]
attributeParsers = [BlockParser m il bl Attributes]
attrParsers
                 , nextAttributes :: Attributes
nextAttributes   = Attributes
forall a. Monoid a => a
mempty
                 }
          "source" ([Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts Int -> [Tok] -> [Tok]
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 :: [BlockSpec m il bl]
-> [BlockParser m il bl bl] -> BlockParser m il bl bl
processLines specs :: [BlockSpec m il bl]
specs finalParsers :: [BlockParser m il bl bl]
finalParsers = {-# SCC processLines #-} do
  let go :: ParsecT [Tok] (BPState m il bl) m ()
go = ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([BlockSpec m il bl] -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl] -> BlockParser m il bl ()
processLine [BlockSpec m il bl]
specs ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
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 <- ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> (BPState m il bl
    -> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl))
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [BlockNode m il bl]
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
forall (m :: * -> *) il bl.
[BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
collapseNodeStack ([BlockNode m il bl]
 -> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl))
-> (BPState m il bl -> [BlockNode m il bl])
-> BPState m il bl
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BPState m il bl -> [BlockNode m il bl]
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack
  (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ \st :: BPState m il bl
st -> BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack = [BlockNode m il bl -> BlockNode m il bl
forall a. Tree a -> Tree a
reverseSubforests BlockNode m il bl
tree] }
  bl
endContent <- [bl] -> bl
forall a. Monoid a => [a] -> a
mconcat ([bl] -> bl)
-> ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BlockParser m il bl bl] -> ParsecT [Tok] (BPState m il bl) m [bl]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [BlockParser m il bl bl]
finalParsers
  tree' :: BlockNode m il bl
tree':_ <- BPState m il bl -> [BlockNode m il bl]
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m il bl -> [BlockNode m il bl])
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m [BlockNode m il bl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  bl
body <- BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
blockConstructor (BlockData m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
tree')) BlockNode m il bl
tree'
  bl -> BlockParser m il bl bl
forall (m :: * -> *) a. Monad m => a -> m a
return (bl -> BlockParser m il bl bl) -> bl -> BlockParser m il bl bl
forall a b. (a -> b) -> a -> b
$! bl
body bl -> bl -> bl
forall a. Semigroup a => a -> a -> a
<> bl
endContent

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

processLine :: (Monad m, IsBlock il bl)
            => [BlockSpec m il bl] -> BlockParser m il bl ()
processLine :: [BlockSpec m il bl] -> BlockParser m il bl ()
processLine specs :: [BlockSpec m il bl]
specs = do
  -- check block continuations for each node in stack
  BPState m il bl
st' <- ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  BPState m il bl -> BlockParser m il bl ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState (BPState m il bl -> BlockParser m il bl ())
-> BPState m il bl -> BlockParser m il bl ()
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 = Map Text SourcePos
forall k a. Map k a
M.empty }
  (matched :: [BlockNode m il bl]
matched, unmatched :: [BlockNode m il bl]
unmatched) <-  (BlockNode m il bl
 -> ([BlockNode m il bl], [BlockNode m il bl])
 -> ParsecT
      [Tok]
      (BPState m il bl)
      m
      ([BlockNode m il bl], [BlockNode m il bl]))
-> ([BlockNode m il bl], [BlockNode m il bl])
-> [BlockNode m il bl]
-> ParsecT
     [Tok]
     (BPState m il bl)
     m
     ([BlockNode m il bl], [BlockNode m il bl])
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM BlockNode m il bl
-> ([BlockNode m il bl], [BlockNode m il bl])
-> ParsecT
     [Tok]
     (BPState m il bl)
     m
     ([BlockNode m il bl], [BlockNode m il bl])
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 ([],[]) (BPState m il bl -> [BlockNode m il bl]
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
  (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl) -> BlockParser m il bl ())
-> (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ \st :: BPState m il bl
st -> BPState m il bl
st{ maybeLazy :: Bool
maybeLazy = BPState m il bl -> Bool
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
          m :: BlockNode m il bl
m:_ -> BlockSpec m il bl -> Bool
forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (BlockNode m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
m)
          _   -> Bool
False }

  -- close unmatched blocks
  if [BlockNode m il bl] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BlockNode m il bl]
unmatched
    then (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl) -> BlockParser m il bl ())
-> (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ \st :: 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
              []   -> SourceName -> BlockParser m il bl ()
forall a. HasCallStack => SourceName -> a
error "no blocks matched"
              m :: BlockNode m il bl
m:ms :: [BlockNode m il bl]
ms -> do
                BlockNode m il bl
m' <- [BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
forall (m :: * -> *) il bl.
[BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
collapseNodeStack ([BlockNode m il bl]
unmatched [BlockNode m il bl] -> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. [a] -> [a] -> [a]
++ [BlockNode m il bl
m])
                (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl) -> BlockParser m il bl ())
-> (BPState m il bl -> BPState m il bl) -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ \st :: BPState m il bl
st -> BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack = BlockNode m il bl
m'BlockNode m il bl -> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. a -> [a] -> [a]
:[BlockNode m il bl]
ms }

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

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

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

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

doBlockStarts :: Monad m => [BlockSpec m il bl] -> BlockParser m il bl ()
doBlockStarts :: [BlockSpec m il bl] -> BlockParser m il bl ()
doBlockStarts specs :: [BlockSpec m il bl]
specs = do
  BPState m il bl
st' <- ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  SourcePos
initPos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let failurePosMap :: Map Text SourcePos
failurePosMap = BPState m il bl -> Map Text SourcePos
forall (m :: * -> *) il bl. BPState m il bl -> Map Text SourcePos
failurePositions BPState m il bl
st'
  let specs' :: [BlockSpec m il bl]
specs' = (BlockSpec m il bl -> [BlockSpec m il bl] -> [BlockSpec m il bl])
-> [BlockSpec m il bl]
-> [BlockSpec m il bl]
-> [BlockSpec m il bl]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\spec :: BlockSpec m il bl
spec sps :: [BlockSpec m il bl]
sps ->
                        case Text -> Map Text SourcePos -> Maybe SourcePos
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
spec) Map Text SourcePos
failurePosMap of
                          Just pos' :: SourcePos
pos' | SourcePos
initPos SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
pos' -> [BlockSpec m il bl]
sps
                          _ -> BlockSpec m il bl
specBlockSpec m il bl -> [BlockSpec m il bl] -> [BlockSpec m il bl]
forall a. a -> [a] -> [a]
:[BlockSpec m il bl]
sps) [] [BlockSpec m il bl]
specs
  SourcePos -> [BlockSpec m il bl] -> BlockParser m il bl ()
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 _ [] = ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  go initPos :: SourcePos
initPos (spec :: BlockSpec m il bl
spec:otherSpecs :: [BlockSpec m il bl]
otherSpecs) = ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
    State [Tok] (BPState m il bl)
pst <- ParsecT [Tok] (BPState m il bl) m (State [Tok] (BPState m il bl))
forall (m :: * -> *) s u. Monad m => ParsecT s u m (State s u)
getParserState
    BlockStartResult
res <- BlockSpec m il bl -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockParser m il bl BlockStartResult
blockStart BlockSpec m il bl
spec
    case BlockStartResult
res of
      BlockStartMatch -> () -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      BlockStartNoMatchBefore pos :: SourcePos
pos -> do
        State [Tok] (BPState m il bl)
-> ParsecT
     [Tok] (BPState m il bl) m (State [Tok] (BPState m il bl))
forall (m :: * -> *) s u.
Monad m =>
State s u -> ParsecT s u m (State s u)
setParserState State [Tok] (BPState m il bl)
pst
        Bool
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SourcePos
pos SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos
initPos) (ParsecT [Tok] (BPState m il bl) m ()
 -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$
          (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ \st :: BPState m il bl
st ->
             BPState m il bl
st{ failurePositions :: Map Text SourcePos
failurePositions =
                  Text -> SourcePos -> Map Text SourcePos -> Map Text SourcePos
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
spec)
                  SourcePos
pos (BPState m il bl -> Map Text SourcePos
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) ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
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 :: 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 nd :: BlockNode m il bl
nd (matched :: [BlockNode m il bl]
matched, unmatched :: [BlockNode m il bl]
unmatched) = do
  Bool
ismatched <- BPState m il bl -> Bool
forall (m :: * -> *) il bl. BPState m il bl -> Bool
blockMatched (BPState m il bl -> Bool)
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  if Bool
ismatched
     then
       {-# SCC blockContinues #-}
       (do (startpos :: SourcePos
startpos, Node bdata :: BlockData m il bl
bdata children :: [BlockNode m il bl]
children) <- BlockSpec m il bl
-> BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
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 -> BlockSpec m il bl
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' <- BPState m il bl -> Bool
forall (m :: * -> *) il bl. BPState m il bl -> Bool
blockMatched (BPState m il bl -> Bool)
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
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:
           Bool
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
matched' (ParsecT [Tok] (BPState m il bl) m ()
 -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$
             (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ \st :: 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 = BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
bdata{ blockStartPos :: [SourcePos]
blockStartPos =
                      SourcePos
startpos SourcePos -> [SourcePos] -> [SourcePos]
forall a. a -> [a] -> [a]
: BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos BlockData m il bl
bdata
                      } [BlockNode m il bl]
children
           ([BlockNode m il bl], [BlockNode m il bl])
-> BlockParser m il bl ([BlockNode m il bl], [BlockNode m il bl])
forall (m :: * -> *) a. Monad m => a -> m a
return (([BlockNode m il bl], [BlockNode m il bl])
 -> BlockParser m il bl ([BlockNode m il bl], [BlockNode m il bl]))
-> ([BlockNode m il bl], [BlockNode m il bl])
-> BlockParser m il bl ([BlockNode m il bl], [BlockNode m il bl])
forall a b. (a -> b) -> a -> b
$!
             if Bool
matched'
                then (BlockNode m il bl
newBlockNode m il bl -> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. a -> [a] -> [a]
:[BlockNode m il bl]
matched, [BlockNode m il bl]
unmatched)
                else ([BlockNode m il bl]
matched, BlockNode m il bl
newBlockNode m il bl -> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. a -> [a] -> [a]
:[BlockNode m il bl]
unmatched))
       BlockParser m il bl ([BlockNode m il bl], [BlockNode m il bl])
-> BlockParser m il bl ([BlockNode m il bl], [BlockNode m il bl])
-> BlockParser m il bl ([BlockNode m il bl], [BlockNode m il bl])
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
ndBlockNode m il bl -> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. a -> [a] -> [a]
:[BlockNode m il bl]
unmatched) ([BlockNode m il bl], [BlockNode m il bl])
-> ParsecT [Tok] (BPState m il bl) m ()
-> BlockParser m il bl ([BlockNode m il bl], [BlockNode m il bl])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\st :: BPState m il bl
st -> BPState m il bl
st{
                                         blockMatched :: Bool
blockMatched = Bool
False })
     else ([BlockNode m il bl], [BlockNode m il bl])
-> BlockParser m il bl ([BlockNode m il bl], [BlockNode m il bl])
forall (m :: * -> *) a. Monad m => a -> m a
return ([BlockNode m il bl]
matched, BlockNode m il bl
ndBlockNode m il bl -> [BlockNode m il bl] -> [BlockNode m il bl]
forall 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
(Int -> BlockStartResult -> ShowS)
-> (BlockStartResult -> SourceName)
-> ([BlockStartResult] -> ShowS)
-> Show BlockStartResult
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
(BlockStartResult -> BlockStartResult -> Bool)
-> (BlockStartResult -> BlockStartResult -> Bool)
-> Eq BlockStartResult
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
     { BlockSpec m il bl -> Text
blockType           :: !Text  -- ^ Descriptive name of block type
     , 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).
     , 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.
     , BlockSpec m il bl -> Bool
blockContainsLines  :: !Bool -- ^ True if this kind of block
                           -- can contain text lines.
     , BlockSpec m il bl -> Bool
blockParagraph      :: !Bool -- ^ True if this kind of block
                           -- is paragraph.
     , 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.
     , 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.
     , 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 bs :: BlockSpec m il bl
bs = "<BlockSpec " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> SourceName
T.unpack (BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
bs) SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ ">"

defaultBlockSpecs :: (Monad m, IsBlock il bl) => [BlockSpec m il bl]
defaultBlockSpecs :: [BlockSpec m il bl]
defaultBlockSpecs =
    [ BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
indentedCodeSpec
    , BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
fencedCodeSpec
    , BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
blockQuoteSpec
    , BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
atxHeadingSpec
    , BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
setextHeadingSpec
    , BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
thematicBreakSpec
    , BlockParser m il bl ListType -> BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockParser m il bl ListType -> BlockSpec m il bl
listItemSpec (BlockParser m il bl ListType
forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
bulletListMarker BlockParser m il bl ListType
-> BlockParser m il bl ListType -> BlockParser m il bl ListType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BlockParser m il bl ListType
forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
orderedListMarker)
    , BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
rawHtmlSpec
    , BlockSpec m il bl
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 :: 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 Text -> Attributes -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "id" (BlockData m il bl -> Attributes
forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
blockAttributes (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
child)) of
    Nothing -> () -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just !Text
ident -> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ \st :: BPState m il bl
st ->
      BPState m il bl
st{ counters :: Map Text Dynamic
counters = Text -> Dynamic -> Map Text Dynamic -> Map Text Dynamic
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ("identifier:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident)
          (Int -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (0 :: Int)) (BPState m il bl -> Map Text Dynamic
forall (m :: * -> *) il bl. BPState m il bl -> Map Text Dynamic
counters BPState m il bl
st) }
  BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! BlockNode m il bl
parent{ subForest :: Forest (BlockData m il bl)
subForest = BlockNode m il bl
child BlockNode m il bl
-> Forest (BlockData m il bl) -> Forest (BlockData m il bl)
forall a. a -> [a] -> [a]
: BlockNode m il bl -> Forest (BlockData m il bl)
forall a. Tree a -> Forest a
subForest BlockNode m il bl
parent }

data BlockData m il bl = BlockData
     { BlockData m il bl -> BlockSpec m il bl
blockSpec       :: BlockSpec m il bl
     , BlockData m il bl -> [[Tok]]
blockLines      :: [[Tok]]  -- in reverse order
     , BlockData m il bl -> [SourcePos]
blockStartPos   :: [SourcePos]  -- in reverse order
     , BlockData m il bl -> Dynamic
blockData       :: !Dynamic
     , BlockData m il bl -> [Int]
blockBlanks     :: [Int]  -- non-content blank lines in block
     , BlockData m il bl -> Attributes
blockAttributes :: !Attributes
     }
  deriving Int -> BlockData m il bl -> ShowS
[BlockData m il bl] -> ShowS
BlockData m il bl -> SourceName
(Int -> BlockData m il bl -> ShowS)
-> (BlockData m il bl -> SourceName)
-> ([BlockData m il bl] -> ShowS)
-> Show (BlockData m il bl)
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 :: BlockSpec m il bl -> BlockData m il bl
defBlockData spec :: BlockSpec m il bl
spec = $WBlockData :: forall (m :: * -> *) il bl.
BlockSpec m il bl
-> [[Tok]]
-> [SourcePos]
-> Dynamic
-> [Int]
-> Attributes
-> BlockData m il bl
BlockData
    { blockSpec :: BlockSpec m il bl
blockSpec     = BlockSpec m il bl
spec
    , blockLines :: [[Tok]]
blockLines    = []
    , blockStartPos :: [SourcePos]
blockStartPos = []
    , blockData :: Dynamic
blockData     = () -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn ()
    , blockBlanks :: [Int]
blockBlanks   = []
    , blockAttributes :: Attributes
blockAttributes = Attributes
forall a. Monoid a => a
mempty
    }

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

data BPState m il bl = BPState
     { BPState m il bl -> ReferenceMap
referenceMap     :: !ReferenceMap
     , BPState m il bl
-> ReferenceMap -> [Tok] -> m (Either ParseError il)
inlineParser     :: ReferenceMap -> [Tok] -> m (Either ParseError il)
     , BPState m il bl -> [BlockNode m il bl]
nodeStack        :: [BlockNode m il bl]   -- reverse order, head is tip
     , BPState m il bl -> Bool
blockMatched     :: !Bool
     , BPState m il bl -> Bool
maybeLazy        :: !Bool
     , BPState m il bl -> Bool
maybeBlank       :: !Bool
     , BPState m il bl -> Map Text Dynamic
counters         :: M.Map Text Dynamic
     , BPState m il bl -> Map Text SourcePos
failurePositions :: M.Map Text SourcePos  -- record known positions
                           -- where parsers fail to avoid repetition
     , BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
attributeParsers :: [ParsecT [Tok] (BPState m il bl) m Attributes]
     , 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
(Int -> ListData -> ShowS)
-> (ListData -> SourceName)
-> ([ListData] -> ShowS)
-> Show ListData
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
(ListData -> ListData -> Bool)
-> (ListData -> ListData -> Bool) -> Eq ListData
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
(Int -> ListItemData -> ShowS)
-> (ListItemData -> SourceName)
-> ([ListItemData] -> ShowS)
-> Show ListItemData
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
(ListItemData -> ListItemData -> Bool)
-> (ListItemData -> ListItemData -> Bool) -> Eq ListItemData
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 :: BlockParser m il bl (Maybe ListType)
getParentListType = do
  (cur :: BlockNode m il bl
cur:_) <- BPState m il bl -> [BlockNode m il bl]
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m il bl -> [BlockNode m il bl])
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m [BlockNode m il bl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  if BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (BlockNode m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
cur) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "List"
     then do
       let ListData lt :: ListType
lt _ = Dynamic -> ListData -> ListData
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
cur))
                            (ListType -> ListSpacing -> ListData
ListData (Char -> ListType
BulletList '*') ListSpacing
TightList)
       Maybe ListType -> BlockParser m il bl (Maybe ListType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ListType -> BlockParser m il bl (Maybe ListType))
-> Maybe ListType -> BlockParser m il bl (Maybe ListType)
forall a b. (a -> b) -> a -> b
$ ListType -> Maybe ListType
forall a. a -> Maybe a
Just ListType
lt
     else Maybe ListType -> BlockParser m il bl (Maybe ListType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListType
forall a. Maybe a
Nothing

runInlineParser :: Monad m
                => [Tok]
                -> BlockParser m il bl il
runInlineParser :: [Tok] -> BlockParser m il bl il
runInlineParser toks :: [Tok]
toks = {-# SCC runInlineParser #-} do
  ReferenceMap
refmap <- BPState m il bl -> ReferenceMap
forall (m :: * -> *) il bl. BPState m il bl -> ReferenceMap
referenceMap (BPState m il bl -> ReferenceMap)
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ReferenceMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  ReferenceMap -> [Tok] -> m (Either ParseError il)
ilParser <- BPState m il bl
-> ReferenceMap -> [Tok] -> m (Either ParseError il)
forall (m :: * -> *) il bl.
BPState m il bl
-> ReferenceMap -> [Tok] -> m (Either ParseError il)
inlineParser (BPState m il bl
 -> ReferenceMap -> [Tok] -> m (Either ParseError il))
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT
     [Tok]
     (BPState m il bl)
     m
     (ReferenceMap -> [Tok] -> m (Either ParseError il))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Either ParseError il
res <- m (Either ParseError il)
-> ParsecT [Tok] (BPState m il bl) m (Either ParseError il)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either ParseError il)
 -> ParsecT [Tok] (BPState m il bl) m (Either ParseError il))
-> m (Either ParseError il)
-> ParsecT [Tok] (BPState m il bl) m (Either ParseError il)
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 ils :: il
ils -> il -> BlockParser m il bl il
forall (m :: * -> *) a. Monad m => a -> m a
return (il -> BlockParser m il bl il) -> il -> BlockParser m il bl il
forall a b. (a -> b) -> a -> b
$! il
ils
       Left err :: ParseError
err  -> (State [Tok] (BPState m il bl)
 -> m (Consumed (m (Reply [Tok] (BPState m il bl) il))))
-> BlockParser m il bl il
forall (m :: * -> *) s u a.
Monad m =>
(State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT (\_ -> Consumed (m (Reply [Tok] (BPState m il bl) il))
-> m (Consumed (m (Reply [Tok] (BPState m il bl) il)))
forall (m :: * -> *) a. Monad m => a -> m a
return (m (Reply [Tok] (BPState m il bl) il)
-> Consumed (m (Reply [Tok] (BPState m il bl) il))
forall a. a -> Consumed a
Empty (Reply [Tok] (BPState m il bl) il
-> m (Reply [Tok] (BPState m il bl) il)
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseError -> Reply [Tok] (BPState m il bl) il
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 :: BlockNode m il bl -> bl -> bl
addRange (Node b :: BlockData m il bl
b _)
 = SourceRange -> bl -> bl
forall a. Rangeable a => SourceRange -> a -> a
ranged ([(SourcePos, SourcePos)] -> SourceRange
SourceRange
            ([(SourcePos, SourcePos)] -> [(SourcePos, SourcePos)]
forall b. Eq b => [(b, b)] -> [(b, b)]
go ([(SourcePos, SourcePos)] -> [(SourcePos, SourcePos)])
-> ([(SourcePos, SourcePos)] -> [(SourcePos, SourcePos)])
-> [(SourcePos, SourcePos)]
-> [(SourcePos, SourcePos)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SourcePos, SourcePos)] -> [(SourcePos, SourcePos)]
forall a. [a] -> [a]
reverse ([(SourcePos, SourcePos)] -> [(SourcePos, SourcePos)])
-> [(SourcePos, SourcePos)] -> [(SourcePos, SourcePos)]
forall a b. (a -> b) -> a -> b
$ (SourcePos -> (SourcePos, SourcePos))
-> [SourcePos] -> [(SourcePos, SourcePos)]
forall a b. (a -> b) -> [a] -> [b]
map (\pos :: SourcePos
pos ->
                                  (SourcePos
pos, SourcePos -> Int -> SourcePos
setSourceColumn
                                         (SourcePos -> Int -> SourcePos
incSourceLine SourcePos
pos 1) 1))
                                (BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos BlockData m il bl
b)))
   where
     go :: [(b, b)] -> [(b, b)]
go [] = []
     go ((!b
startpos1, !b
endpos1):(!b
startpos2, !b
endpos2):rest :: [(b, b)]
rest)
       | b
startpos1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
startpos2
       , b
endpos1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
endpos2   = [(b, b)] -> [(b, b)]
go ((b
startpos1, b
endpos2)(b, b) -> [(b, b)] -> [(b, b)]
forall a. a -> [a] -> [a]
:[(b, b)]
rest)
       | b
endpos1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
startpos2 = [(b, b)] -> [(b, b)]
go ((b
startpos1, b
endpos2)(b, b) -> [(b, b)] -> [(b, b)]
forall a. a -> [a] -> [a]
:[(b, b)]
rest)
     go (x :: (b, b)
x:xs :: [(b, b)]
xs) = (b, b)
x (b, b) -> [(b, b)] -> [(b, b)]
forall a. a -> [a] -> [a]
: [(b, b)] -> [(b, b)]
go [(b, b)]
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 :: BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack node :: BlockNode m bl il
node = do
  (cur :: BlockNode m bl il
cur:rest :: [BlockNode m bl il]
rest) <- BPState m bl il -> [BlockNode m bl il]
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m bl il -> [BlockNode m bl il])
-> ParsecT [Tok] (BPState m bl il) m (BPState m bl il)
-> ParsecT [Tok] (BPState m bl il) m [BlockNode m bl il]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m bl il) m (BPState m bl il)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool -> BlockParser m bl il ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> BlockParser m bl il ()) -> Bool -> BlockParser m bl il ()
forall a b. (a -> b) -> a -> b
$ BlockSpec m bl il -> Bool
forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (BlockNode m bl il -> BlockSpec m bl il
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m bl il
cur) Bool -> Bool -> Bool
|| Bool -> Bool
not (BlockSpec m bl il -> Bool
forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockContainsLines (BlockNode m bl il -> BlockSpec m bl il
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m bl il
cur))
  if BlockSpec m bl il -> BlockSpec m bl il -> Bool
forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockSpec m il bl -> Bool
blockCanContain (BlockNode m bl il -> BlockSpec m bl il
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m bl il
cur) (BlockNode m bl il -> BlockSpec m bl il
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m bl il
node)
     then do
       Attributes
nextAttr <- BPState m bl il -> Attributes
forall (m :: * -> *) il bl. BPState m il bl -> Attributes
nextAttributes (BPState m bl il -> Attributes)
-> ParsecT [Tok] (BPState m bl il) m (BPState m bl il)
-> ParsecT [Tok] (BPState m bl il) m Attributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m bl il) m (BPState m bl il)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
       let node' :: BlockNode m bl il
node' = if Attributes -> Bool
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 = BlockNode m bl il -> BlockData m bl il
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
                                }}
       (BPState m bl il -> BPState m bl il) -> BlockParser m bl il ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m bl il -> BPState m bl il) -> BlockParser m bl il ())
-> (BPState m bl il -> BPState m bl il) -> BlockParser m bl il ()
forall a b. (a -> b) -> a -> b
$ \st :: BPState m bl il
st ->
            BPState m bl il
st{ nextAttributes :: Attributes
nextAttributes = Attributes
forall a. Monoid a => a
mempty
              , nodeStack :: [BlockNode m bl il]
nodeStack = BlockNode m bl il
node' BlockNode m bl il -> [BlockNode m bl il] -> [BlockNode m bl il]
forall a. a -> [a] -> [a]
: BlockNode m bl il
cur BlockNode m bl il -> [BlockNode m bl il] -> [BlockNode m bl il]
forall a. a -> [a] -> [a]
: [BlockNode m bl il]
rest
              , maybeLazy :: Bool
maybeLazy = Bool
False }
     else case [BlockNode m bl il]
rest of
              (x :: BlockNode m bl il
x:xs :: [BlockNode m bl il]
xs) -> do
                [BlockNode m bl il]
stack <- (BlockNode m bl il -> [BlockNode m bl il] -> [BlockNode m bl il]
forall a. a -> [a] -> [a]
:[BlockNode m bl il]
xs) (BlockNode m bl il -> [BlockNode m bl il])
-> ParsecT [Tok] (BPState m bl il) m (BlockNode m bl il)
-> ParsecT [Tok] (BPState m bl il) m [BlockNode m bl il]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BlockNode m bl il]
-> ParsecT [Tok] (BPState m bl il) m (BlockNode m bl il)
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]
                (BPState m bl il -> BPState m bl il) -> BlockParser m bl il ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m bl il -> BPState m bl il) -> BlockParser m bl il ())
-> (BPState m bl il -> BPState m bl il) -> BlockParser m bl il ()
forall a b. (a -> b) -> a -> b
$ \st :: BPState m bl il
st -> BPState m bl il
st{ nodeStack :: [BlockNode m bl il]
nodeStack = [BlockNode m bl il]
stack }
                BlockNode m bl il -> BlockParser m bl il ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m bl il
node
              _ -> BlockParser m bl il ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero

interruptsParagraph :: Monad m => BlockParser m bl il Bool
interruptsParagraph :: BlockParser m bl il Bool
interruptsParagraph = do
  (cur :: BlockNode m bl il
cur:_) <- BPState m bl il -> [BlockNode m bl il]
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m bl il -> [BlockNode m bl il])
-> ParsecT [Tok] (BPState m bl il) m (BPState m bl il)
-> ParsecT [Tok] (BPState m bl il) m [BlockNode m bl il]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m bl il) m (BPState m bl il)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool -> BlockParser m bl il Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> BlockParser m bl il Bool)
-> Bool -> BlockParser m bl il Bool
forall a b. (a -> b) -> a -> b
$! BlockSpec m bl il -> Bool
forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (BlockNode m bl il -> BlockSpec m bl il
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 :: BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren node :: BlockNode m il bl
node = (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m bl)
-> [BlockNode m il bl] -> BlockParser m il bl [bl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m bl
renderC ([BlockNode m il bl] -> BlockParser m il bl [bl])
-> [BlockNode m il bl] -> BlockParser m il bl [bl]
forall a b. (a -> b) -> a -> b
$ BlockNode m il bl -> [BlockNode m il bl]
forall a. Tree a -> Forest a
subForest BlockNode m il bl
node
  where
    renderC :: BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m bl
renderC n :: BlockNode m il bl
n = do
      let attrs :: Attributes
attrs = BlockData m il bl -> Attributes
forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
blockAttributes (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
n)
      (if Attributes -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Attributes
attrs
          then bl -> bl
forall a. a -> a
id
          else Attributes -> bl -> bl
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs) (bl -> bl) -> (bl -> bl) -> bl -> bl
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        BlockNode m il bl -> bl -> bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> bl -> bl
addRange BlockNode m il bl
n (bl -> bl)
-> ParsecT [Tok] (BPState m il bl) m bl
-> ParsecT [Tok] (BPState m il bl) m bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockSpec m il bl
-> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m bl
forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
blockConstructor (BlockData m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
n)) BlockNode m il bl
n

docSpec :: (Monad m, IsBlock il bl, Monoid bl) => BlockSpec m il bl
docSpec :: BlockSpec m il bl
docSpec = $WBlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = "Doc"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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       = \n :: BlockNode m il bl
n -> (,BlockNode m il bl
n) (SourcePos -> (SourcePos, BlockNode m il bl))
-> ParsecT [Tok] (BPState m il bl) m SourcePos
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = ([bl] -> bl)
-> ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [bl] -> bl
forall a. Monoid a => [a] -> a
mconcat (ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl)
-> (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m [bl])
-> BlockNode m il bl
-> BlockParser m il bl bl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m [bl]
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       = BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
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 :: BlockSpec m il bl
refLinkDefSpec = $WBlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = "ReferenceLinkDefinition"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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       = BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. a -> b -> a
const BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \node :: BlockNode m il bl
node -> do
         let linkdefs :: [((SourceRange, Text), LinkInfo)]
linkdefs = Dynamic
-> [((SourceRange, Text), LinkInfo)]
-> [((SourceRange, Text), LinkInfo)]
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                  [((SourceRange, Text), LinkInfo)]
forall a. HasCallStack => a
undefined :: [((SourceRange, Text), LinkInfo)]
         bl -> BlockParser m il bl bl
forall (m :: * -> *) a. Monad m => a -> m a
return (bl -> BlockParser m il bl bl) -> bl -> BlockParser m il bl bl
forall a b. (a -> b) -> a -> b
$! [bl] -> bl
forall a. Monoid a => [a] -> a
mconcat ([bl] -> bl) -> [bl] -> bl
forall a b. (a -> b) -> a -> b
$ (((SourceRange, Text), LinkInfo) -> bl)
-> [((SourceRange, Text), LinkInfo)] -> [bl]
forall a b. (a -> b) -> [a] -> [b]
map (\((range :: SourceRange
range, lab :: Text
lab), linkinfo :: LinkInfo
linkinfo) ->
            SourceRange -> bl -> bl
forall a. Rangeable a => SourceRange -> a -> a
ranged SourceRange
range
              (Attributes -> bl -> bl
forall a. HasAttributes a => Attributes -> a -> a
addAttributes (LinkInfo -> Attributes
linkAttributes LinkInfo
linkinfo)
                (Text -> (Text, Text) -> bl
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       = BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
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 :: BlockNode m il bl
-> BlockParser
     m il bl (Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
extractReferenceLinks node :: BlockNode m il bl
node = do
  BPState m il bl
st <- ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Either ParseError ([((SourceRange, Text), LinkInfo)], [Tok])
res <- m (Either ParseError ([((SourceRange, Text), LinkInfo)], [Tok]))
-> ParsecT
     [Tok]
     (BPState m il bl)
     m
     (Either ParseError ([((SourceRange, Text), LinkInfo)], [Tok]))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either ParseError ([((SourceRange, Text), LinkInfo)], [Tok]))
 -> ParsecT
      [Tok]
      (BPState m il bl)
      m
      (Either ParseError ([((SourceRange, Text), LinkInfo)], [Tok])))
-> m (Either ParseError ([((SourceRange, Text), LinkInfo)], [Tok]))
-> ParsecT
     [Tok]
     (BPState m il bl)
     m
     (Either ParseError ([((SourceRange, Text), LinkInfo)], [Tok]))
forall a b. (a -> b) -> a -> b
$ ParsecT
  [Tok]
  (BPState m il bl)
  m
  ([((SourceRange, Text), LinkInfo)], [Tok])
-> BPState m il bl
-> SourceName
-> [Tok]
-> m (Either ParseError ([((SourceRange, Text), LinkInfo)], [Tok]))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
runParserT ((,) ([((SourceRange, Text), LinkInfo)]
 -> [Tok] -> ([((SourceRange, Text), LinkInfo)], [Tok]))
-> ParsecT
     [Tok] (BPState m il bl) m [((SourceRange, Text), LinkInfo)]
-> ParsecT
     [Tok]
     (BPState m il bl)
     m
     ([Tok] -> ([((SourceRange, Text), LinkInfo)], [Tok]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok ParsecT [Tok] (BPState m il bl) m Tok
-> (Tok -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SourcePos -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> ParsecT [Tok] (BPState m il bl) m ())
-> (Tok -> SourcePos)
-> Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> SourcePos
tokPos) ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT
     [Tok] (BPState m il bl) m [((SourceRange, Text), LinkInfo)]
-> ParsecT
     [Tok] (BPState m il bl) m [((SourceRange, Text), LinkInfo)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                        ParsecT [Tok] (BPState m il bl) m ((SourceRange, Text), LinkInfo)
-> ParsecT
     [Tok] (BPState m il bl) m [((SourceRange, Text), LinkInfo)]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Tok] (BPState m il bl) m Attributes
-> ParsecT
     [Tok] (BPState m il bl) m ((SourceRange, Text), LinkInfo)
forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s m Attributes
-> ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
linkReferenceDef ([ParsecT [Tok] (BPState m il bl) m Attributes]
-> ParsecT [Tok] (BPState m il bl) m Attributes
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]
 -> ParsecT [Tok] (BPState m il bl) m Attributes)
-> [ParsecT [Tok] (BPState m il bl) m Attributes]
-> ParsecT [Tok] (BPState m il bl) m Attributes
forall a b. (a -> b) -> a -> b
$ BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
forall (m :: * -> *) il bl.
BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
attributeParsers BPState m il bl
st)))
                  ParsecT
  [Tok]
  (BPState m il bl)
  m
  ([Tok] -> ([((SourceRange, Text), LinkInfo)], [Tok]))
-> ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT
     [Tok]
     (BPState m il bl)
     m
     ([((SourceRange, Text), LinkInfo)], [Tok])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT [Tok] (BPState m il bl) m [Tok]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput) BPState m il bl
st "" (BlockNode m il bl -> [Tok]
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 _ -> (Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
-> BlockParser
     m il bl (Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockNode m il bl -> Maybe (BlockNode m il bl)
forall a. a -> Maybe a
Just BlockNode m il bl
node, Maybe (BlockNode m il bl)
forall a. Maybe a
Nothing)
        Right (linkdefs :: [((SourceRange, Text), LinkInfo)]
linkdefs, toks' :: [Tok]
toks') -> do
          (((SourceRange, Text), LinkInfo)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> [((SourceRange, Text), LinkInfo)]
-> ParsecT [Tok] (BPState m il bl) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
            (\((_,lab :: Text
lab),linkinfo :: LinkInfo
linkinfo) ->
             (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ \s :: BPState m il bl
s -> BPState m il bl
s{
              referenceMap :: ReferenceMap
referenceMap = Text -> LinkInfo -> ReferenceMap -> ReferenceMap
forall a. Typeable a => Text -> a -> ReferenceMap -> ReferenceMap
insertReference Text
lab LinkInfo
linkinfo
                (BPState m il bl -> ReferenceMap
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
                           (t :: Tok
t:_) -> (SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< Tok -> SourcePos
tokPos Tok
t)
                           _     -> Bool -> SourcePos -> Bool
forall a b. a -> b -> a
const Bool
False
          let node' :: Maybe (BlockNode m il bl)
node' = if [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tok]
toks'
                         then Maybe (BlockNode m il bl)
forall a. Maybe a
Nothing
                         else BlockNode m il bl -> Maybe (BlockNode m il bl)
forall a. a -> Maybe a
Just BlockNode m il bl
node{ rootLabel :: BlockData m il bl
rootLabel =
                              (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node){
                                blockLines :: [[Tok]]
blockLines = [[Tok]
toks'],
                                blockStartPos :: [SourcePos]
blockStartPos = (SourcePos -> Bool) -> [SourcePos] -> [SourcePos]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile SourcePos -> Bool
isRefPos
                                   (BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (BlockNode m il bl -> BlockData m il bl
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 =
                 (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node){
                     blockLines :: [[Tok]]
blockLines = ([Tok] -> Bool) -> [[Tok]] -> [[Tok]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Tok -> Bool) -> [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (SourcePos -> Bool
isRefPos (SourcePos -> Bool) -> (Tok -> SourcePos) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok -> SourcePos
tokPos))
                       (BlockData m il bl -> [[Tok]]
forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                   , blockStartPos :: [SourcePos]
blockStartPos = (SourcePos -> Bool) -> [SourcePos] -> [SourcePos]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile SourcePos -> Bool
isRefPos
                       (BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                   , blockData :: Dynamic
blockData = [((SourceRange, Text), LinkInfo)] -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn [((SourceRange, Text), LinkInfo)]
linkdefs
                   , blockSpec :: BlockSpec m il bl
blockSpec = BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
refLinkDefSpec
                 }}
          (Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
-> BlockParser
     m il bl (Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (BlockNode m il bl)
node', BlockNode m il bl -> Maybe (BlockNode m il bl)
forall a. a -> Maybe a
Just BlockNode m il bl
refnode)

attributeSpec :: (Monad m, IsBlock il bl)
              => BlockSpec m il bl
attributeSpec :: BlockSpec m il bl
attributeSpec = $WBlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = "Attribute"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
         [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers <- BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
forall (m :: * -> *) il bl.
BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
attributeParsers (BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes])
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT
     [Tok]
     (BPState m il bl)
     m
     [ParsecT [Tok] (BPState m il bl) m Attributes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
         Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not ([ParsecT [Tok] (BPState m il bl) m Attributes] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers)
         BlockParser m il bl Bool
forall (m :: * -> *) bl il. Monad m => BlockParser m bl il Bool
interruptsParagraph BlockParser m il bl Bool
-> (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> (Bool -> Bool) -> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
         ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
         SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         Attributes
attrs <- [ParsecT [Tok] (BPState m il bl) m Attributes]
-> ParsecT [Tok] (BPState m il bl) m Attributes
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
         (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
         ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
         BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ())
-> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$
           BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
attributeSpec){
                     blockData :: Dynamic
blockData = Attributes -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Attributes
attrs,
                     blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
         BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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       = \n :: BlockNode m il bl
n -> do
         [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers <- BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
forall (m :: * -> *) il bl.
BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
attributeParsers (BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes])
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT
     [Tok]
     (BPState m il bl)
     m
     [ParsecT [Tok] (BPState m il bl) m Attributes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
         Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not ([ParsecT [Tok] (BPState m il bl) m Attributes] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers)
         ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
         SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         Attributes
attrs <- [ParsecT [Tok] (BPState m il bl) m Attributes]
-> ParsecT [Tok] (BPState m il bl) m Attributes
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
         (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
         ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
         let oldattrs :: Attributes
oldattrs = Dynamic -> Attributes -> Attributes
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
n)) Attributes
forall a. Monoid a => a
mempty :: Attributes
         let attrs' :: Attributes
attrs' = Attributes
oldattrs Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
attrs
         (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return  (SourcePos
pos, BlockNode m il bl
n{ rootLabel :: BlockData m il bl
rootLabel = (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
n){
                          blockData :: Dynamic
blockData = Attributes -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Attributes
attrs' }})
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \_ -> bl -> BlockParser m il bl bl
forall (m :: * -> *) a. Monad m => a -> m a
return (bl -> BlockParser m il bl bl) -> bl -> BlockParser m il bl bl
forall a b. (a -> b) -> a -> b
$! bl
forall a. Monoid a => a
mempty
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = \node :: BlockNode m il bl
node parent :: BlockNode m il bl
parent -> do
         let attrs :: Attributes
attrs = Dynamic -> Attributes -> Attributes
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node)) Attributes
forall a. Monoid a => a
mempty :: Attributes
         (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ \st :: BPState m il bl
st -> BPState m il bl
st{ nextAttributes :: Attributes
nextAttributes = Attributes
attrs }
         BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
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 :: BlockSpec m il bl
paraSpec = $WBlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = "Paragraph"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             BlockParser m il bl Bool
forall (m :: * -> *) bl il. Monad m => BlockParser m bl il Bool
interruptsParagraph BlockParser m il bl Bool
-> (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> (Bool -> Bool) -> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
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 Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
             BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ())
-> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$
               BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec){
                       blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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       = \n :: BlockNode m il bl
n -> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (BlockParser m il bl (SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$ BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (BlockParser m il bl (SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$ do
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
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 Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
             (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
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    = \node :: BlockNode m il bl
node ->
         il -> bl
forall il b. IsBlock il b => il -> b
paragraph (il -> bl)
-> ParsecT [Tok] (BPState m il bl) m il -> BlockParser m il bl bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tok] -> ParsecT [Tok] (BPState m il bl) m il
forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (BlockNode m il bl -> [Tok]
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       = \child :: BlockNode m il bl
child parent :: BlockNode m il bl
parent -> do
         (mbchild :: Maybe (BlockNode m il bl)
mbchild, mbrefdefs :: Maybe (BlockNode m il bl)
mbrefdefs) <- BlockNode m il bl
-> BlockParser
     m il bl (Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
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
           (_, Nothing) -> BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
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
           (Nothing, Just refnode :: BlockNode m il bl
refnode)
                        -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! BlockNode m il bl
parent{ subForest :: Forest (BlockData m il bl)
subForest =
                                          BlockNode m il bl
refnode BlockNode m il bl
-> Forest (BlockData m il bl) -> Forest (BlockData m il bl)
forall a. a -> [a] -> [a]
: BlockNode m il bl -> Forest (BlockData m il bl)
forall a. Tree a -> Forest a
subForest BlockNode m il bl
parent }
           (Just child' :: BlockNode m il bl
child', Just refnode :: BlockNode m il bl
refnode)
                        -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! BlockNode m il bl
parent{ subForest :: Forest (BlockData m il bl)
subForest =
                                        BlockNode m il bl
child' BlockNode m il bl
-> Forest (BlockData m il bl) -> Forest (BlockData m il bl)
forall a. a -> [a] -> [a]
: BlockNode m il bl
refnode BlockNode m il bl
-> Forest (BlockData m il bl) -> Forest (BlockData m il bl)
forall a. a -> [a] -> [a]
: BlockNode m il bl -> Forest (BlockData m il bl)
forall a. Tree a -> Forest a
subForest BlockNode m il bl
parent }
     }

plainSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
plainSpec :: BlockSpec m il bl
plainSpec = BlockSpec m il bl
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    = \node :: BlockNode m il bl
node ->
         il -> bl
forall il b. IsBlock il b => il -> b
plain (il -> bl)
-> ParsecT [Tok] (BPState m il bl) m il -> BlockParser m il bl bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tok] -> ParsecT [Tok] (BPState m il bl) m il
forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (BlockNode m il bl -> [Tok]
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 :: ParsecT [Tok] s m Attributes
-> ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
linkReferenceDef attrParser :: ParsecT [Tok] s m Attributes
attrParser = ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
-> ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
 -> ParsecT [Tok] s m ((SourceRange, Text), LinkInfo))
-> ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
-> ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
forall a b. (a -> b) -> a -> b
$ do
  SourcePos
startpos <- ParsecT [Tok] s m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Text
lab <- ParsecT [Tok] s m Text
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Text
pLinkLabel
  Bool -> ParsecT [Tok] s m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] s m ()) -> Bool -> ParsecT [Tok] s m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
lab
  Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol ':'
  ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  SourcePos
linkpos <- ParsecT [Tok] s m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  [Tok]
dest <- ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pLinkDestination
  (title :: [Tok]
title, attrs :: Attributes
attrs) <- ([Tok], Attributes)
-> ParsecT [Tok] s m ([Tok], Attributes)
-> ParsecT [Tok] s m ([Tok], Attributes)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option ([Tok]
forall a. Monoid a => a
mempty, Attributes
forall a. Monoid a => a
mempty) (ParsecT [Tok] s m ([Tok], Attributes)
 -> ParsecT [Tok] s m ([Tok], Attributes))
-> ParsecT [Tok] s m ([Tok], Attributes)
-> ParsecT [Tok] s m ([Tok], Attributes)
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] s m ([Tok], Attributes)
-> ParsecT [Tok] s m ([Tok], Attributes)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m ([Tok], Attributes)
 -> ParsecT [Tok] s m ([Tok], Attributes))
-> ParsecT [Tok] s m ([Tok], Attributes)
-> ParsecT [Tok] s m ([Tok], Attributes)
forall a b. (a -> b) -> a -> b
$ do
             [Tok]
tit <- [Tok] -> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Tok]
forall a. Monoid a => a
mempty (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pLinkTitle)
             (Tok -> Bool) -> ParsecT [Tok] s m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             Attributes
as <- Attributes
-> ParsecT [Tok] s m Attributes -> ParsecT [Tok] s m Attributes
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Attributes
forall a. Monoid a => a
mempty ParsecT [Tok] s m Attributes
attrParser
             (Tok -> Bool) -> ParsecT [Tok] s m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             ParsecT [Tok] s m () -> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] s m Tok -> ParsecT [Tok] s m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd ParsecT [Tok] s m ()
-> ParsecT [Tok] s m () -> ParsecT [Tok] s m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
             ([Tok], Attributes) -> ParsecT [Tok] s m ([Tok], Attributes)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
tit, Attributes
as)
  SourcePos
endpos <- ParsecT [Tok] s m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ParsecT [Tok] s m Tok -> ParsecT [Tok] s m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd ParsecT [Tok] s m ()
-> ParsecT [Tok] s m () -> ParsecT [Tok] s m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  ((SourceRange, Text), LinkInfo)
-> ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (([(SourcePos, SourcePos)] -> SourceRange
SourceRange [(SourcePos
startpos, SourcePos
endpos)], Text
lab),
                $WLinkInfo :: Text -> Text -> Attributes -> Maybe SourcePos -> LinkInfo
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 = SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just SourcePos
linkpos })

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

setextHeadingSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
setextHeadingSpec :: BlockSpec m il bl
setextHeadingSpec = $WBlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = "SetextHeading"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             (cur :: BlockNode m il bl
cur:rest :: [BlockNode m il bl]
rest) <- BPState m il bl -> [BlockNode m il bl]
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m il bl -> [BlockNode m il bl])
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m [BlockNode m il bl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
             Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ BlockSpec m il bl -> Bool
forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (BlockNode m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
cur)
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             Int
level <- (2 :: Int) Int
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '-')
                  ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (1 :: Int) Int
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '=')
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd)
             -- process any reference links, make sure there's some
             -- content left
             (mbcur :: Maybe (BlockNode m il bl)
mbcur, mbrefdefs :: Maybe (BlockNode m il bl)
mbrefdefs) <- BlockNode m il bl
-> BlockParser
     m il bl (Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
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
             (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ \st :: BPState m il bl
st ->
                BPState m il bl
st{ nodeStack :: [BlockNode m il bl]
nodeStack = case Maybe (BlockNode m il bl)
mbrefdefs of
                                  Nothing -> [BlockNode m il bl]
rest
                                  Just rd :: BlockNode m il bl
rd -> case [BlockNode m il bl]
rest of
                                                (x :: BlockNode m il bl
x:xs :: [BlockNode m il bl]
xs) ->
                                                  BlockNode m il bl
x{ subForest :: [BlockNode m il bl]
subForest =
                                                      BlockNode m il bl
rd BlockNode m il bl -> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. a -> [a] -> [a]
: BlockNode m il bl -> [BlockNode m il bl]
forall a. Tree a -> Forest a
subForest BlockNode m il bl
x }BlockNode m il bl -> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. a -> [a] -> [a]
:[BlockNode m il bl]
xs
                                                [] -> [BlockNode m il bl
rd] }
             case Maybe (BlockNode m il bl)
mbcur of
               Nothing -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. MonadPlus m => m a
mzero -- should not happen
               Just cur' :: BlockNode m il bl
cur' -> do
                 -- replace cur with new setext heading node
                 BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ())
-> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$
                      BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
cur'){
                              blockSpec :: BlockSpec m il bl
blockSpec  = BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
setextHeadingSpec,
                              blockData :: Dynamic
blockData = Int -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Int
level,
                              blockStartPos :: [SourcePos]
blockStartPos =
                                   BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
cur') [SourcePos] -> [SourcePos] -> [SourcePos]
forall a. [a] -> [a] -> [a]
++ [SourcePos
pos] }
                                    []
                 BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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       = BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. a -> b -> a
const BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \node :: BlockNode m il bl
node -> do
         let level :: Int
level = Dynamic -> Int -> Int
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node)) 1
         il
ils <- [Tok] -> BlockParser m il bl il
forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (BlockNode m il bl -> [Tok]
forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node)
         bl -> BlockParser m il bl bl
forall (m :: * -> *) a. Monad m => a -> m a
return (bl -> BlockParser m il bl bl) -> bl -> BlockParser m il bl bl
forall a b. (a -> b) -> a -> b
$! Int -> il -> bl
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 cdata :: BlockData m il bl
cdata children :: [BlockNode m il bl]
children) parent :: BlockNode m il bl
parent -> do
         let oldAttr :: Attributes
oldAttr = BlockData m il bl -> Attributes
forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
blockAttributes BlockData m il bl
cdata
         let toks :: [Tok]
toks = BlockNode m il bl -> [Tok]
forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node
         (newtoks :: [Tok]
newtoks, attr :: Attributes
attr) <- Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
forall (m :: * -> *) il bl.
Monad m =>
Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
parseFinalAttributes Bool
True [Tok]
toks
                        BlockParser m il bl ([Tok], Attributes)
-> BlockParser m il bl ([Tok], Attributes)
-> BlockParser m il bl ([Tok], Attributes)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (([Tok], Attributes) -> BlockParser m il bl ([Tok], Attributes)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
toks, Attributes
forall a. Monoid a => a
mempty))
         BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
cdata{ blockAttributes :: Attributes
blockAttributes = Attributes
oldAttr Attributes -> Attributes -> Attributes
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 :: Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
parseFinalAttributes requireWhitespace :: Bool
requireWhitespace ts :: [Tok]
ts = do
  [ParsecT [Tok] (BPState m il bl) m Attributes]
attrParsers <- BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
forall (m :: * -> *) il bl.
BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
attributeParsers (BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes])
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT
     [Tok]
     (BPState m il bl)
     m
     [ParsecT [Tok] (BPState m il bl) m Attributes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let pAttr' :: ParsecT [Tok] (BPState m il bl) m Attributes
pAttr' = ParsecT [Tok] (BPState m il bl) m Attributes
-> ParsecT [Tok] (BPState m il bl) m Attributes
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (BPState m il bl) m Attributes
 -> ParsecT [Tok] (BPState m il bl) m Attributes)
-> ParsecT [Tok] (BPState m il bl) m Attributes
-> ParsecT [Tok] (BPState m il bl) m Attributes
forall a b. (a -> b) -> a -> b
$ (if Bool
requireWhitespace
                         then () ()
-> ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] (BPState m il bl) m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
                         else ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] (BPState m il bl) m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace)
                     ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Attributes
-> ParsecT [Tok] (BPState m il bl) m Attributes
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ParsecT [Tok] (BPState m il bl) m Attributes]
-> ParsecT [Tok] (BPState m il bl) m Attributes
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 ParsecT [Tok] (BPState m il bl) m Attributes
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Attributes
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] (BPState m il bl) m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace ParsecT [Tok] (BPState m il bl) m Attributes
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Attributes
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  BPState m il bl
st <- ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Either ParseError ([Tok], Attributes)
res <- m (Either ParseError ([Tok], Attributes))
-> ParsecT
     [Tok] (BPState m il bl) m (Either ParseError ([Tok], Attributes))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either ParseError ([Tok], Attributes))
 -> ParsecT
      [Tok] (BPState m il bl) m (Either ParseError ([Tok], Attributes)))
-> m (Either ParseError ([Tok], Attributes))
-> ParsecT
     [Tok] (BPState m il bl) m (Either ParseError ([Tok], Attributes))
forall a b. (a -> b) -> a -> b
$ BlockParser m il bl ([Tok], Attributes)
-> BPState m il bl
-> SourceName
-> [Tok]
-> m (Either ParseError ([Tok], Attributes))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
runParserT
       ((,) ([Tok] -> Attributes -> ([Tok], Attributes))
-> ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT
     [Tok] (BPState m il bl) m (Attributes -> ([Tok], Attributes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] (BPState m il bl) m Attributes
-> ParsecT [Tok] (BPState m il bl) m ()
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' ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anyTok)
            ParsecT
  [Tok] (BPState m il bl) m (Attributes -> ([Tok], Attributes))
-> ParsecT [Tok] (BPState m il bl) m Attributes
-> BlockParser m il bl ([Tok], Attributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Attributes
-> ParsecT [Tok] (BPState m il bl) m Attributes
-> ParsecT [Tok] (BPState m il bl) m Attributes
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 "heading contents" [Tok]
ts
  case Either ParseError ([Tok], Attributes)
res of
    Left _         -> BlockParser m il bl ([Tok], Attributes)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Right (xs :: [Tok]
xs, ys :: Attributes
ys) -> ([Tok], Attributes) -> BlockParser m il bl ([Tok], Attributes)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
xs, Attributes
ys)

blockQuoteSpec :: (Monad m, IsBlock il bl) => BlockSpec m il bl
blockQuoteSpec :: BlockSpec m il bl
blockQuoteSpec = $WBlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = "BlockQuote"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             Tok
_ <- Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '>'
             Int
_ <- Int
-> ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option 0 (Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces 1)
             BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ())
-> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$
                BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
blockQuoteSpec){
                          blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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       = \n :: BlockNode m il bl
n -> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (BlockParser m il bl (SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$ do
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             Tok
_ <- Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '>'
             Int
_ <- Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces 1
             (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
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    = ([bl] -> bl)
-> ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (bl -> bl
forall il b. IsBlock il b => b -> b
blockQuote (bl -> bl) -> ([bl] -> bl) -> [bl] -> bl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [bl] -> bl
forall a. Monoid a => [a] -> a
mconcat) (ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl)
-> (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m [bl])
-> BlockNode m il bl
-> BlockParser m il bl bl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m [bl]
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       = BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
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 :: BlockParser m il bl ListType -> BlockSpec m il bl
listItemSpec parseListMarker :: BlockParser m il bl ListType
parseListMarker = $WBlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = "ListItem"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             (pos :: SourcePos
pos, lidata :: ListItemData
lidata) <- BlockParser m il bl ListType
-> BlockParser m il bl (SourcePos, ListItemData)
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 = BlockData m il bl
-> Forest (BlockData m il bl) -> Tree (BlockData m il bl)
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData (BlockSpec m il bl -> BlockData m il bl)
-> BlockSpec m il bl -> BlockData m il bl
forall a b. (a -> b) -> a -> b
$ BlockParser m il bl ListType -> BlockSpec m il bl
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 = ListItemData -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn ListItemData
lidata,
                             blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             let listdata :: ListData
listdata = $WListData :: ListType -> ListSpacing -> 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 = BlockData m il bl
-> Forest (BlockData m il bl) -> Tree (BlockData m il bl)
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
listSpec){
                              blockData :: Dynamic
blockData = ListData -> Dynamic
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
             (cur :: Tree (BlockData m il bl)
cur:_) <- BPState m il bl -> Forest (BlockData m il bl)
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m il bl -> Forest (BlockData m il bl))
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m (Forest (BlockData m il bl))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
             Bool
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BlockSpec m il bl -> Bool
forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (Tree (BlockData m il bl) -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec Tree (BlockData m il bl)
cur)) (ParsecT [Tok] (BPState m il bl) m ()
 -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ do
               Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ case ListData -> ListType
listType ListData
listdata of
                            BulletList _            -> Bool
True
                            OrderedList 1 Decimal _ -> Bool
True
                            _                       -> Bool
False
               ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
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 ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
             let curdata :: ListData
curdata = Dynamic -> ListData -> ListData
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (Tree (BlockData m il bl) -> BlockData m il bl
forall a. Tree a -> a
rootLabel Tree (BlockData m il bl)
cur))
                                (ListType -> ListSpacing -> ListData
ListData (Char -> ListType
BulletList '*') ListSpacing
TightList)
             let isSingleRomanDigit :: a -> Bool
isSingleRomanDigit n :: a
n = a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 5 Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 10 Bool -> Bool -> Bool
||
                                        a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 50 Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 100 Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 500 Bool -> Bool -> Bool
||
                                        a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1000
             let matchesOrderedListStyle :: ListType -> ListType -> Bool
matchesOrderedListStyle
                  (OrderedList _s1 :: Int
_s1 e1 :: EnumeratorType
e1 d1 :: DelimiterType
d1) (OrderedList s2 :: Int
s2 e2 :: EnumeratorType
e2 d2 :: DelimiterType
d2) =
                    DelimiterType
d1 DelimiterType -> DelimiterType -> Bool
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
                        (LowerAlpha, LowerRoman) -> Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
                        (UpperAlpha, UpperRoman) -> Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
                        (LowerRoman, LowerAlpha) -> Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
                        (UpperRoman, UpperAlpha) -> Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
                        _ -> EnumeratorType
e1 EnumeratorType -> EnumeratorType -> Bool
forall a. Eq a => a -> a -> Bool
== EnumeratorType
e2
                 matchesOrderedListStyle _ _ = Bool
False

             let matchesList :: ListType -> ListType -> Bool
matchesList (BulletList c :: Char
c) (BulletList d :: Char
d)       = Char
c Char -> Char -> Bool
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 _ _                                 = Bool
False
             case BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (Tree (BlockData m il bl) -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec Tree (BlockData m il bl)
cur) of
                  "List" | ListData -> ListType
listType ListData
curdata ListType -> ListType -> Bool
`matchesList`
                           ListItemData -> ListType
listItemType ListItemData
lidata
                    -> Tree (BlockData m il bl) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack Tree (BlockData m il bl)
linode
                  _ -> Tree (BlockData m il bl) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack Tree (BlockData m il bl)
listnode ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tree (BlockData m il bl) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack Tree (BlockData m il bl)
linode
             BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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 ndata :: BlockData m il bl
ndata children :: Forest (BlockData m il bl)
children) -> do
             let lidata :: ListItemData
lidata = Dynamic -> ListItemData -> ListItemData
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
ndata)
                             (ListType -> Int -> Bool -> Bool -> ListItemData
ListItemData (Char -> ListType
BulletList '*') 0 Bool
False Bool
False)
             -- a marker followed by two blanks is just an empty item:
             Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BlockData m il bl -> [Int]
forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
ndata) Bool -> Bool -> Bool
||
                     Bool -> Bool
not (Forest (BlockData m il bl) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Forest (BlockData m il bl)
children)
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces (ListItemData -> Int
listItemIndent ListItemData
lidata) ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 0 Int
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
             (SourcePos, Tree (BlockData m il bl))
-> BlockParser m il bl (SourcePos, Tree (BlockData m il bl))
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    = ([bl] -> bl)
-> ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [bl] -> bl
forall a. Monoid a => [a] -> a
mconcat (ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl)
-> (Tree (BlockData m il bl)
    -> ParsecT [Tok] (BPState m il bl) m [bl])
-> Tree (BlockData m il bl)
-> BlockParser m il bl bl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (BlockData m il bl) -> ParsecT [Tok] (BPState m il bl) m [bl]
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 cdata :: BlockData m il bl
cdata children :: Forest (BlockData m il bl)
children) parent :: Tree (BlockData m il bl)
parent -> do
          let lidata :: ListItemData
lidata = Dynamic -> ListItemData -> ListItemData
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
cdata)
                                 (ListType -> Int -> Bool -> Bool -> ListItemData
ListItemData (Char -> ListType
BulletList '*')
                                   0 Bool
False Bool
False)
          let allblanks :: [Int]
allblanks = [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ BlockData m il bl -> [Int]
forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
cdata [Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
:
                                  (Tree (BlockData m il bl) -> [Int])
-> Forest (BlockData m il bl) -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (BlockData m il bl -> [Int]
forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks (BlockData m il bl -> [Int])
-> (Tree (BlockData m il bl) -> BlockData m il bl)
-> Tree (BlockData m il bl)
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (BlockData m il bl) -> BlockData m il bl
forall a. Tree a -> a
rootLabel)
                                  ((Tree (BlockData m il bl) -> Bool)
-> Forest (BlockData m il bl) -> Forest (BlockData m il bl)
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "List") (Text -> Bool)
-> (Tree (BlockData m il bl) -> Text)
-> Tree (BlockData m il bl)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (BlockSpec m il bl -> Text)
-> (Tree (BlockData m il bl) -> BlockSpec m il bl)
-> Tree (BlockData m il bl)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   BlockData m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec (BlockData m il bl -> BlockSpec m il bl)
-> (Tree (BlockData m il bl) -> BlockData m il bl)
-> Tree (BlockData m il bl)
-> BlockSpec m il bl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (BlockData m il bl) -> BlockData m il bl
forall a. Tree a -> a
rootLabel) Forest (BlockData m il bl)
children)
          Int
curline <- SourcePos -> Int
sourceLine (SourcePos -> Int)
-> ParsecT [Tok] (BPState m il bl) m SourcePos
-> ParsecT [Tok] (BPState m il bl) m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
          let blanksAtEnd :: Bool
blanksAtEnd = case [Int]
allblanks of
                                   (l :: Int
l:_) -> Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
curline Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
                                   _     -> Bool
False
          let blanksInside :: Bool
blanksInside = case [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> [Int]
removeConsecutive [Int]
allblanks) of
                                n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1     -> Bool
True
                                  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1    -> Bool -> Bool
not Bool
blanksAtEnd
                                  | Bool
otherwise -> Bool
False
          let lidata' :: Dynamic
lidata' = ListItemData -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (ListItemData -> Dynamic) -> ListItemData -> Dynamic
forall a b. (a -> b) -> a -> b
$ ListItemData
lidata{ listItemBlanksInside :: Bool
listItemBlanksInside = Bool
blanksInside
                                      , listItemBlanksAtEnd :: Bool
listItemBlanksAtEnd  = Bool
blanksAtEnd }
          Tree (BlockData m il bl)
-> Tree (BlockData m il bl)
-> BlockParser m il bl (Tree (BlockData m il bl))
forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (BlockData m il bl
-> Forest (BlockData m il bl) -> Tree (BlockData m il bl)
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
cdata{ blockData :: Dynamic
blockData = Dynamic
lidata' } Forest (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 :: BlockParser m il bl ListType
-> BlockParser m il bl (SourcePos, ListItemData)
itemStart parseListMarker :: BlockParser m il bl ListType
parseListMarker = do
  Int
beforecol <- SourcePos -> Int
sourceColumn (SourcePos -> Int)
-> ParsecT [Tok] (BPState m il bl) m SourcePos
-> ParsecT [Tok] (BPState m il bl) m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces 3
  SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
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 (SourcePos -> Int)
-> ParsecT [Tok] (BPState m il bl) m SourcePos
-> ParsecT [Tok] (BPState m il bl) m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  Int
numspaces <- ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces 4 ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m ()
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 [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace)
           ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces 1
           ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 1 Int
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
  (SourcePos, ListItemData)
-> BlockParser m il bl (SourcePos, ListItemData)
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
pos, $WListItemData :: ListType -> Int -> Bool -> Bool -> ListItemData
ListItemData{
           listItemType :: ListType
listItemType = ListType
ty
          , listItemIndent :: Int
listItemIndent = (Int
aftercol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
beforecol) Int -> Int -> Int
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 :: BlockParser m il bl ListType
bulletListMarker = do
  Tok (Symbol c :: Char
c) _ _ <- Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '-' ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '*' ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '+'
  ListType -> BlockParser m il bl ListType
forall (m :: * -> *) a. Monad m => a -> m a
return (ListType -> BlockParser m il bl ListType)
-> ListType -> BlockParser m il bl ListType
forall a b. (a -> b) -> a -> b
$! Char -> ListType
BulletList Char
c

orderedListMarker :: Monad m => BlockParser m il bl ListType
orderedListMarker :: BlockParser m il bl ListType
orderedListMarker = do
  Tok WordChars _ ds :: Text
ds <- (Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\t :: Text
t -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
t Bool -> Bool -> Bool
&& Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10)
  (Int
start :: Int) <- (SourceName -> ParsecT [Tok] (BPState m il bl) m Int)
-> ((Int, Text) -> ParsecT [Tok] (BPState m il bl) m Int)
-> Either SourceName (Int, Text)
-> ParsecT [Tok] (BPState m il bl) m Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SourceName -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) a. MonadFail m => SourceName -> m a
fail (Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT [Tok] (BPState m il bl) m Int)
-> ((Int, Text) -> Int)
-> (Int, Text)
-> ParsecT [Tok] (BPState m il bl) m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Int
forall a b. (a, b) -> a
fst) (Reader Int
forall a. Integral a => Reader a
TR.decimal Text
ds)
  DelimiterType
delimtype <- DelimiterType
Period DelimiterType
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m DelimiterType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '.' ParsecT [Tok] (BPState m il bl) m DelimiterType
-> ParsecT [Tok] (BPState m il bl) m DelimiterType
-> ParsecT [Tok] (BPState m il bl) m DelimiterType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> DelimiterType
OneParen DelimiterType
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m DelimiterType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol ')'
  ListType -> BlockParser m il bl ListType
forall (m :: * -> *) a. Monad m => a -> m a
return (ListType -> BlockParser m il bl ListType)
-> ListType -> BlockParser m il bl ListType
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 :: BlockSpec m il bl
listSpec = $WBlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = "List"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = \sp :: BlockSpec m il bl
sp -> BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
sp Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "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       = \n :: BlockNode m il bl
n -> (,BlockNode m il bl
n) (SourcePos -> (SourcePos, BlockNode m il bl))
-> ParsecT [Tok] (BPState m il bl) m SourcePos
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \node :: BlockNode m il bl
node -> do
          let ListData lt :: ListType
lt ls :: ListSpacing
ls = Dynamic -> ListData -> ListData
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                                 (ListType -> ListSpacing -> ListData
ListData (Char -> ListType
BulletList '*') ListSpacing
TightList)
          ListType -> ListSpacing -> [bl] -> bl
forall il b. IsBlock il b => ListType -> ListSpacing -> [b] -> b
list ListType
lt ListSpacing
ls ([bl] -> bl)
-> ParsecT [Tok] (BPState m il bl) m [bl] -> BlockParser m il bl bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m [bl]
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 cdata :: BlockData m il bl
cdata children :: Forest (BlockData m il bl)
children) parent :: BlockNode m il bl
parent -> do
          let ListData lt :: ListType
lt _ = Dynamic -> ListData -> ListData
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
cdata)
                                 (ListType -> ListSpacing -> ListData
ListData (Char -> ListType
BulletList '*') ListSpacing
TightList)
          let getListItemData :: Tree (BlockData m il bl) -> ListItemData
getListItemData (Node d :: BlockData m il bl
d _) =
                Dynamic -> ListItemData -> ListItemData
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
d)
                  (ListType -> Int -> Bool -> Bool -> ListItemData
ListItemData (Char -> ListType
BulletList '*') 0 Bool
False Bool
False)
          let childrenData :: [ListItemData]
childrenData = (BlockNode m il bl -> ListItemData)
-> Forest (BlockData m il bl) -> [ListItemData]
forall a b. (a -> b) -> [a] -> [b]
map BlockNode m il bl -> ListItemData
forall (m :: * -> *) il bl.
Tree (BlockData m il bl) -> ListItemData
getListItemData Forest (BlockData m il bl)
children
          let ls :: ListSpacing
ls = case [ListItemData]
childrenData of
                          c :: ListItemData
c:cs :: [ListItemData]
cs | (ListItemData -> Bool) -> [ListItemData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ListItemData -> Bool
listItemBlanksInside (ListItemData
cListItemData -> [ListItemData] -> [ListItemData]
forall a. a -> [a] -> [a]
:[ListItemData]
cs) Bool -> Bool -> Bool
||
                                 (Bool -> Bool
not ([ListItemData] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ListItemData]
cs) Bool -> Bool -> Bool
&&
                                  (ListItemData -> Bool) -> [ListItemData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ListItemData -> Bool
listItemBlanksAtEnd [ListItemData]
cs)
                               -> ListSpacing
LooseList
                          _    -> ListSpacing
TightList
          [Int]
blockBlanks' <- case [ListItemData]
childrenData of
                             c :: ListItemData
c:_ | ListItemData -> Bool
listItemBlanksAtEnd ListItemData
c -> do
                                 Int
curline <- SourcePos -> Int
sourceLine (SourcePos -> Int)
-> ParsecT [Tok] (BPState m il bl) m SourcePos
-> ParsecT [Tok] (BPState m il bl) m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                                 [Int] -> ParsecT [Tok] (BPState m il bl) m [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> ParsecT [Tok] (BPState m il bl) m [Int])
-> [Int] -> ParsecT [Tok] (BPState m il bl) m [Int]
forall a b. (a -> b) -> a -> b
$! Int
curline Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: BlockData m il bl -> [Int]
forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
cdata
                             _ -> [Int] -> ParsecT [Tok] (BPState m il bl) m [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> ParsecT [Tok] (BPState m il bl) m [Int])
-> [Int] -> ParsecT [Tok] (BPState m il bl) m [Int]
forall a b. (a -> b) -> a -> b
$! BlockData m il bl -> [Int]
forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks BlockData m il bl
cdata
          let ldata' :: Dynamic
ldata' = ListData -> Dynamic
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 nd :: BlockData m il bl
nd cs :: Forest (BlockData m il bl)
cs)
                | BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (BlockData m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec BlockData m il bl
nd) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Paragraph"
                            = BlockData m il bl
-> Forest (BlockData m il bl) -> Tree (BlockData m il bl)
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
nd{ blockSpec :: BlockSpec m il bl
blockSpec = BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
plainSpec } Forest (BlockData m il bl)
cs
                | Bool
otherwise = BlockData m il bl
-> Forest (BlockData m il bl) -> Tree (BlockData m il bl)
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
nd Forest (BlockData m il bl)
cs
          let childrenToTight :: Tree (BlockData m il bl) -> Tree (BlockData m il bl)
childrenToTight (Node nd :: BlockData m il bl
nd cs :: Forest (BlockData m il bl)
cs) = BlockData m il bl
-> Forest (BlockData m il bl) -> Tree (BlockData m il bl)
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
nd ((Tree (BlockData m il bl) -> Tree (BlockData m il bl))
-> Forest (BlockData m il bl) -> Forest (BlockData m il bl)
forall a b. (a -> b) -> [a] -> [b]
map Tree (BlockData m il bl) -> Tree (BlockData m il bl)
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
Tree (BlockData m il bl) -> Tree (BlockData m il bl)
totight Forest (BlockData m il bl)
cs)
          let children' :: Forest (BlockData m il bl)
children' =
                 if ListSpacing
ls ListSpacing -> ListSpacing -> Bool
forall a. Eq a => a -> a -> Bool
== ListSpacing
TightList
                    then (BlockNode m il bl -> BlockNode m il bl)
-> Forest (BlockData m il bl) -> Forest (BlockData m il bl)
forall a b. (a -> b) -> [a] -> [b]
map BlockNode m il bl -> BlockNode m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
Tree (BlockData m il bl) -> Tree (BlockData m il bl)
childrenToTight Forest (BlockData m il bl)
children
                    else Forest (BlockData m il bl)
children
          BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
cdata{ blockData :: Dynamic
blockData = Dynamic
ldata'
                                      , blockBlanks :: [Int]
blockBlanks = [Int]
blockBlanks' } Forest (BlockData m il bl)
children')
                           BlockNode m il bl
parent
     }

thematicBreakSpec :: (Monad m, IsBlock il bl)
            => BlockSpec m il bl
thematicBreakSpec :: BlockSpec m il bl
thematicBreakSpec = $WBlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = "ThematicBreak"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
            ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
            SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
            Tok (Symbol c :: Char
c) _ _ <- Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '-'
                              ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '_'
                              ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '*'
            (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
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 = Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
c ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m () -> ParsecT [Tok] s m Tok
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Tok -> Bool) -> ParsecT [Tok] s m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
            Int
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count 2 ParsecT [Tok] (BPState m il bl) m Tok
forall s. ParsecT [Tok] s m Tok
tbchar
            ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Tok] (BPState m il bl) m Tok
forall s. ParsecT [Tok] s m Tok
tbchar
            (do ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
                BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack (BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
thematicBreakSpec){
                                   blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } [])
                BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch) BlockParser m il bl BlockStartResult
-> BlockParser m il bl BlockStartResult
-> BlockParser m il bl BlockStartResult
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              (SourcePos -> BlockStartResult
BlockStartNoMatchBefore (SourcePos -> BlockStartResult)
-> ParsecT [Tok] (BPState m il bl) m SourcePos
-> BlockParser m il bl BlockStartResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition)
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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       = BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. a -> b -> a
const BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \_ -> bl -> BlockParser m il bl bl
forall (m :: * -> *) a. Monad m => a -> m a
return bl
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       = BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
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 :: BlockSpec m il bl
indentedCodeSpec = $WBlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = "IndentedCode"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
             BlockParser m il bl Bool
forall (m :: * -> *) bl il. Monad m => BlockParser m bl il Bool
interruptsParagraph BlockParser m il bl Bool
-> (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> (Bool -> Bool) -> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
             ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> (BPState m il bl -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> Bool)
-> BPState m il bl
-> ParsecT [Tok] (BPState m il bl) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool)
-> (BPState m il bl -> Bool) -> BPState m il bl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BPState m il bl -> Bool
forall (m :: * -> *) il bl. BPState m il bl -> Bool
maybeLazy
             Int
_ <- Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces 4
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
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 ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
             BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ())
-> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
indentedCodeSpec){
                          blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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 -> do
             ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces 4)
               ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces) ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd)
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
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    = \node :: BlockNode m il bl
node ->
             bl -> BlockParser m il bl bl
forall (m :: * -> *) a. Monad m => a -> m a
return (bl -> BlockParser m il bl bl) -> bl -> BlockParser m il bl bl
forall a b. (a -> b) -> a -> b
$! Text -> Text -> bl
forall il b. IsBlock il b => Text -> Text -> b
codeBlock Text
forall a. Monoid a => a
mempty ([Tok] -> Text
untokenize (BlockNode m il bl -> [Tok]
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 cdata :: BlockData m il bl
cdata children :: Forest (BlockData m il bl)
children) parent :: BlockNode m il bl
parent -> do
         -- strip off blank lines at end:
         let blanks :: [[Tok]]
blanks = ([Tok] -> Bool) -> [[Tok]] -> [[Tok]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile [Tok] -> Bool
isblankLine ([[Tok]] -> [[Tok]]) -> [[Tok]] -> [[Tok]]
forall a b. (a -> b) -> a -> b
$ BlockData m il bl -> [[Tok]]
forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
cdata
         let numblanks :: Int
numblanks = [[Tok]] -> Int
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 =
                                Int -> [[Tok]] -> [[Tok]]
forall a. Int -> [a] -> [a]
drop Int
numblanks ([[Tok]] -> [[Tok]]) -> [[Tok]] -> [[Tok]]
forall a b. (a -> b) -> a -> b
$ BlockData m il bl -> [[Tok]]
forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
cdata
                           , blockStartPos :: [SourcePos]
blockStartPos =
                                Int -> [SourcePos] -> [SourcePos]
forall a. Int -> [a] -> [a]
drop Int
numblanks ([SourcePos] -> [SourcePos]) -> [SourcePos] -> [SourcePos]
forall a b. (a -> b) -> a -> b
$ BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos BlockData m il bl
cdata
                           }
         BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
cdata' Forest (BlockData m il bl)
children) BlockNode m il bl
parent
     }

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

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

             let infotoks :: [Tok]
infotoks = SourceName -> Text -> [Tok]
tokenize "info string" Text
info
             (content :: [Tok]
content, attrs :: Attributes
attrs) <- Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
forall (m :: * -> *) il bl.
Monad m =>
Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
parseFinalAttributes Bool
False [Tok]
infotoks
                                  BlockParser m il bl ([Tok], Attributes)
-> BlockParser m il bl ([Tok], Attributes)
-> BlockParser m il bl ([Tok], Attributes)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (([Tok], Attributes) -> BlockParser m il bl ([Tok], Attributes)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
infotoks, Attributes
forall a. Monoid a => a
mempty))
             BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ())
-> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$
                BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
fencedCodeSpec){
                          blockData :: Dynamic
blockData = (Char, Int, Int, Text, Attributes) -> Dynamic
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] } []
             BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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 -> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
             let ((c :: Char
c, fencelength :: Int
fencelength, _, _, _)
                    :: (Char, Int, Int, Text, Attributes)) = Dynamic
-> (Char, Int, Int, Text, Attributes)
-> (Char, Int, Int, Text, Attributes)
forall a. Typeable a => Dynamic -> a -> a
fromDyn
                                   (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                                   ('`', 3, 0, Text
forall a. Monoid a => a
mempty, Attributes
forall a. Monoid a => a
mempty)
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             [Tok]
ts <- ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
c)
             Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ [Tok] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fencelength
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (BPState m il bl) m ()
 -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ()
endOfBlock
             (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node))
               BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do let ((_, _, indentspaces :: Int
indentspaces, _, _)
                              :: (Char, Int, Int, Text, Attributes)) = Dynamic
-> (Char, Int, Int, Text, Attributes)
-> (Char, Int, Int, Text, Attributes)
forall a. Typeable a => Dynamic -> a -> a
fromDyn
                                   (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
                                   ('`', 3, 0, Text
forall a. Monoid a => a
mempty, Attributes
forall a. Monoid a => a
mempty)
                       SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                       Int
_ <- Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
indentspaces
                       (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
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    = \node :: BlockNode m il bl
node -> do
           let ((_, _, _, info :: Text
info, attrs :: Attributes
attrs) :: (Char, Int, Int, Text, Attributes)) =
                   Dynamic
-> (Char, Int, Int, Text, Attributes)
-> (Char, Int, Int, Text, Attributes)
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node)) ('`', 3, 0, Text
forall a. Monoid a => a
mempty, Attributes
forall a. Monoid a => a
mempty)
           let codetext :: Text
codetext = [Tok] -> Text
untokenize ([Tok] -> Text) -> [Tok] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Tok] -> [Tok]
forall a. Int -> [a] -> [a]
drop 1 (BlockNode m il bl -> [Tok]
forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node)
           bl -> BlockParser m il bl bl
forall (m :: * -> *) a. Monad m => a -> m a
return (bl -> BlockParser m il bl bl) -> bl -> BlockParser m il bl bl
forall a b. (a -> b) -> a -> b
$!
              if Attributes -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Attributes
attrs
                 then Text -> Text -> bl
forall il b. IsBlock il b => Text -> Text -> b
codeBlock Text
info Text
codetext
                 else Attributes -> bl -> bl
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs (bl -> bl) -> bl -> bl
forall a b. (a -> b) -> a -> b
$ Text -> Text -> bl
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       = BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
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 :: BlockSpec m il bl
rawHtmlSpec = $WBlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = "RawHTML"
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = do
         SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         (rawHtmlType :: Int
rawHtmlType, toks :: [Tok]
toks) <- ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m (Int, [Tok])
forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw (ParsecT [Tok] (BPState m il bl) m Int
 -> ParsecT [Tok] (BPState m il bl) m (Int, [Tok]))
-> ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m (Int, [Tok])
forall a b. (a -> b) -> a -> b
$
           do ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
              Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '<'
              Int
ty <- [ParsecT [Tok] (BPState m il bl) m Int]
-> ParsecT [Tok] (BPState m il bl) m Int
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 Int]
 -> ParsecT [Tok] (BPState m il bl) m Int)
-> [ParsecT [Tok] (BPState m il bl) m Int]
-> ParsecT [Tok] (BPState m il bl) m Int
forall a b. (a -> b) -> a -> b
$ (Int -> ParsecT [Tok] (BPState m il bl) m Int)
-> [Int] -> [ParsecT [Tok] (BPState m il bl) m Int]
forall a b. (a -> b) -> [a] -> [b]
map (\n :: Int
n -> Int
n Int
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) il bl.
Monad m =>
Int -> BlockParser m il bl ()
startCond Int
n) [1..7]
              -- some blocks can end on same line
              Bool
finished <- Bool
-> ParsecT [Tok] (BPState m il bl) m Bool
-> ParsecT [Tok] (BPState m il bl) m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (ParsecT [Tok] (BPState m il bl) m Bool
 -> ParsecT [Tok] (BPState m il bl) m Bool)
-> ParsecT [Tok] (BPState m il bl) m Bool
-> ParsecT [Tok] (BPState m il bl) m Bool
forall a b. (a -> b) -> a -> b
$ do
                 Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
ty Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 6 Bool -> Bool -> Bool
&& Int
ty Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 7)
                 Int -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) il bl.
Monad m =>
Int -> BlockParser m il bl ()
endCond Int
ty
                 Bool -> ParsecT [Tok] (BPState m il bl) m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
              Bool
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ty Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 7) (ParsecT [Tok] (BPState m il bl) m ()
 -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ do
                 -- type 7 blocks can't interrupt a paragraph
                 (n :: BlockNode m il bl
n:_) <- BPState m il bl -> [BlockNode m il bl]
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m il bl -> [BlockNode m il bl])
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m [BlockNode m il bl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                 Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ BlockSpec m il bl -> Bool
forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (BlockNode m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
n)
              (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (Bool -> Bool
not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
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
              Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT [Tok] (BPState m il bl) m Int)
-> Int -> ParsecT [Tok] (BPState m il bl) m Int
forall a b. (a -> b) -> a -> b
$! if Bool
finished then 0 else Int
ty
         BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ())
-> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
rawHtmlSpec){
                      blockData :: Dynamic
blockData = Int -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Int
rawHtmlType,
                      blockLines :: [[Tok]]
blockLines = [[Tok]
toks],
                      blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
         BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
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 ndata :: BlockData m il bl
ndata children :: [BlockNode m il bl]
children) -> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (BlockParser m il bl (SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$ do
         SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         case Dynamic -> Int -> Int
forall a. Typeable a => Dynamic -> a -> a
fromDyn (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node)) (0 :: Int) of
              0 -> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. MonadPlus m => m a
mzero  -- 0 means that the block start already closed
              6 -> (SourcePos
pos, BlockNode m il bl
node) (SourcePos, BlockNode m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
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 ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
              7 -> (SourcePos
pos, BlockNode m il bl
node) (SourcePos, BlockNode m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
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 ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
              n :: Int
n ->
                (do SourcePos
pos' <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                    ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Int -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) il bl.
Monad m =>
Int -> BlockParser m il bl ()
endCond Int
n)
                    ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ()
endOfBlock
                    [Tok]
toks <- ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (Bool -> Bool
not (Bool -> Bool) -> (Tok -> Bool) -> Tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokType -> Tok -> Bool
hasType TokType
LineEnd))
                    [Tok]
le <- [Tok]
-> ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m [Tok]
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 [Tok]
 -> ParsecT [Tok] (BPState m il bl) m [Tok])
-> ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall a b. (a -> b) -> a -> b
$ (Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
:[]) (Tok -> [Tok])
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
                    (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! (SourcePos
pos', BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
ndata{
                                    blockData :: Dynamic
blockData = Int -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (0 :: Int)
                                  , blockLines :: [[Tok]]
blockLines = ([Tok]
toks [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok]
le) [Tok] -> [[Tok]] -> [[Tok]]
forall a. a -> [a] -> [a]
: BlockData m il bl -> [[Tok]]
forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
ndata
                                  } [BlockNode m il bl]
children)) BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
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    = \node :: BlockNode m il bl
node ->
             bl -> BlockParser m il bl bl
forall (m :: * -> *) a. Monad m => a -> m a
return (bl -> BlockParser m il bl bl) -> bl -> BlockParser m il bl bl
forall a b. (a -> b) -> a -> b
$! Format -> Text -> bl
forall il b. IsBlock il b => Format -> Text -> b
rawBlock (Text -> Format
Format "html")
                           ([Tok] -> Text
untokenize (BlockNode m il bl -> [Tok]
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
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
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 :: Int -> BlockParser m il bl ()
startCond 1 = ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ())
-> ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (BPState m il bl) m Tok
 -> ParsecT [Tok] (BPState m il bl) m Tok)
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall a b. (a -> b) -> a -> b
$ do
  (Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ([Text] -> Text -> Bool
isOneOfCI ["script","pre","style","textarea"])
  ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
spaceTok
     ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '>'
     ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
startCond 2 = ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ())
-> ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (BPState m il bl) m Tok
 -> ParsecT [Tok] (BPState m il bl) m Tok)
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '!'
  Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '-'
  Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '-'
startCond 3 = ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ())
-> ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '?'
startCond 4 = ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ())
-> ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (BPState m il bl) m Tok
 -> ParsecT [Tok] (BPState m il bl) m Tok)
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '!'
  (Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\t :: Text
t -> case Text -> Maybe (Char, Text)
T.uncons Text
t of
                          Just (c :: Char
c, _) -> Char -> Bool
isAsciiUpper Char
c
                          _           -> Bool
False)
startCond 5 = ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ())
-> ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (BPState m il bl) m Tok
 -> ParsecT [Tok] (BPState m il bl) m Tok)
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '!'
  Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '['
  (Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "CDATA")
  Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '['
startCond 6 = ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ())
-> ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (BPState m il bl) m Tok
 -> ParsecT [Tok] (BPState m il bl) m Tok)
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall a b. (a -> b) -> a -> b
$ do
  ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '/')
  (Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ([Text] -> Text -> Bool
isOneOfCI ["address", "article", "aside", "base",
    "basefont", "blockquote", "body", "caption", "center", "col",
    "colgroup", "dd", "details", "dialog", "dir", "div", "dl",
    "dt", "fieldset", "figcaption", "figure", "footer", "form", "frame",
    "frameset", "h1", "h2", "h3", "h4", "h5", "h6", "head", "header",
    "hr", "html", "iframe", "legend", "li", "link", "main", "menu",
    "menuitem", "nav", "noframes", "ol", "optgroup", "option",
    "p", "param", "section", "source", "summary", "table", "tbody",
    "td", "tfoot", "th", "thead", "title", "tr", "track", "ul"])
  ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
spaceTok
    ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
    ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '>'
    ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '/' ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol '>')
startCond 7 = ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ())
-> ParsecT [Tok] (BPState m il bl) m Tok -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (BPState m il bl) m Tok
 -> ParsecT [Tok] (BPState m il bl) m Tok)
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall a b. (a -> b) -> a -> b
$ do
  [Tok]
toks <- ParsecT [Tok] (BPState m il bl) m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlOpenTag ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlClosingTag
  Bool -> BlockParser m il bl ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> BlockParser m il bl ()) -> Bool -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> [Tok] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TokType -> Tok -> Bool
hasType TokType
LineEnd) [Tok]
toks
  (Tok -> Bool) -> BlockParser m il bl ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
  ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
startCond n :: Int
n = SourceName -> BlockParser m il bl ()
forall (m :: * -> *) a. MonadFail m => SourceName -> m a
fail (SourceName -> BlockParser m il bl ())
-> SourceName -> BlockParser m il bl ()
forall a b. (a -> b) -> a -> b
$ "Unknown HTML block type " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> SourceName
forall a. Show a => a -> SourceName
show Int
n

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

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

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

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

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

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

collapseNodeStack :: [BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
collapseNodeStack :: [BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
collapseNodeStack [] = SourceName -> BlockParser m il bl (BlockNode m il bl)
forall a. HasCallStack => SourceName -> a
error "Empty node stack!"  -- should not happen
collapseNodeStack (n :: BlockNode m il bl
n:ns :: [BlockNode m il bl]
ns) = (BlockNode m il bl
 -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockNode m il bl
-> [BlockNode m il bl]
-> BlockParser m il bl (BlockNode m il bl)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
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 child :: BlockNode m il bl
child parent :: BlockNode m il bl
parent
         = if BlockSpec m il bl -> BlockSpec m il bl -> Bool
forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockSpec m il bl -> Bool
blockCanContain (BlockNode m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
parent) (BlockNode m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
child)
              then BlockSpec m il bl
-> BlockNode m il bl
-> BlockNode m il bl
-> BlockParser m il bl (BlockNode m il bl)
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 -> BlockSpec m il bl
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 SourceName -> BlockParser m il bl (BlockNode m il bl)
forall a. HasCallStack => SourceName -> a
error (SourceName -> BlockParser m il bl (BlockNode m il bl))
-> SourceName -> BlockParser m il bl (BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$ "collapseNodeStack: " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++
                     Text -> SourceName
T.unpack (BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (BlockNode m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
parent)) SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++
                     " cannot contain " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> SourceName
T.unpack (BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (BlockNode m il bl -> BlockSpec m il bl
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 :: BlockNode m il bl -> BlockSpec m il bl
bspec = BlockData m il bl -> BlockSpec m il bl
forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec (BlockData m il bl -> BlockSpec m il bl)
-> (BlockNode m il bl -> BlockData m il bl)
-> BlockNode m il bl
-> BlockSpec m il bl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel

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