{-# 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
, 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 (pEscapedSymbol, 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, isAsciiLower, 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
import Data.List (sort)
mkBlockParser
:: (Monad m, IsBlock il bl)
=> [BlockSpec m il bl]
-> [BlockParser m il bl bl]
-> (ReferenceMap -> [Tok] -> m (Either ParseError il))
-> [BlockParser m il bl Attributes]
-> [Tok]
-> m (Either ParseError bl)
mkBlockParser :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl]
-> [BlockParser m il bl bl]
-> (ReferenceMap -> [Tok] -> m (Either ParseError il))
-> [BlockParser m il bl Attributes]
-> [Tok]
-> m (Either ParseError bl)
mkBlockParser [BlockSpec m il bl]
specs [BlockParser m il bl bl]
finalParsers ReferenceMap -> [Tok] -> m (Either ParseError il)
ilParser [BlockParser m il bl Attributes]
attrParsers [Tok]
ts =
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
(Tok
t:[Tok]
_) -> 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 a. a -> ParsecT [Tok] (BPState m il bl) m a
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)
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 -> [Tree 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
}
SourceName
"source" ([Tok] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts Int -> [Tok] -> [Tok]
forall a b. a -> b -> b
`seq` [Tok]
ts)
processLines :: (Monad m, IsBlock il bl)
=> [BlockSpec m il bl]
-> [BlockParser m il bl bl]
-> BlockParser m il bl bl
processLines :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl]
-> [BlockParser m il bl bl] -> BlockParser m il bl bl
processLines [BlockSpec m il bl]
specs [BlockParser m il bl bl]
finalParsers = {-# SCC processLines #-} do
let go :: ParsecT [Tok] (BPState m il bl) m ()
go = 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 a b.
ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m b
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
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 a b.
ParsecT [Tok] (BPState m il bl) m a
-> (a -> ParsecT [Tok] (BPState m il bl) m b)
-> ParsecT [Tok] (BPState m il bl) m b
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
updateState $ \BPState m il bl
st -> BPState m il bl
st{ nodeStack = [reverseSubforests tree] }
endContent <- mconcat <$> sequence finalParsers
tree':_ <- nodeStack <$> getState
body <- blockConstructor (blockSpec (rootLabel tree')) tree'
return $! body <> endContent
reverseSubforests :: Tree a -> Tree a
reverseSubforests :: forall a. Tree a -> Tree a
reverseSubforests (Node a
x [Tree a]
cs) = a -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
x ([Tree a] -> Tree a) -> [Tree a] -> Tree a
forall a b. (a -> b) -> a -> b
$ (Tree a -> Tree a) -> [Tree a] -> [Tree a]
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> Tree a
forall a. Tree a -> Tree a
reverseSubforests ([Tree a] -> [Tree a]) -> [Tree a] -> [Tree a]
forall a b. (a -> b) -> a -> b
$ [Tree a] -> [Tree a]
forall a. [a] -> [a]
reverse [Tree a]
cs
processLine :: (Monad m, IsBlock il bl)
=> [BlockSpec m il bl] -> BlockParser m il bl ()
processLine :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl] -> BlockParser m il bl ()
processLine [BlockSpec m il bl]
specs = do
st' <- ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
putState $ st'{ blockMatched = True
, maybeLazy = True
, maybeBlank = True
, failurePositions = M.empty }
(matched, unmatched) <- foldrM checkContinue ([],[]) (nodeStack st')
updateState $ \BPState m il bl
st -> BPState m il bl
st{ maybeLazy = maybeLazy st &&
case unmatched of
BlockNode m il bl
m:[BlockNode m il bl]
_ -> 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)
[BlockNode m il bl]
_ -> Bool
False }
revertState <- getState
if null unmatched
then updateState $ \BPState m il bl
st -> BPState m il bl
st{ nodeStack = matched }
else case matched of
[] -> SourceName -> ParsecT [Tok] (BPState m il bl) m ()
forall a. HasCallStack => SourceName -> a
error SourceName
"no blocks matched"
BlockNode m il bl
m:[BlockNode m il bl]
ms -> do
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])
updateState $ \BPState m il bl
st -> BPState m il bl
st{ nodeStack = m':ms }
restBlank <- option False $ True <$ lookAhead blankLine
{-# SCC block_starts #-} unless restBlank $
(do skipMany1 (doBlockStarts specs)
optional (try (blockStart paraSpec)))
<|>
(do getState >>= guard . maybeLazy
sp <- getPosition
updateState $ const revertState
updateState $ \BPState m il bl
st -> BPState m il bl
st{ nodeStack =
map (addStartPos sp) (nodeStack st) })
<|>
void (try (blockStart paraSpec))
<|>
return ()
(cur:rest) <- nodeStack <$> getState
let curdata = BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
cur
when (blockParagraph (bspec cur)) $ skipMany spaceTok
pos <- getPosition
toks <- {-# SCC restOfLine #-} restOfLine
updateState $ \BPState m il bl
st -> BPState m il bl
st{
nodeStack =
cur{ rootLabel =
if blockContainsLines (bspec cur)
then curdata{ blockLines = toks : blockLines curdata }
else
if maybeBlank st && restBlank
then curdata{ blockBlanks = sourceLine pos :
blockBlanks curdata }
else curdata
} : rest
}
addStartPos :: SourcePos -> BlockNode m il bl -> BlockNode m il bl
addStartPos :: forall (m :: * -> *) il bl.
SourcePos -> BlockNode m il bl -> BlockNode m il bl
addStartPos SourcePos
sp (Node BlockData m il bl
bd [Tree (BlockData m il bl)]
cs) = BlockData m il bl
-> [Tree (BlockData m il bl)] -> Tree (BlockData m il bl)
forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
bd{ blockStartPos = sp : blockStartPos bd } [Tree (BlockData m il bl)]
cs
doBlockStarts :: Monad m => [BlockSpec m il bl] -> BlockParser m il bl ()
doBlockStarts :: forall (m :: * -> *) il bl.
Monad m =>
[BlockSpec m il bl] -> BlockParser m il bl ()
doBlockStarts [BlockSpec m il bl]
specs = do
st' <- ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
initPos <- getPosition
let 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 -> [BlockSpec m il bl] -> [BlockSpec m il bl])
-> [BlockSpec m il bl]
-> [BlockSpec m il bl]
-> [BlockSpec m il bl]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\BlockSpec m il bl
spec [BlockSpec m il bl]
sps ->
case 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 SourcePos
pos' | SourcePos
initPos SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< SourcePos
pos' -> [BlockSpec m il bl]
sps
Maybe SourcePos
_ -> 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
go initPos specs'
where
go :: SourcePos
-> [BlockSpec m il bl] -> ParsecT [Tok] (BPState m il bl) m ()
go SourcePos
_ [] = ParsecT [Tok] (BPState m il bl) m ()
forall a. ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
go SourcePos
initPos (BlockSpec m il bl
spec:[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
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
res <- blockStart spec
case res of
BlockStartResult
BlockStartMatch -> () -> ParsecT [Tok] (BPState m il bl) m ()
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
BlockStartNoMatchBefore 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
$ \BPState m il bl
st ->
BPState m il bl
st{ failurePositions =
M.insert (blockType spec)
pos (failurePositions 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 :: forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> ([BlockNode m il bl], [BlockNode m il bl])
-> BlockParser m il bl ([BlockNode m il bl], [BlockNode m il bl])
checkContinue BlockNode m il bl
nd ([BlockNode m il bl]
matched, [BlockNode m il bl]
unmatched) = do
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 ismatched
then
{-# SCC blockContinues #-}
(do (startpos, Node bdata children) <- blockContinue (bspec nd) nd
matched' <- blockMatched <$> getState
unless matched' $
updateState $ \BPState m il bl
st -> BPState m il bl
st{ maybeBlank = False,
maybeLazy = False }
let new = BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
bdata{ blockStartPos =
startpos : blockStartPos bdata
} [BlockNode m il bl]
children
return $!
if matched'
then (new:matched, unmatched)
else (matched, new:unmatched))
<|> (matched, nd:unmatched) <$ updateState (\BPState m il bl
st -> BPState m il bl
st{
blockMatched = False })
else return (matched, nd:unmatched)
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
$cshowsPrec :: Int -> BlockStartResult -> ShowS
showsPrec :: Int -> BlockStartResult -> ShowS
$cshow :: BlockStartResult -> SourceName
show :: BlockStartResult -> SourceName
$cshowList :: [BlockStartResult] -> ShowS
showList :: [BlockStartResult] -> ShowS
Show, BlockStartResult -> BlockStartResult -> Bool
(BlockStartResult -> BlockStartResult -> Bool)
-> (BlockStartResult -> BlockStartResult -> Bool)
-> Eq BlockStartResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockStartResult -> BlockStartResult -> Bool
== :: BlockStartResult -> BlockStartResult -> Bool
$c/= :: BlockStartResult -> BlockStartResult -> Bool
/= :: BlockStartResult -> BlockStartResult -> Bool
Eq)
data BlockSpec m il bl = BlockSpec
{ forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType :: !Text
, forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockParser m il bl BlockStartResult
blockStart :: BlockParser m il bl BlockStartResult
, forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockSpec m il bl -> Bool
blockCanContain :: BlockSpec m il bl -> Bool
, forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockContainsLines :: !Bool
, forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph :: !Bool
, forall (m :: * -> *) il bl.
BlockSpec m il bl
-> BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
, forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
, forall (m :: * -> *) il bl.
BlockSpec m il bl
-> BlockNode m il bl
-> BlockNode m il bl
-> BlockParser m il bl (BlockNode m il bl)
blockFinalize :: BlockNode m il bl -> BlockNode m il bl
-> BlockParser m il bl (BlockNode m il bl)
}
instance Show (BlockSpec m il bl) where
show :: BlockSpec m il bl -> SourceName
show BlockSpec m il bl
bs = SourceName
"<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]
++ SourceName
">"
defaultBlockSpecs :: (Monad m, IsBlock il bl) => [BlockSpec m il bl]
defaultBlockSpecs :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl]
defaultBlockSpecs =
[ 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 :: forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer !BlockNode m il bl
child !BlockNode m il bl
parent = do
case Text -> Attributes -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"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
Maybe Text
Nothing -> () -> ParsecT [Tok] (BPState m il bl) m ()
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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
$ \BPState m il bl
st ->
BPState m il bl
st{ counters = M.insert ("identifier:" <> ident)
(toDyn (0 :: Int)) (counters st) }
BlockNode m il bl
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockNode m il bl
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl))
-> BlockNode m il bl
-> ParsecT [Tok] (BPState m il bl) m (BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! BlockNode m il bl
parent{ subForest = child : subForest parent }
data BlockData m il bl = BlockData
{ forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec :: BlockSpec m il bl
, forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines :: [[Tok]]
, forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos :: [SourcePos]
, forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData :: !Dynamic
, forall (m :: * -> *) il bl. BlockData m il bl -> [Int]
blockBlanks :: [Int]
, forall (m :: * -> *) il bl. 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
$cshowsPrec :: forall (m :: * -> *) il bl. Int -> BlockData m il bl -> ShowS
showsPrec :: Int -> BlockData m il bl -> ShowS
$cshow :: forall (m :: * -> *) il bl. BlockData m il bl -> SourceName
show :: BlockData m il bl -> SourceName
$cshowList :: forall (m :: * -> *) il bl. [BlockData m il bl] -> ShowS
showList :: [BlockData m il bl] -> ShowS
Show
defBlockData :: BlockSpec m il bl -> BlockData m il bl
defBlockData :: forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
spec = BlockData
{ blockSpec :: BlockSpec m il bl
blockSpec = BlockSpec m il bl
spec
, blockLines :: [[Tok]]
blockLines = []
, blockStartPos :: [SourcePos]
blockStartPos = []
, blockData :: Dynamic
blockData = () -> 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
{ forall (m :: * -> *) il bl. BPState m il bl -> ReferenceMap
referenceMap :: !ReferenceMap
, forall (m :: * -> *) il bl.
BPState m il bl
-> ReferenceMap -> [Tok] -> m (Either ParseError il)
inlineParser :: ReferenceMap -> [Tok] -> m (Either ParseError il)
, forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack :: [BlockNode m il bl]
, forall (m :: * -> *) il bl. BPState m il bl -> Bool
blockMatched :: !Bool
, forall (m :: * -> *) il bl. BPState m il bl -> Bool
maybeLazy :: !Bool
, forall (m :: * -> *) il bl. BPState m il bl -> Bool
maybeBlank :: !Bool
, forall (m :: * -> *) il bl. BPState m il bl -> Map Text Dynamic
counters :: M.Map Text Dynamic
, forall (m :: * -> *) il bl. BPState m il bl -> Map Text SourcePos
failurePositions :: M.Map Text SourcePos
, forall (m :: * -> *) il bl.
BPState m il bl -> [ParsecT [Tok] (BPState m il bl) m Attributes]
attributeParsers :: [ParsecT [Tok] (BPState m il bl) m Attributes]
, forall (m :: * -> *) il bl. BPState m il bl -> Attributes
nextAttributes :: !Attributes
}
type BlockParser m il bl = ParsecT [Tok] (BPState m il bl) m
data ListData = ListData
{ ListData -> ListType
listType :: !ListType
, ListData -> ListSpacing
listSpacing :: !ListSpacing
} deriving (Int -> ListData -> ShowS
[ListData] -> ShowS
ListData -> SourceName
(Int -> ListData -> ShowS)
-> (ListData -> SourceName)
-> ([ListData] -> ShowS)
-> Show ListData
forall a.
(Int -> a -> ShowS)
-> (a -> SourceName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListData -> ShowS
showsPrec :: Int -> ListData -> ShowS
$cshow :: ListData -> SourceName
show :: ListData -> SourceName
$cshowList :: [ListData] -> ShowS
showList :: [ListData] -> ShowS
Show, ListData -> ListData -> Bool
(ListData -> ListData -> Bool)
-> (ListData -> ListData -> Bool) -> Eq ListData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListData -> ListData -> Bool
== :: ListData -> ListData -> Bool
$c/= :: ListData -> ListData -> Bool
/= :: 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
$cshowsPrec :: Int -> ListItemData -> ShowS
showsPrec :: Int -> ListItemData -> ShowS
$cshow :: ListItemData -> SourceName
show :: ListItemData -> SourceName
$cshowList :: [ListItemData] -> ShowS
showList :: [ListItemData] -> ShowS
Show, ListItemData -> ListItemData -> Bool
(ListItemData -> ListItemData -> Bool)
-> (ListItemData -> ListItemData -> Bool) -> Eq ListItemData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListItemData -> ListItemData -> Bool
== :: ListItemData -> ListItemData -> Bool
$c/= :: ListItemData -> ListItemData -> Bool
/= :: ListItemData -> ListItemData -> Bool
Eq)
getParentListType :: Monad m => BlockParser m il bl (Maybe ListType)
getParentListType :: forall (m :: * -> *) il bl.
Monad m =>
BlockParser m il bl (Maybe ListType)
getParentListType = do
(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 blockType (bspec cur) == "List"
then do
let ListData lt _ = fromDyn (blockData (rootLabel cur))
(ListData (BulletList '*') TightList)
return $ Just lt
else return Nothing
runInlineParser :: Monad m
=> [Tok]
-> BlockParser m il bl il
runInlineParser :: forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser [Tok]
toks = {-# SCC runInlineParser #-} do
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
ilParser <- inlineParser <$> getState
res <- lift $ ilParser refmap toks
case res of
Right il
ils -> il -> ParsecT [Tok] (BPState m il bl) m il
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (il -> ParsecT [Tok] (BPState m il bl) m il)
-> il -> ParsecT [Tok] (BPState m il bl) m il
forall a b. (a -> b) -> a -> b
$! il
ils
Left ParseError
err -> (State [Tok] (BPState m il bl)
-> m (Consumed (m (Reply [Tok] (BPState m il bl) il))))
-> ParsecT [Tok] (BPState m il bl) m il
forall (m :: * -> *) s u a.
Monad m =>
(State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT (\State [Tok] (BPState m il bl)
_ -> Consumed (m (Reply [Tok] (BPState m il bl) il))
-> m (Consumed (m (Reply [Tok] (BPState m il bl) il)))
forall a. a -> m a
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 a. a -> m a
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))))
addRange :: (Monad m, IsBlock il bl)
=> BlockNode m il bl -> bl -> bl
addRange :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> bl -> bl
addRange (Node BlockData m il bl
b [Tree (BlockData m il bl)]
_)
= SourceRange -> bl -> bl
forall a. Rangeable a => SourceRange -> a -> a
ranged ([(SourcePos, SourcePos)] -> SourceRange
SourceRange
([(SourcePos, SourcePos)] -> [(SourcePos, SourcePos)]
forall {a}. Eq a => [(a, a)] -> [(a, a)]
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 (\SourcePos
pos ->
(SourcePos
pos, SourcePos -> Int -> SourcePos
setSourceColumn
(SourcePos -> Int -> SourcePos
incSourceLine SourcePos
pos Int
1) Int
1))
(BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos BlockData m il bl
b)))
where
go :: [(a, a)] -> [(a, a)]
go [] = []
go ((!a
startpos1, !a
endpos1):(!a
startpos2, !a
endpos2):[(a, a)]
rest)
| a
startpos1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
startpos2
, a
endpos1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
endpos2 = [(a, a)] -> [(a, a)]
go ((a
startpos1, a
endpos2)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
rest)
| a
endpos1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
startpos2 = [(a, a)] -> [(a, a)]
go ((a
startpos1, a
endpos2)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
rest)
go ((a, a)
x:[(a, a)]
xs) = (a, a)
x (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [(a, a)] -> [(a, a)]
go [(a, a)]
xs
addNodeToStack :: Monad m => BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack :: forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack BlockNode m bl il
node = do
(cur: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
guard $ blockParagraph (bspec cur) || not (blockContainsLines (bspec cur))
if blockCanContain (bspec cur) (bspec node)
then do
nextAttr <- nextAttributes <$> getState
let node' = if Attributes -> Bool
forall a. [a] -> 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 = rl{
blockAttributes = nextAttr
}}
updateState $ \BPState m bl il
st ->
BPState m bl il
st{ nextAttributes = mempty
, nodeStack = node' : cur : rest
, maybeLazy = False }
else case rest of
(BlockNode m bl il
x:[BlockNode m bl il]
xs) -> do
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]
updateState $ \BPState m bl il
st -> BPState m bl il
st{ nodeStack = stack }
addNodeToStack node
[BlockNode m bl il]
_ -> ParsecT [Tok] (BPState m bl il) m ()
forall a. ParsecT [Tok] (BPState m bl il) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
interruptsParagraph :: Monad m => BlockParser m bl il Bool
interruptsParagraph :: forall (m :: * -> *) bl il. Monad m => BlockParser m bl il Bool
interruptsParagraph = do
(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
return $! blockParagraph (bspec cur)
renderChildren :: (Monad m, IsBlock il bl)
=> BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren BlockNode m il bl
node = (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m bl)
-> [BlockNode m il bl] -> ParsecT [Tok] (BPState m il bl) m [bl]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m bl
forall {m :: * -> *} {il} {b}.
(Monad m, IsBlock il b) =>
Tree (BlockData m il b) -> ParsecT [Tok] (BPState m il b) m b
renderC ([BlockNode m il bl] -> ParsecT [Tok] (BPState m il bl) m [bl])
-> [BlockNode m il bl] -> ParsecT [Tok] (BPState m il bl) m [bl]
forall a b. (a -> b) -> a -> b
$ BlockNode m il bl -> [BlockNode m il bl]
forall a. Tree a -> [Tree a]
subForest BlockNode m il bl
node
where
renderC :: Tree (BlockData m il b) -> ParsecT [Tok] (BPState m il b) m b
renderC Tree (BlockData m il b)
n = do
let attrs :: Attributes
attrs = BlockData m il b -> Attributes
forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
blockAttributes (Tree (BlockData m il b) -> BlockData m il b
forall a. Tree a -> a
rootLabel Tree (BlockData m il b)
n)
(if Attributes -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Attributes
attrs
then b -> b
forall a. a -> a
id
else Attributes -> b -> b
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs) (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Tree (BlockData m il b) -> b -> b
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> bl -> bl
addRange Tree (BlockData m il b)
n (b -> b)
-> ParsecT [Tok] (BPState m il b) m b
-> ParsecT [Tok] (BPState m il b) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockSpec m il b
-> Tree (BlockData m il b) -> ParsecT [Tok] (BPState m il b) m b
forall (m :: * -> *) il bl.
BlockSpec m il bl -> BlockNode m il bl -> BlockParser m il bl bl
blockConstructor (BlockData m il b -> BlockSpec m il b
forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec (Tree (BlockData m il b) -> BlockData m il b
forall a. Tree a -> a
rootLabel Tree (BlockData m il b)
n)) Tree (BlockData m il b)
n
docSpec :: (Monad m, IsBlock il bl, Monoid bl) => BlockSpec m il bl
docSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, Monoid bl) =>
BlockSpec m il bl
docSpec = BlockSpec
{ blockType :: Text
blockType = Text
"Doc"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = BlockParser m il bl BlockStartResult
forall a. ParsecT [Tok] (BPState m il bl) m a
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 = \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 a b.
(a -> b)
-> ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
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 :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
refLinkDefSpec = BlockSpec
{ blockType :: Text
blockType = Text
"ReferenceLinkDefinition"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = BlockParser m il bl BlockStartResult
forall a. ParsecT [Tok] (BPState m il bl) m a
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 a. ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
, blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor = \BlockNode m il bl
node -> do
let linkdefs :: [((SourceRange, Text), LinkInfo)]
linkdefs = 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 a. a -> ParsecT [Tok] (BPState m il bl) m a
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 (\((SourceRange
range, Text
lab), 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
}
extractReferenceLinks :: (Monad m, IsBlock il bl)
=> BlockNode m il bl
-> BlockParser m il bl (Maybe (BlockNode m il bl),
Maybe (BlockNode m il bl))
BlockNode m il bl
node = do
st <- ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
res <- lift $ runParserT ((,) <$> ((lookAhead anyTok >>= setPosition . tokPos) >>
many1 (linkReferenceDef (choice $ attributeParsers st)))
<*> getInput) st "" (getBlockText node)
case res of
Left ParseError
_ -> (Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
-> ParsecT
[Tok]
(BPState m il bl)
m
(Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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 ([((SourceRange, Text), LinkInfo)]
linkdefs, [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_
(\((SourceRange
_,Text
lab),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
$ \BPState m il bl
s -> BPState m il bl
s{
referenceMap = insertReference lab linkinfo
(referenceMap s) }) [((SourceRange, Text), LinkInfo)]
linkdefs
let isRefPos :: SourcePos -> Bool
isRefPos = case [Tok]
toks' of
(Tok
t:[Tok]
_) -> (SourcePos -> SourcePos -> Bool
forall a. Ord a => a -> a -> Bool
< Tok -> SourcePos
tokPos Tok
t)
[Tok]
_ -> Bool -> SourcePos -> Bool
forall a b. a -> b -> a
const Bool
False
let node' :: Maybe (BlockNode m il bl)
node' = if [Tok] -> Bool
forall a. [a] -> 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 =
(rootLabel node){
blockLines = [toks'],
blockStartPos = dropWhile isRefPos
(blockStartPos (rootLabel node))
}
}
let refnode :: BlockNode m il bl
refnode = BlockNode m il bl
node{ rootLabel =
(rootLabel node){
blockLines = takeWhile (any (isRefPos . tokPos))
(blockLines (rootLabel node))
, blockStartPos = takeWhile isRefPos
(blockStartPos (rootLabel node))
, blockData = toDyn linkdefs
, blockSpec = refLinkDefSpec
}}
(Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
-> ParsecT
[Tok]
(BPState m il bl)
m
(Maybe (BlockNode m il bl), Maybe (BlockNode m il bl))
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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 :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
attributeSpec = BlockSpec
{ blockType :: Text
blockType = Text
"Attribute"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = do
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
guard $ not (null attrParsers)
interruptsParagraph >>= guard . not
nonindentSpaces
pos <- getPosition
attrs <- choice attrParsers
skipWhile (hasType Spaces)
lookAhead (void lineEnd <|> eof)
addNodeToStack $
Node (defBlockData attributeSpec){
blockData = toDyn attrs,
blockStartPos = [pos] } []
return 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 = \BlockNode m il bl
n -> do
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
guard $ not (null attrParsers)
nonindentSpaces
pos <- getPosition
attrs <- choice attrParsers
skipWhile (hasType Spaces)
lookAhead (void lineEnd <|> eof)
let 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
oldattrs Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
attrs
return (pos, n{ rootLabel = (rootLabel n){
blockData = toDyn attrs' }})
, blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor = \BlockNode m il bl
_ -> bl -> BlockParser m il bl bl
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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 = \BlockNode m il bl
node 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
$ \BPState m il bl
st -> BPState m il bl
st{ nextAttributes = 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 :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec = BlockSpec
{ blockType :: Text
blockType = Text
"Paragraph"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = do
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 a b.
ParsecT [Tok] (BPState m il bl) m a
-> (a -> ParsecT [Tok] (BPState m il bl) m b)
-> ParsecT [Tok] (BPState m il bl) m b
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)
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
notFollowedBy lineEnd
addNodeToStack $
Node (defBlockData paraSpec){
blockStartPos = [pos] } []
return 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 = \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)
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
notFollowedBy lineEnd
return $! (pos, n)
, blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor = \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 = \BlockNode m il bl
child BlockNode m il bl
parent -> do
(mbchild, 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 (mbchild, mbrefdefs) of
(Maybe (BlockNode m il bl)
_, Maybe (BlockNode m il bl)
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
(Maybe (BlockNode m il bl)
Nothing, Just BlockNode m il bl
refnode)
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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 =
refnode : subForest parent }
(Just BlockNode m il bl
child', Just BlockNode m il bl
refnode)
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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 =
child' : refnode : subForest parent }
}
plainSpec :: (Monad m, IsBlock il bl)
=> BlockSpec m il bl
plainSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
plainSpec = BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec{
blockConstructor = \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 :: forall (m :: * -> *) s.
Monad m =>
ParsecT [Tok] s m Attributes
-> ParsecT [Tok] s m ((SourceRange, Text), LinkInfo)
linkReferenceDef 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
startpos <- ParsecT [Tok] s m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
lab <- pLinkLabel
guard $ not $ T.all isSpace lab
symbol ':'
optional whitespace
linkpos <- getPosition
dest <- pLinkDestination
(title, attrs) <- option (mempty, mempty) $ try $ do
tit <- option mempty $ try (whitespace *> pLinkTitle)
skipWhile (hasType Spaces)
as <- option mempty attrParser
skipWhile (hasType Spaces)
lookAhead (void lineEnd <|> eof)
return (tit, as)
endpos <- getPosition
void lineEnd <|> eof
return ((SourceRange [(startpos, endpos)], lab),
LinkInfo{ linkDestination = unEntity dest
, linkTitle = unEntity title
, linkAttributes = attrs
, linkPos = Just linkpos })
atxHeadingSpec :: (Monad m, IsBlock il bl)
=> BlockSpec m il bl
atxHeadingSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
atxHeadingSpec = BlockSpec
{ blockType :: Text
blockType = Text
"ATXHeading"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = do
ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
hashes <- many1 (symbol '#')
let level = [Tok] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
hashes
guard $ level <= 6
(spaceTok *> skipMany spaceTok)
<|> void (lookAhead lineEnd)
<|> lookAhead eof
raw <- many (satisfyTok (not . hasType LineEnd))
let removeClosingHash (Int
_ :: Int) [] = []
removeClosingHash Int
0 (Tok TokType
Spaces SourcePos
_ Text
_ : [Tok]
xs) =
Int -> [Tok] -> [Tok]
removeClosingHash Int
0 [Tok]
xs
removeClosingHash Int
_ (Tok (Symbol Char
'#') SourcePos
_ Text
_ :
Tok (Symbol Char
'\\') SourcePos
_ Text
_ : [Tok]
_) =
[Tok] -> [Tok]
forall a. [a] -> [a]
reverse [Tok]
raw
removeClosingHash Int
_ (Tok (Symbol Char
'#') SourcePos
_ Text
_ : [Tok]
xs) =
Int -> [Tok] -> [Tok]
removeClosingHash Int
1 [Tok]
xs
removeClosingHash Int
1 (Tok TokType
Spaces SourcePos
_ Text
_ : [Tok]
xs) = [Tok]
xs
removeClosingHash Int
1 (Tok
x:[Tok]
_)
| Tok -> TokType
tokType Tok
x TokType -> TokType -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> TokType
Symbol Char
'#' = [Tok] -> [Tok]
forall a. [a] -> [a]
reverse [Tok]
raw
removeClosingHash Int
_ [Tok]
xs = [Tok]
xs
let 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 Int
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
addNodeToStack $ Node (defBlockData atxHeadingSpec){
blockLines = [raw'],
blockData = toDyn level,
blockStartPos = [pos] } []
return 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 a. ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
, blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor = \BlockNode m il bl
node -> do
let level :: Int
level = 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)) Int
1
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)
return $! heading level ils
, blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize = \node :: BlockNode m il bl
node@(Node BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode m il bl
parent -> do
let oldAttr :: Attributes
oldAttr = 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, 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 a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
toks, Attributes
forall a. Monoid a => a
mempty))
defaultFinalizer (Node cdata{ blockAttributes = oldAttr <> attr
, blockLines = [newtoks] }
children) parent
}
setextHeadingSpec :: (Monad m, IsBlock il bl)
=> BlockSpec m il bl
setextHeadingSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
setextHeadingSpec = BlockSpec
{ blockType :: Text
blockType = Text
"SetextHeading"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = do
(cur: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
guard $ blockParagraph (bspec cur)
nonindentSpaces
pos <- getPosition
level <- (2 :: Int) <$ skipMany1 (symbol '-')
<|> (1 :: Int) <$ skipMany1 (symbol '=')
skipWhile (hasType Spaces)
lookAhead (eof <|> void lineEnd)
(mbcur, mbrefdefs) <- extractReferenceLinks cur
updateState $ \BPState m il bl
st ->
BPState m il bl
st{ nodeStack = case mbrefdefs of
Maybe (BlockNode m il bl)
Nothing -> [BlockNode m il bl]
rest
Just BlockNode m il bl
rd -> case [BlockNode m il bl]
rest of
(BlockNode m il bl
x:[BlockNode m il bl]
xs) ->
BlockNode m il bl
x{ subForest =
rd : subForest 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 mbcur of
Maybe (BlockNode m il bl)
Nothing -> BlockParser m il bl BlockStartResult
forall a. ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just BlockNode m il bl
cur' -> do
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 -> [Tree a] -> Tree a
Node (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
cur'){
blockSpec = setextHeadingSpec,
blockData = toDyn level,
blockStartPos =
blockStartPos (rootLabel cur') ++ [pos] }
[]
BlockStartResult -> BlockParser m il bl BlockStartResult
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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 a. ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
, blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor = \BlockNode m il bl
node -> do
let level :: Int
level = 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)) Int
1
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)
return $! heading level ils
, blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize = \node :: BlockNode m il bl
node@(Node BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode m il bl
parent -> do
let oldAttr :: Attributes
oldAttr = 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, 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 a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
toks, Attributes
forall a. Monoid a => a
mempty))
defaultFinalizer (Node cdata{ blockAttributes = oldAttr <> attr
, blockLines = [newtoks] }
children) parent
}
parseFinalAttributes :: Monad m
=> Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
parseFinalAttributes :: forall (m :: * -> *) il bl.
Monad m =>
Bool -> [Tok] -> BlockParser m il bl ([Tok], Attributes)
parseFinalAttributes Bool
requireWhitespace [Tok]
ts = do
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
-> 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 a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
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 a b.
ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m b
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 a b.
ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
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 a b.
ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
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
st <- getState
res <- lift $ runParserT
((,) <$> many (notFollowedBy pAttr' >> anyTok)
<*> option [] pAttr') st "heading contents" ts
case res of
Left ParseError
_ -> ParsecT [Tok] (BPState m il bl) m ([Tok], Attributes)
forall a. ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Right ([Tok]
xs, Attributes
ys) -> ([Tok], Attributes)
-> ParsecT [Tok] (BPState m il bl) m ([Tok], Attributes)
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tok]
xs, Attributes
ys)
blockQuoteSpec :: (Monad m, IsBlock il bl) => BlockSpec m il bl
blockQuoteSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
blockQuoteSpec = BlockSpec
{ blockType :: Text
blockType = Text
"BlockQuote"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = do
ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
_ <- symbol '>'
_ <- option 0 (gobbleSpaces 1)
addNodeToStack $
Node (defBlockData blockQuoteSpec){
blockStartPos = [pos] } []
return 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 = \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
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
_ <- symbol '>'
_ <- gobbleUpToSpaces 1
return (pos, 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 a b.
(a -> b)
-> ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
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 :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockParser m il bl ListType -> BlockSpec m il bl
listItemSpec BlockParser m il bl ListType
parseListMarker = BlockSpec
{ blockType :: Text
blockType = Text
"ListItem"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = do
(pos, 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 = BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> [Tree 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 = toDyn lidata,
blockStartPos = [pos] } []
let listdata = ListData{
listType :: ListType
listType = ListItemData -> ListType
listItemType ListItemData
lidata
, listSpacing :: ListSpacing
listSpacing = ListSpacing
TightList }
let listnode = BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> [Tree 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 = toDyn listdata,
blockStartPos = [pos] } []
(cur:_) <- nodeStack <$> getState
when (blockParagraph (bspec cur)) $ do
guard $ case listType listdata of
BulletList Char
_ -> Bool
True
OrderedList Int
1 EnumeratorType
Decimal DelimiterType
_ -> Bool
True
ListType
_ -> Bool
False
notFollowedBy blankLine
let 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 (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 Char
'*') ListSpacing
TightList)
let isSingleRomanDigit a
n = a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
5 Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
10 Bool -> Bool -> Bool
||
a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
50 Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
100 Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
500 Bool -> Bool -> Bool
||
a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1000
let matchesOrderedListStyle
(OrderedList Int
_s1 EnumeratorType
e1 DelimiterType
d1) (OrderedList Int
s2 EnumeratorType
e2 DelimiterType
d2) =
DelimiterType
d1 DelimiterType -> DelimiterType -> Bool
forall a. Eq a => a -> a -> Bool
== DelimiterType
d2 Bool -> Bool -> Bool
&&
case (EnumeratorType
e1, EnumeratorType
e2) of
(EnumeratorType
LowerAlpha, EnumeratorType
LowerRoman) -> Int -> Bool
forall {a}. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
(EnumeratorType
UpperAlpha, EnumeratorType
UpperRoman) -> Int -> Bool
forall {a}. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
(EnumeratorType
LowerRoman, EnumeratorType
LowerAlpha) -> Int -> Bool
forall {a}. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
(EnumeratorType
UpperRoman, EnumeratorType
UpperAlpha) -> Int -> Bool
forall {a}. (Eq a, Num a) => a -> Bool
isSingleRomanDigit Int
s2
(EnumeratorType, EnumeratorType)
_ -> EnumeratorType
e1 EnumeratorType -> EnumeratorType -> Bool
forall a. Eq a => a -> a -> Bool
== EnumeratorType
e2
matchesOrderedListStyle ListType
_ ListType
_ = Bool
False
let matchesList (BulletList Char
c) (BulletList 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 ListType
_ ListType
_ = Bool
False
case blockType (bspec cur) of
Text
"List" | ListData -> ListType
listType ListData
curdata ListType -> ListType -> Bool
`matchesList`
ListItemData -> ListType
listItemType ListItemData
lidata
-> 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
linode
Text
_ -> 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
listnode ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b.
ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
linode
return 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 = \node :: BlockNode m il bl
node@(Node BlockData m il bl
ndata [BlockNode 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 Char
'*') Int
0 Bool
False Bool
False)
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
case blockBlanks ndata of
Int
_:[Int]
_ | [BlockNode m il bl] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BlockNode m il bl]
children -> 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
[Int]
_ -> () ()
-> ParsecT [Tok] (BPState m il bl) m Int
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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 ()
-> 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 (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
return (pos, node)
, 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 a b.
(a -> b)
-> ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
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 = \(Node BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode 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 Char
'*')
Int
0 Bool
False Bool
False)
let allblanks :: [Int]
allblanks = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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]
:
(BlockNode m il bl -> [Int]) -> [BlockNode 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])
-> (BlockNode m il bl -> BlockData m il bl)
-> BlockNode m il bl
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel)
((BlockNode m il bl -> Bool)
-> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"List") (Text -> Bool)
-> (BlockNode m il bl -> Text) -> BlockNode 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)
-> (BlockNode m il bl -> BlockSpec m il bl)
-> BlockNode 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)
-> (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) [BlockNode m il bl]
children)
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 = case [Int]
allblanks of
(Int
l:[Int]
_) -> Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
curline Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
[Int]
_ -> Bool
False
let blanksInside = case [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> [Int]
removeConsecutive [Int]
allblanks) of
Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> Bool
True
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Bool -> Bool
not Bool
blanksAtEnd
| Bool
otherwise -> Bool
False
let lidata' = ListItemData -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (ListItemData -> Dynamic) -> ListItemData -> Dynamic
forall a b. (a -> b) -> a -> b
$ ListItemData
lidata{ listItemBlanksInside = blanksInside
, listItemBlanksAtEnd = blanksAtEnd }
defaultFinalizer (Node cdata{ blockData = lidata' } children)
parent
}
itemStart :: Monad m
=> BlockParser m il bl ListType
-> BlockParser m il bl (SourcePos, ListItemData)
itemStart :: forall (m :: * -> *) il bl.
Monad m =>
BlockParser m il bl ListType
-> BlockParser m il bl (SourcePos, ListItemData)
itemStart BlockParser m il bl ListType
parseListMarker = do
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
gobbleUpToSpaces 3
pos <- getPosition
ty <- parseListMarker
aftercol <- sourceColumn <$> getPosition
lookAhead whitespace
numspaces <- try (gobbleUpToSpaces 4 <* notFollowedBy whitespace)
<|> gobbleSpaces 1
<|> 1 <$ lookAhead lineEnd
return (pos, ListItemData{
listItemType = ty
, listItemIndent = (aftercol - beforecol) + numspaces
, listItemBlanksInside = False
, listItemBlanksAtEnd = False
})
bulletListMarker :: Monad m => BlockParser m il bl ListType
bulletListMarker :: forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
bulletListMarker = do
Tok (Symbol c) _ _ <- 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
-> 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 Char
'*' 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 Char
'+'
return $! BulletList c
orderedListMarker :: Monad m => BlockParser m il bl ListType
orderedListMarker :: forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ListType
orderedListMarker = do
Tok WordChars _ ds <- (Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\Text
t -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
t Bool -> Bool -> Bool
&& Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10)
(start :: Int) <- either fail (return . fst) (TR.decimal ds)
delimtype <- Period <$ symbol '.' <|> OneParen <$ symbol ')'
return $! OrderedList start Decimal delimtype
listSpec :: (Monad m, IsBlock il bl) => BlockSpec m il bl
listSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
listSpec = BlockSpec
{ blockType :: Text
blockType = Text
"List"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = BlockParser m il bl BlockStartResult
forall a. ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
, blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain = \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
== Text
"ListItem"
, blockContainsLines :: Bool
blockContainsLines = Bool
False
, blockParagraph :: Bool
blockParagraph = Bool
False
, blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue = \BlockNode m il bl
n -> (,BlockNode m il bl
n) (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 = \BlockNode m il bl
node -> do
let ListData ListType
lt 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 Char
'*') 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 BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode m il bl
parent -> do
let ListData ListType
lt ListSpacing
_ = 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 Char
'*') ListSpacing
TightList)
let getListItemData :: Tree (BlockData m il bl) -> ListItemData
getListItemData (Node BlockData m il bl
d [Tree (BlockData m il bl)]
_) =
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 Char
'*') Int
0 Bool
False Bool
False)
let childrenData :: [ListItemData]
childrenData = (BlockNode m il bl -> ListItemData)
-> [BlockNode 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 [BlockNode m il bl]
children
let ls :: ListSpacing
ls = case [ListItemData]
childrenData of
ListItemData
c:[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 a. [a] -> 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
[ListItemData]
_ -> ListSpacing
TightList
blockBlanks' <- case [ListItemData]
childrenData of
ListItemData
c:[ListItemData]
_ | ListItemData -> Bool
listItemBlanksAtEnd ListItemData
c -> do
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
return $! case blockBlanks cdata of
Int
lb:[Int]
b | Int
lb Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
curline Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 ->
Int
lbInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
b
[Int]
b ->
Int
curline Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
b
[ListItemData]
_ -> [Int] -> ParsecT [Tok] (BPState m il bl) m [Int]
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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' = ListData -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (ListType -> ListSpacing -> ListData
ListData ListType
lt ListSpacing
ls)
let totight (Node BlockData m il bl
nd [Tree (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
== Text
"Paragraph"
= BlockData m il bl
-> [Tree (BlockData m il bl)] -> Tree (BlockData m il bl)
forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd{ blockSpec = plainSpec } [Tree (BlockData m il bl)]
cs
| Bool
otherwise = BlockData m il bl
-> [Tree (BlockData m il bl)] -> Tree (BlockData m il bl)
forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd [Tree (BlockData m il bl)]
cs
let childrenToTight (Node BlockData m il bl
nd [Tree (BlockData m il bl)]
cs) = BlockData m il bl
-> [Tree (BlockData m il bl)] -> Tree (BlockData m il bl)
forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
nd ((Tree (BlockData m il bl) -> Tree (BlockData m il bl))
-> [Tree (BlockData m il bl)] -> [Tree (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 [Tree (BlockData m il bl)]
cs)
let 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)
-> [BlockNode m il bl] -> [BlockNode 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 [BlockNode m il bl]
children
else [BlockNode m il bl]
children
defaultFinalizer (Node cdata{ blockData = ldata'
, blockBlanks = blockBlanks' } children')
parent
}
thematicBreakSpec :: (Monad m, IsBlock il bl)
=> BlockSpec m il bl
thematicBreakSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
thematicBreakSpec = BlockSpec
{ blockType :: Text
blockType = Text
"ThematicBreak"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = do
ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Tok (Symbol c) _ _ <- symbol '-'
<|> symbol '_'
<|> symbol '*'
skipWhile (hasType Spaces)
let 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 a b.
ParsecT [Tok] s m a -> ParsecT [Tok] s m b -> ParsecT [Tok] s m a
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)
count 2 tbchar
skipMany tbchar
(do lookAhead lineEnd
addNodeToStack (Node (defBlockData thematicBreakSpec){
blockStartPos = [pos] } [])
return BlockStartMatch) <|>
(BlockStartNoMatchBefore <$> 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 a. ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
, blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor = \BlockNode m il bl
_ -> bl -> BlockParser m il bl bl
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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 :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
indentedCodeSpec = BlockSpec
{ blockType :: Text
blockType = Text
"IndentedCode"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = do
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 a b.
ParsecT [Tok] (BPState m il bl) m a
-> (a -> ParsecT [Tok] (BPState m il bl) m b)
-> ParsecT [Tok] (BPState m il bl) m b
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 a b.
ParsecT [Tok] (BPState m il bl) m a
-> (a -> ParsecT [Tok] (BPState m il bl) m b)
-> ParsecT [Tok] (BPState m il bl) m b
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 -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleSpaces Int
4
pos <- getPosition
notFollowedBy blankLine
addNodeToStack $ Node (defBlockData indentedCodeSpec){
blockStartPos = [pos] } []
return 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 = \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 Int
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 a b.
ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
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)
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
return (pos, node)
, blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor = \BlockNode m il bl
node ->
bl -> BlockParser m il bl bl
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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 BlockData m il bl
cdata [BlockNode m il bl]
children) BlockNode m il bl
parent -> do
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 a. [a] -> 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 =
drop numblanks $ blockLines cdata
, blockStartPos =
drop numblanks $ blockStartPos 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 -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
cdata' [BlockNode m il bl]
children) BlockNode m il bl
parent
}
isblankLine :: [Tok] -> Bool
isblankLine :: [Tok] -> Bool
isblankLine [] = Bool
True
isblankLine [Tok TokType
LineEnd SourcePos
_ Text
_] = Bool
True
isblankLine (Tok TokType
Spaces SourcePos
_ Text
_ : [Tok]
xs) = [Tok] -> Bool
isblankLine [Tok]
xs
isblankLine [Tok]
_ = Bool
False
fencedCodeSpec :: (Monad m, IsBlock il bl)
=> BlockSpec m il bl
fencedCodeSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
fencedCodeSpec = BlockSpec
{ blockType :: Text
blockType = Text
"FencedCode"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = do
prepos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
nonindentSpaces
pos <- getPosition
let indentspaces = SourcePos -> Int
sourceColumn SourcePos
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceColumn SourcePos
prepos
(c, ticks) <- (('`',) <$> many1 (symbol '`'))
<|> (('~',) <$> many1 (symbol '~'))
let fencelength = [Tok] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ticks
guard $ fencelength >= 3
skipWhile (hasType Spaces)
let 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
'`' | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`'])
info <- T.strip . unEntity <$> many (pEscapedSymbol <|> infoTok)
lookAhead $ void lineEnd <|> eof
let infotoks = SourceName -> Text -> [Tok]
tokenize SourceName
"info string" Text
info
(content, attrs) <- parseFinalAttributes False infotoks
<|> (return (infotoks, mempty))
addNodeToStack $
Node (defBlockData fencedCodeSpec){
blockData = toDyn
(c, fencelength, indentspaces,
untokenize content, attrs),
blockStartPos = [pos] } []
return 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 = \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 ((Char
c, Int
fencelength, Int
_, Text
_, Attributes
_)
:: (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))
(Char
'`', Int
3, Int
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
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
ts <- many1 (symbol c)
guard $ length ts >= fencelength
skipWhile (hasType Spaces)
lookAhead $ void lineEnd <|> eof
endOfBlock
return $! (pos, 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 ((Char
_, Int
_, Int
indentspaces, Text
_, Attributes
_)
:: (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))
(Char
'`', Int
3, Int
0, Text
forall a. Monoid a => a
mempty, Attributes
forall a. Monoid a => a
mempty)
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
_ <- gobbleUpToSpaces indentspaces
return (pos, node))
, blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor = \BlockNode m il bl
node -> do
let ((Char
_, Int
_, Int
_, Text
info, Attributes
attrs) :: (Char, Int, Int, Text, Attributes)) =
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)) (Char
'`', Int
3, Int
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 Int
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 a. a -> ParsecT [Tok] (BPState m il bl) m a
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 a. [a] -> 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 :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
rawHtmlSpec = BlockSpec
{ blockType :: Text
blockType = Text
"RawHTML"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = do
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(rawHtmlType, toks) <- withRaw $
do nonindentSpaces
symbol '<'
ty <- choice $ map (\Int
n -> Int
n Int
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m Int
forall a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
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]
finished <- option False $ do
guard (ty /= 6 && ty /= 7)
endCond ty
return True
when (ty == 7) $ do
(n:_) <- nodeStack <$> getState
guard $ not $ blockParagraph (bspec n)
skipWhile (not . hasType LineEnd)
return $! if finished then 0 else ty
addNodeToStack $ Node (defBlockData rawHtmlSpec){
blockData = toDyn rawHtmlType,
blockLines = [toks],
blockStartPos = [pos] } []
return 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 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)
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
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
case fromDyn (blockData (rootLabel node)) (0 :: Int) of
Int
0 -> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a. ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Int
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 a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
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
Int
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 a b.
a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m a
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
Int
n ->
(do pos' <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
lookAhead (endCond n)
endOfBlock
toks <- many (satisfyTok (not . hasType LineEnd))
le <- option [] $ (:[]) <$> lookAhead lineEnd
return $! (pos', Node ndata{
blockData = toDyn (0 :: Int)
, blockLines = (toks ++ le) : blockLines ndata
} 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 a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
pos, BlockNode m il bl
node))
, blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor = \BlockNode m il bl
node ->
bl -> BlockParser m il bl bl
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
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 Text
"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
}
startCond :: Monad m => Int -> BlockParser m il bl ()
startCond :: forall (m :: * -> *) il bl.
Monad m =>
Int -> BlockParser m il bl ()
startCond Int
1 = 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 ())
-> ParsecT [Tok] (BPState m il bl) m Tok
-> 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 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 [Text
"script",Text
"pre",Text
"style",Text
"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 Char
'>'
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 Int
2 = 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 ())
-> ParsecT [Tok] (BPState m il bl) m Tok
-> 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 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
'!'
Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'
startCond Int
3 = 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 ())
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
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 Char
'?'
startCond Int
4 = 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 ())
-> ParsecT [Tok] (BPState m il bl) m Tok
-> 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 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
'!'
(Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (\Text
t -> case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
c, Text
_) -> Char -> Bool
isAsciiLetter Char
c
Maybe (Char, Text)
_ -> Bool
False)
startCond Int
5 = 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 ())
-> ParsecT [Tok] (BPState m il bl) m Tok
-> 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 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
'!'
Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'['
(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
== Text
"CDATA")
Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'['
startCond Int
6 = 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 ())
-> ParsecT [Tok] (BPState m il bl) m Tok
-> 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 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
-> 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 (Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/')
(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 [Text
"address", Text
"article", Text
"aside", Text
"base",
Text
"basefont", Text
"blockquote", Text
"body", Text
"caption", Text
"center", Text
"col",
Text
"colgroup", Text
"dd", Text
"details", Text
"dialog", Text
"dir", Text
"div", Text
"dl",
Text
"dt", Text
"fieldset", Text
"figcaption", Text
"figure", Text
"footer", Text
"form", Text
"frame",
Text
"frameset", Text
"h1", Text
"h2", Text
"h3", Text
"h4", Text
"h5", Text
"h6", Text
"head", Text
"header",
Text
"hr", Text
"html", Text
"iframe", Text
"legend", Text
"li", Text
"link", Text
"main", Text
"menu",
Text
"menuitem", Text
"nav", Text
"noframes", Text
"ol", Text
"optgroup", Text
"option",
Text
"p", Text
"param", Text
"search", Text
"section", Text
"summary", Text
"table", Text
"tbody",
Text
"td", Text
"tfoot", Text
"th", Text
"thead", Text
"title", Text
"tr", Text
"track", Text
"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 Char
'>'
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 Char
'/' 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.
ParsecT [Tok] (BPState m il bl) m a
-> ParsecT [Tok] (BPState m il bl) m b
-> ParsecT [Tok] (BPState m il bl) m b
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 Char
'>')
startCond Int
7 = 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 ())
-> ParsecT [Tok] (BPState m il bl) m Tok
-> 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 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
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
guard $ not $ any (hasType LineEnd) toks
skipWhile (hasType Spaces)
lookAhead lineEnd
startCond Int
n = SourceName -> ParsecT [Tok] (BPState m il bl) m ()
forall a. SourceName -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. MonadFail m => SourceName -> m a
fail (SourceName -> ParsecT [Tok] (BPState m il bl) m ())
-> SourceName -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ SourceName
"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 :: forall (m :: * -> *) il bl.
Monad m =>
Int -> BlockParser m il bl ()
endCond Int
1 = 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 (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
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
'<'
Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'/'
(Text -> Bool) -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord ([Text] -> Text -> Bool
isOneOfCI [Text
"script",Text
"pre",Text
"style",Text
"textarea"])
Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'>'
ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
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 Int
2 = 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 (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
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 Char
'-' ParsecT [Tok] u m Tok
-> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
forall a b.
ParsecT [Tok] u m a -> ParsecT [Tok] u m b -> ParsecT [Tok] u m b
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 Char
'-' ParsecT [Tok] u m Tok
-> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
forall a b.
ParsecT [Tok] u m a -> ParsecT [Tok] u m b -> ParsecT [Tok] u m b
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 Char
'>'
ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
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 Int
3 = 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 (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
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 Char
'?' ParsecT [Tok] u m Tok
-> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
forall a b.
ParsecT [Tok] u m a -> ParsecT [Tok] u m b -> ParsecT [Tok] u m b
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 Char
'>'
ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
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 Int
4 = 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 (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 Tok
-> ParsecT [Tok] (BPState m il bl) m ()
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 Char
'>')
endCond Int
5 = 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 (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
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 Char
']' ParsecT [Tok] u m Tok
-> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
forall a b.
ParsecT [Tok] u m a -> ParsecT [Tok] u m b -> ParsecT [Tok] u m b
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 Char
']' ParsecT [Tok] u m Tok
-> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m Tok
forall a b.
ParsecT [Tok] u m a -> ParsecT [Tok] u m b -> ParsecT [Tok] u m b
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 Char
'>'
ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
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 Int
6 = ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
endCond Int
7 = ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
endCond Int
n = SourceName -> ParsecT [Tok] (BPState m il bl) m ()
forall a. SourceName -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. MonadFail m => SourceName -> m a
fail (SourceName -> ParsecT [Tok] (BPState m il bl) m ())
-> SourceName -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ SourceName
"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 :: forall (m :: * -> *) il bl. 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 (Int
x:Int
y:[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
+ Int
1 = [Int] -> [Int]
removeConsecutive (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
zs)
removeConsecutive [Int]
xs = [Int]
xs
isAsciiLetter :: Char -> Bool
isAsciiLetter :: Char -> Bool
isAsciiLetter Char
c =
Char -> Bool
isAsciiUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiLower Char
c
collapseNodeStack :: [BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
collapseNodeStack :: forall (m :: * -> *) il bl.
[BlockNode m il bl] -> BlockParser m il bl (BlockNode m il bl)
collapseNodeStack [] = SourceName -> BlockParser m il bl (BlockNode m il bl)
forall a. HasCallStack => SourceName -> a
error SourceName
"Empty node stack!"
collapseNodeStack (BlockNode m il bl
n:[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 BlockNode m il bl
child 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
$ SourceName
"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]
++
SourceName
" 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 :: forall (m :: * -> *) il bl. 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 :: forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ()
endOfBlock = (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
$ \BPState m il bl
st -> BPState m il bl
st{ blockMatched = False }