{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
module Commonmark.Extensions.Attributes
( attributesSpec
, HasDiv(..)
, fencedDivSpec
, HasSpan(..)
, bracketedSpanSpec
, rawAttributeSpec
, pAttributes
)
where
import Commonmark.Types
import Commonmark.Tag (htmlAttributeName, htmlDoubleQuotedAttributeValue)
import Commonmark.Tokens
import Commonmark.Syntax
import Commonmark.Inlines
import Commonmark.TokParsers
import Commonmark.SourceMap
import Commonmark.Blocks
import Commonmark.Entity (unEntity)
import Commonmark.Html
import Data.Dynamic
import Data.Tree
import Control.Monad (mzero, guard, void)
import Text.Parsec
class HasDiv bl where
div_ :: bl -> bl
instance HasDiv (Html a) where
div_ :: Html a -> Html a
div_ Html a
bs = forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"div" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a. Text -> Html a
htmlRaw Text
"\n" forall a. Semigroup a => a -> a -> a
<> Html a
bs)
instance (HasDiv bl, Semigroup bl)
=> HasDiv (WithSourceMap bl) where
div_ :: WithSourceMap bl -> WithSourceMap bl
div_ WithSourceMap bl
bs = (forall bl. HasDiv bl => bl -> bl
div_ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap bl
bs) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"div"
fencedDivSpec
:: (Monad m, IsInline il, IsBlock il bl, HasDiv bl)
=> SyntaxSpec m il bl
fencedDivSpec :: forall (m :: * -> *) il bl.
(Monad m, IsInline il, IsBlock il bl, HasDiv bl) =>
SyntaxSpec m il bl
fencedDivSpec = forall a. Monoid a => a
mempty
{ syntaxBlockSpecs :: [BlockSpec m il bl]
syntaxBlockSpecs = [forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDiv bl) =>
BlockSpec m il bl
fencedDivBlockSpec] }
fencedDivBlockSpec :: (Monad m, IsBlock il bl, HasDiv bl)
=> BlockSpec m il bl
fencedDivBlockSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDiv bl) =>
BlockSpec m il bl
fencedDivBlockSpec = BlockSpec
{ blockType :: Text
blockType = Text
"FencedDiv"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
SourcePos
prepos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m ()
nonindentSpaces
SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
let indentspaces :: Int
indentspaces = SourcePos -> Int
sourceColumn SourcePos
pos forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceColumn SourcePos
prepos
[Tok]
colons <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':')
let fencelength :: Int
fencelength = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
colons
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
fencelength forall a. Ord a => a -> a -> Bool
>= Int
3
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
Attributes
attrs <- forall u (m :: * -> *). Monad m => ParsecT [Tok] u m Attributes
pAttributes forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(do [Tok]
bareWordToks <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1
(forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (forall a b. a -> b -> a
const Bool
True) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anySymbol)
forall (m :: * -> *) a. Monad m => a -> m a
return [(Text
"class", [Tok] -> Text
untokenize [Tok]
bareWordToks)])
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack forall a b. (a -> b) -> a -> b
$
forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDiv bl) =>
BlockSpec m il bl
fencedDivBlockSpec){
blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn
(Int
fencelength, Int
indentspaces, Attributes
attrs),
blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
, blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain = forall a b. a -> b -> a
const Bool
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
node -> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m ()
nonindentSpaces
SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
[Tok]
ts <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':')
let closelength :: Int
closelength = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
let fencelength :: Int
fencelength = forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDiv bl) =>
BlockNode m il bl -> Int
getFenceLength BlockNode m il bl
node
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
closelength forall a. Ord a => a -> a -> Bool
>= Int
fencelength
[BlockNode m il bl]
ns <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
(\BlockNode m il bl
n ->
(forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec (forall a. Tree a -> a
rootLabel BlockNode m il bl
n))) forall a. Eq a => a -> a -> Bool
== Text
"FencedDiv" Bool -> Bool -> Bool
&&
(forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDiv bl) =>
BlockNode m il bl -> Int
getFenceLength BlockNode m il bl
n) forall a. Ord a => a -> a -> Bool
<= Int
closelength) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\BlockNode m il bl
n -> Bool -> Bool
not
(forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType (forall (m :: * -> *) il bl. BlockData m il bl -> BlockSpec m il bl
blockSpec (forall a. Tree a -> a
rootLabel BlockNode m il bl
n)) forall a. Eq a => a -> a -> Bool
== Text
"FencedDiv" Bool -> Bool -> Bool
&&
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (forall a. Tree a -> a
rootLabel BlockNode m il bl
n) forall a. Eq a => a -> a -> Bool
==
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (forall a. Tree a -> a
rootLabel BlockNode m il bl
node)))
[BlockNode m il bl]
ns
forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ()
endOfBlock
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do let ((Int
_, Int
indentspaces, Attributes
_)
:: (Int, Int, Attributes)) = forall a. Typeable a => Dynamic -> a -> a
fromDyn
(forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
(Int
3, Int
0, forall a. Monoid a => a
mempty)
SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Int
_ <- forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
indentspaces
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node))
, blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor = \BlockNode m il bl
node -> do
let ((Int
_, Int
_, Attributes
attrs) :: (Int, Int, Attributes)) =
forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node)) (Int
3, Int
0, forall a. Monoid a => a
mempty)
(forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bl. HasDiv bl => bl -> bl
div_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockNode m il bl -> BlockParser m il bl [bl]
renderChildren BlockNode m il bl
node
, blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize = forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer
}
getFenceLength :: (Monad m, IsBlock il bl, HasDiv bl)
=> BlockNode m il bl -> Int
getFenceLength :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDiv bl) =>
BlockNode m il bl -> Int
getFenceLength BlockNode m il bl
node =
let ((Int
fencelength, Int
_, Attributes
_)
:: (Int, Int, Attributes)) = forall a. Typeable a => Dynamic -> a -> a
fromDyn
(forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
(Int
3, Int
0, forall a. Monoid a => a
mempty)
in Int
fencelength
bracketedSpanSpec
:: (Monad m, IsInline il, HasSpan il)
=> SyntaxSpec m il bl
bracketedSpanSpec :: forall (m :: * -> *) il bl.
(Monad m, IsInline il, HasSpan il) =>
SyntaxSpec m il bl
bracketedSpanSpec = forall a. Monoid a => a
mempty
{ syntaxBracketedSpecs :: [BracketedSpec il]
syntaxBracketedSpecs = [ BracketedSpec il
bsSpec ]
}
where
bsSpec :: BracketedSpec il
bsSpec = BracketedSpec
{ bracketedName :: Text
bracketedName = Text
"Span"
, bracketedNests :: Bool
bracketedNests = Bool
True
, bracketedPrefix :: Maybe Char
bracketedPrefix = forall a. Maybe a
Nothing
, bracketedSuffixEnd :: Maybe Char
bracketedSuffixEnd = forall a. Maybe a
Nothing
, bracketedSuffix :: ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
bracketedSuffix = forall {m :: * -> *} {a} {p} {p} {u}.
(Monad m, HasSpan a) =>
p -> p -> ParsecT [Tok] u m (a -> a)
pSpanSuffix
}
pSpanSuffix :: p -> p -> ParsecT [Tok] u m (a -> a)
pSpanSuffix p
_rm p
_key = do
Attributes
attrs <- forall u (m :: * -> *). Monad m => ParsecT [Tok] u m Attributes
pAttributes
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. HasSpan a => Attributes -> a -> a
spanWith Attributes
attrs
class IsInline a => HasSpan a where
spanWith :: Attributes -> a -> a
instance Rangeable (Html a) => HasSpan (Html a) where
spanWith :: Attributes -> Html a -> Html a
spanWith Attributes
attrs Html a
ils = forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs forall a b. (a -> b) -> a -> b
$ forall a. Text -> Maybe (Html a) -> Html a
htmlInline Text
"span" (forall a. a -> Maybe a
Just Html a
ils)
instance (HasSpan i, Semigroup i, Monoid i)
=> HasSpan (WithSourceMap i) where
spanWith :: Attributes -> WithSourceMap i -> WithSourceMap i
spanWith Attributes
attrs WithSourceMap i
x = (forall a. HasSpan a => Attributes -> a -> a
spanWith Attributes
attrs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap i
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"span"
pRawSpan :: (IsInline a, Monad m) => InlineParser m a
pRawSpan :: forall a (m :: * -> *). (IsInline a, Monad m) => InlineParser m a
pRawSpan = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
Tok
tok <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'`'
forall (m :: * -> *).
Monad m =>
Tok -> InlineParser m (Either [Tok] [Tok])
pBacktickSpan Tok
tok forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\case
Left [Tok]
ticks -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. IsInline a => Text -> a
str ([Tok] -> Text
untokenize [Tok]
ticks)
Right [Tok]
codetoks -> do
let raw :: Text
raw = [Tok] -> Text
untokenize [Tok]
codetoks
(do Format
f <- forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Format
pRawAttribute
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. IsInline a => Format -> Text -> a
rawInline Format
f Text
raw)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. IsInline a => Text -> a
code forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
normalizeCodeSpan forall a b. (a -> b) -> a -> b
$ Text
raw)
rawAttributeSpec :: (Monad m, IsBlock il bl)
=> SyntaxSpec m il bl
rawAttributeSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
SyntaxSpec m il bl
rawAttributeSpec = forall a. Monoid a => a
mempty
{ syntaxBlockSpecs :: [BlockSpec m il bl]
syntaxBlockSpecs = [ forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
rawAttributeBlockSpec ]
, syntaxInlineParsers :: [InlineParser m il]
syntaxInlineParsers = [ forall a (m :: * -> *). (IsInline a, Monad m) => InlineParser m a
pRawSpan ]
}
rawAttributeBlockSpec :: (Monad m, IsBlock il bl)
=> BlockSpec m il bl
rawAttributeBlockSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
rawAttributeBlockSpec = BlockSpec
{ blockType :: Text
blockType = Text
"RawBlock"
, blockStart :: BlockParser m il bl BlockStartResult
blockStart = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
SourcePos
prepos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m ()
nonindentSpaces
SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
let indentspaces :: Int
indentspaces = SourcePos -> Int
sourceColumn SourcePos
pos forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceColumn SourcePos
prepos
(Char
c, [Tok]
ticks) <- ((Char
'`',) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'`'))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Char
'~',) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'~'))
let fencelength :: Int
fencelength = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ticks
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
fencelength forall a. Ord a => a -> a -> Bool
>= Int
3
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
Format
fmt <- forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Format
pRawAttribute
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack forall a b. (a -> b) -> a -> b
$
forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
rawAttributeBlockSpec){
blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn
(Char
c, Int
fencelength, Int
indentspaces, Format
fmt),
blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
, blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain = forall a b. a -> b -> a
const Bool
False
, blockContainsLines :: Bool
blockContainsLines = Bool
True
, blockParagraph :: Bool
blockParagraph = Bool
False
, blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue = \BlockNode m il bl
node -> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
let ((Char
c, Int
fencelength, Int
_, Format
_)
:: (Char, Int, Int, Format)) = forall a. Typeable a => Dynamic -> a -> a
fromDyn
(forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
(Char
'`', Int
3, Int
0, Text -> Format
Format forall a. Monoid a => a
mempty)
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m ()
nonindentSpaces
SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
[Tok]
ts <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
c)
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts forall a. Ord a => a -> a -> Bool
>= Int
fencelength
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ()
endOfBlock
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do let ((Char
_, Int
_, Int
indentspaces, Format
_)
:: (Char, Int, Int, Format)) = forall a. Typeable a => Dynamic -> a -> a
fromDyn
(forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
(Char
'`', Int
3, Int
0, Text -> Format
Format forall a. Monoid a => a
mempty)
SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Int
_ <- forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
indentspaces
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node))
, blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor = \BlockNode m il bl
node -> do
let ((Char
_, Int
_, Int
_, Format
fmt) :: (Char, Int, Int, Format)) =
forall a. Typeable a => Dynamic -> a -> a
fromDyn (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData (forall a. Tree a -> a
rootLabel BlockNode m il bl
node))
(Char
'`', Int
3, Int
0, Text -> Format
Format forall a. Monoid a => a
mempty)
let codetext :: Text
codetext = [Tok] -> Text
untokenize forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 (forall (m :: * -> *) il bl. BlockNode m il bl -> [Tok]
getBlockText BlockNode m il bl
node)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall il b. IsBlock il b => Format -> Text -> b
rawBlock Format
fmt Text
codetext
, blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize = forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer
}
attributesSpec
:: (Monad m, IsInline il)
=> SyntaxSpec m il bl
attributesSpec :: forall (m :: * -> *) il bl.
(Monad m, IsInline il) =>
SyntaxSpec m il bl
attributesSpec = forall a. Monoid a => a
mempty
{ syntaxAttributeParsers :: forall u (m1 :: * -> *).
Monad m1 =>
[ParsecT [Tok] u m1 Attributes]
syntaxAttributeParsers = [forall u (m :: * -> *). Monad m => ParsecT [Tok] u m Attributes
pAttributes]
}
pAttributes :: forall u m . Monad m => ParsecT [Tok] u m Attributes
pAttributes :: forall u (m :: * -> *). Monad m => ParsecT [Tok] u m Attributes
pAttributes = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall {u}. ParsecT [Tok] u m Attributes
pattr
where
pattr :: ParsecT [Tok] u m Attributes
pattr = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'{'
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
let pAttribute :: ParsecT [Tok] u m Attribute
pAttribute = forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pIdentifier forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pClass forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pKeyValue
Attribute
a <- forall {u}. ParsecT [Tok] u m Attribute
pAttribute
Attributes
as <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pIdentifier forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pClass forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pKeyValue))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'}'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Attribute
aforall a. a -> [a] -> [a]
:Attributes
as)
pRawAttribute :: Monad m => ParsecT [Tok] u m Format
pRawAttribute :: forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Format
pRawAttribute = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'{'
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'='
Tok TokType
_ SourcePos
_ Text
t <- forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (forall a b. a -> b -> a
const Bool
True)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'}'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Text -> Format
Format Text
t
pIdentifier :: Monad m => ParsecT [Tok] u m Attribute
pIdentifier :: forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pIdentifier = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'#'
[Tok]
xs <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (forall a b. a -> b -> a
const Bool
True)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\Tok
c -> TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'-') Tok
c Bool -> Bool -> Bool
|| TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'_') Tok
c
Bool -> Bool -> Bool
|| TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
':') Tok
c Bool -> Bool -> Bool
|| TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'.') Tok
c)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Text
"id", [Tok] -> Text
unEntity [Tok]
xs)
pClass :: Monad m => ParsecT [Tok] u m Attribute
pClass :: forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pClass = do
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'.'
[Tok]
xs <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (forall a b. a -> b -> a
const Bool
True)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (\Tok
c -> TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'-') Tok
c Bool -> Bool -> Bool
|| TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'_') Tok
c)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Text
"class", [Tok] -> Text
unEntity [Tok]
xs)
pKeyValue :: Monad m => ParsecT [Tok] u m Attribute
pKeyValue :: forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pKeyValue = do
[Tok]
name <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeName
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'='
[Tok]
val <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlDoubleQuotedAttributeValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s.
Monad m =>
[TokType] -> ParsecT [Tok] s m Tok
noneOfToks [TokType
Spaces, TokType
LineEnd, Char -> TokType
Symbol Char
'<', Char -> TokType
Symbol Char
'>',
Char -> TokType
Symbol Char
'=', Char -> TokType
Symbol Char
'`', Char -> TokType
Symbol Char
'\'', Char -> TokType
Symbol Char
'"',
Char -> TokType
Symbol Char
'}'])
let val' :: [Tok]
val' = case [Tok]
val of
Tok (Symbol Char
'"') SourcePos
_ Text
_:Tok
_:[Tok]
_ -> forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ [Tok]
val
Tok (Symbol Char
'\'') SourcePos
_ Text
_:Tok
_:[Tok]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
[Tok]
_ -> [Tok]
val
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ([Tok] -> Text
untokenize [Tok]
name, [Tok] -> Text
unEntity [Tok]
val')