{-# 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 = Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"div" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
forall a b. (a -> b) -> a -> b
$ Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\n" Html a -> Html a -> Html a
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 = (bl -> bl
forall bl. HasDiv bl => bl -> bl
div_ (bl -> bl) -> WithSourceMap bl -> WithSourceMap bl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap bl
bs) WithSourceMap bl -> WithSourceMap () -> WithSourceMap bl
forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
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 = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxBlockSpecs = [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          = BlockParser m il bl BlockStartResult
-> BlockParser m il bl BlockStartResult
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (BlockParser m il bl BlockStartResult
 -> BlockParser m il bl BlockStartResult)
-> BlockParser m il bl BlockStartResult
-> BlockParser m il bl BlockStartResult
forall a b. (a -> b) -> a -> b
$ do
             SourcePos
prepos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m ()
nonindentSpaces
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             let indentspaces :: Int
indentspaces = SourcePos -> Int
sourceColumn SourcePos
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceColumn SourcePos
prepos
             [Tok]
colons <- ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':')
             let fencelength :: Int
fencelength = [Tok] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
colons
             Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ Int
fencelength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             Attributes
attrs <- ParsecT [Tok] (BPState m il bl) m Attributes
forall u (m :: * -> *). Monad m => ParsecT [Tok] u m Attributes
pAttributes 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 s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                      (do [Tok]
bareWordToks <- ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1
                           ((Text -> Bool) -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True) 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
anySymbol)
                          Attributes -> ParsecT [Tok] (BPState m il bl) m Attributes
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Text
"class", [Tok] -> Text
untokenize [Tok]
bareWordToks)])
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (BPState m il bl) m ()
 -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
             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 (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, HasDiv bl) =>
BlockSpec m il bl
fencedDivBlockSpec){
                          blockData = toDyn
                               (fencelength, indentspaces, attrs),
                          blockStartPos = [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
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 -> 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
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m ()
nonindentSpaces
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             [Tok]
ts <- ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':')
             let closelength :: Int
closelength = [Tok] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (BPState m il bl) m ()
 -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
             let fencelength :: Int
fencelength = BlockNode m il bl -> Int
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDiv bl) =>
BlockNode m il bl -> Int
getFenceLength BlockNode m il bl
node
             Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ Int
closelength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fencelength
             -- ensure that there aren't subordinate open fenced divs
             -- with fencelength <= closelength:
             [BlockNode m il bl]
ns <- BPState m il bl -> [BlockNode m il bl]
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m il bl -> [BlockNode m il bl])
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m [BlockNode m il bl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
             Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (BlockNode m il bl -> Bool) -> [BlockNode m il bl] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
               (\BlockNode m il bl
n ->
                 (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 (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
n))) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"FencedDiv" Bool -> Bool -> Bool
&&
                 (BlockNode m il bl -> Int
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDiv bl) =>
BlockNode m il bl -> Int
getFenceLength BlockNode m il bl
n) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
closelength) ([BlockNode m il bl] -> Bool) -> [BlockNode m il bl] -> Bool
forall a b. (a -> b) -> a -> b
$
               (BlockNode m il bl -> Bool)
-> [BlockNode m il bl] -> [BlockNode m il bl]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\BlockNode m il bl
n -> Bool -> Bool
not
                    (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 (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
n)) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"FencedDiv" Bool -> Bool -> Bool
&&
                     BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
n) [SourcePos] -> [SourcePos] -> Bool
forall a. Eq a => a -> a -> Bool
==
                     BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
node)))
               [BlockNode m il bl]
ns
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ()
endOfBlock
             (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node))
               BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do let ((Int
_, Int
indentspaces, Attributes
_)
                              :: (Int, Int, Attributes)) = Dynamic -> (Int, Int, Attributes) -> (Int, Int, 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))
                                   (Int
3, Int
0, Attributes
forall a. Monoid a => a
mempty)
                       SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                       Int
_ <- Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
indentspaces
                       (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node))
     , 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)) =
                   Dynamic -> (Int, Int, Attributes) -> (Int, Int, 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)) (Int
3, Int
0, Attributes
forall a. Monoid a => a
mempty)
           (Attributes -> bl -> bl
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs (bl -> bl) -> ([bl] -> bl) -> [bl] -> bl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bl -> bl
forall bl. HasDiv bl => bl -> bl
div_ (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)
             ([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       = 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
     }

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)) = Dynamic -> (Int, Int, Attributes) -> (Int, Int, 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))
                        (Int
3, Int
0, Attributes
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 = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxBracketedSpecs = [ bsSpec ]
  }
  where
   bsSpec :: BracketedSpec il
bsSpec = BracketedSpec
            { bracketedName :: Text
bracketedName = Text
"Span"
            , bracketedNests :: Bool
bracketedNests = Bool
True
            , bracketedPrefix :: Maybe Char
bracketedPrefix = Maybe Char
forall a. Maybe a
Nothing
            , bracketedSuffixEnd :: Maybe Char
bracketedSuffixEnd = Maybe Char
forall a. Maybe a
Nothing
            , bracketedSuffix :: ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
bracketedSuffix = ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
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 <- ParsecT [Tok] u m Attributes
forall u (m :: * -> *). Monad m => ParsecT [Tok] u m Attributes
pAttributes
     (a -> a) -> ParsecT [Tok] u m (a -> a)
forall a. a -> ParsecT [Tok] u m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a -> a) -> ParsecT [Tok] u m (a -> a))
-> (a -> a) -> ParsecT [Tok] u m (a -> a)
forall a b. (a -> b) -> a -> b
$! Attributes -> a -> a
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 = Attributes -> Html a -> Html a
forall a. HasAttributes a => Attributes -> a -> a
addAttributes Attributes
attrs (Html a -> Html a) -> Html a -> Html a
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlInline Text
"span" (Html a -> Maybe (Html a)
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 = (Attributes -> i -> i
forall a. HasSpan a => Attributes -> a -> a
spanWith Attributes
attrs (i -> i) -> WithSourceMap i -> WithSourceMap i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithSourceMap i
x) WithSourceMap i -> WithSourceMap () -> WithSourceMap i
forall a b. WithSourceMap a -> WithSourceMap b -> WithSourceMap a
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 = ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] (IPState m) (StateT Enders m) a
 -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a b. (a -> b) -> a -> b
$ do
  Tok
tok <- Char -> ParsecT [Tok] (IPState m) (StateT Enders m) Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'`'
  Tok -> InlineParser m (Either [Tok] [Tok])
forall (m :: * -> *).
Monad m =>
Tok -> InlineParser m (Either [Tok] [Tok])
pBacktickSpan Tok
tok InlineParser m (Either [Tok] [Tok])
-> (Either [Tok] [Tok]
    -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a b.
ParsecT [Tok] (IPState m) (StateT Enders m) a
-> (a -> ParsecT [Tok] (IPState m) (StateT Enders m) b)
-> ParsecT [Tok] (IPState m) (StateT Enders m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
   \case
    Left [Tok]
ticks     -> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
-> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a b. (a -> b) -> a -> b
$! Text -> a
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 <- ParsecT [Tok] (IPState m) (StateT Enders m) Format
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Format
pRawAttribute
          a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
-> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a b. (a -> b) -> a -> b
$! Format -> Text -> a
forall a. IsInline a => Format -> Text -> a
rawInline Format
f Text
raw)
       ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
-> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a. a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT [Tok] (IPState m) (StateT Enders m) a)
-> a -> ParsecT [Tok] (IPState m) (StateT Enders m) a
forall a b. (a -> b) -> a -> b
$! Text -> a
forall a. IsInline a => Text -> a
code (Text -> a) -> (Text -> Text) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
normalizeCodeSpan (Text -> a) -> Text -> a
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 = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxBlockSpecs = [ rawAttributeBlockSpec ]
  , syntaxInlineParsers = [ 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          = BlockParser m il bl BlockStartResult
-> BlockParser m il bl BlockStartResult
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (BlockParser m il bl BlockStartResult
 -> BlockParser m il bl BlockStartResult)
-> BlockParser m il bl BlockStartResult
-> BlockParser m il bl BlockStartResult
forall a b. (a -> b) -> a -> b
$ do
             SourcePos
prepos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m ()
nonindentSpaces
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             let indentspaces :: Int
indentspaces = SourcePos -> Int
sourceColumn SourcePos
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- SourcePos -> Int
sourceColumn SourcePos
prepos
             (Char
c, [Tok]
ticks) <-  ((Char
'`',) ([Tok] -> (Char, [Tok]))
-> ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m (Char, [Tok])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'`'))
                        ParsecT [Tok] (BPState m il bl) m (Char, [Tok])
-> ParsecT [Tok] (BPState m il bl) m (Char, [Tok])
-> ParsecT [Tok] (BPState m il bl) m (Char, [Tok])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Char
'~',) ([Tok] -> (Char, [Tok]))
-> ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m (Char, [Tok])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'~'))
             let fencelength :: Int
fencelength = [Tok] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ticks
             Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ Int
fencelength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             Format
fmt <- ParsecT [Tok] (BPState m il bl) m Format
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Format
pRawAttribute
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (BPState m il bl) m ()
 -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
             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 (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
rawAttributeBlockSpec){
                          blockData = toDyn
                               (c, fencelength, indentspaces, fmt),
                          blockStartPos = [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       = \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
_, Format
_)
                    :: (Char, Int, Int, Format)) = Dynamic -> (Char, Int, Int, Format) -> (Char, Int, Int, Format)
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 -> Format
Format Text
forall a. Monoid a => a
mempty)
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m ()
nonindentSpaces
             SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             [Tok]
ts <- ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
c)
             Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ [Tok] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tok]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fencelength
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (BPState m il bl) m ()
 -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ()
endOfBlock
             (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node))
               BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do let ((Char
_, Int
_, Int
indentspaces, Format
_)
                              :: (Char, Int, Int, Format)) = Dynamic -> (Char, Int, Int, Format) -> (Char, Int, Int, Format)
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 -> Format
Format Text
forall a. Monoid a => a
mempty)
                       SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                       Int
_ <- Int -> ParsecT [Tok] (BPState m il bl) m Int
forall (m :: * -> *) u. Monad m => Int -> ParsecT [Tok] u m Int
gobbleUpToSpaces Int
indentspaces
                       (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a. a -> ParsecT [Tok] (BPState m il bl) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node))
     , 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)) =
                   Dynamic -> (Char, Int, Int, Format) -> (Char, Int, Int, Format)
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 -> Format
Format Text
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)
           -- drop 1 initial lineend token
           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 Format
fmt 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
     }

-- | Allow attributes on everything.
attributesSpec
             :: (Monad m, IsInline il)
             => SyntaxSpec m il bl
attributesSpec :: forall (m :: * -> *) il bl.
(Monad m, IsInline il) =>
SyntaxSpec m il bl
attributesSpec = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxAttributeParsers = [pAttributes]
  }

pAttributes :: forall u m . Monad m => ParsecT [Tok] u m Attributes
pAttributes :: forall u (m :: * -> *). Monad m => ParsecT [Tok] u m Attributes
pAttributes = [Attributes] -> Attributes
forall a. Monoid a => [a] -> a
mconcat ([Attributes] -> Attributes)
-> ParsecT [Tok] u m [Attributes] -> ParsecT [Tok] u m Attributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] u m Attributes -> ParsecT [Tok] u m [Attributes]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Tok] u m Attributes
forall {u}. ParsecT [Tok] u m Attributes
pattr
  where
    pattr :: ParsecT [Tok] u m Attributes
pattr = ParsecT [Tok] u m Attributes -> ParsecT [Tok] u m Attributes
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] u m Attributes -> ParsecT [Tok] u m Attributes)
-> ParsecT [Tok] u m Attributes -> ParsecT [Tok] u m Attributes
forall a b. (a -> b) -> a -> b
$ do
      Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'{'
      ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] u m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
      let pAttribute :: ParsecT [Tok] u m Attribute
pAttribute = ParsecT [Tok] u m Attribute
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pIdentifier ParsecT [Tok] u m Attribute
-> ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attribute
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] u m Attribute
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pClass ParsecT [Tok] u m Attribute
-> ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attribute
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] u m Attribute
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pKeyValue
      Attribute
a <- ParsecT [Tok] u m Attribute
forall {u}. ParsecT [Tok] u m Attribute
pAttribute
      Attributes
as <- ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attributes
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attributes)
-> ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attributes
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attribute
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] u m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace ParsecT [Tok] u m [Tok]
-> ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attribute
forall a b.
ParsecT [Tok] u m a -> ParsecT [Tok] u m b -> ParsecT [Tok] u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT [Tok] u m Attribute
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pIdentifier ParsecT [Tok] u m Attribute
-> ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attribute
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] u m Attribute
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pClass ParsecT [Tok] u m Attribute
-> ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attribute
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] u m Attribute
forall (m :: * -> *) u. Monad m => ParsecT [Tok] u m Attribute
pKeyValue))
      ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] u m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
      Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'}'
      Attributes -> ParsecT [Tok] u m Attributes
forall a. a -> ParsecT [Tok] u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attributes -> ParsecT [Tok] u m Attributes)
-> Attributes -> ParsecT [Tok] u m Attributes
forall a b. (a -> b) -> a -> b
$! (Attribute
aAttribute -> Attributes -> Attributes
forall 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 = ParsecT [Tok] u m Format -> ParsecT [Tok] u m Format
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] u m Format -> ParsecT [Tok] u m Format)
-> ParsecT [Tok] u m Format -> ParsecT [Tok] u m Format
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'{'
  ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] u m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'='
  Tok TokType
_ SourcePos
_ Text
t <- (Text -> Bool) -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True)
  ParsecT [Tok] u m [Tok] -> ParsecT [Tok] u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [Tok] u m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
  Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'}'
  Format -> ParsecT [Tok] u m Format
forall a. a -> ParsecT [Tok] u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> ParsecT [Tok] u m Format)
-> Format -> ParsecT [Tok] u m Format
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 = ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attribute
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attribute)
-> ParsecT [Tok] u m Attribute -> ParsecT [Tok] u m Attribute
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
'#'
  [Tok]
xs <- ParsecT [Tok] u m Tok -> ParsecT [Tok] u m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (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
$
        (Text -> Bool) -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True)
    ParsecT [Tok] u m Tok
-> 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 -> ParsecT s u m a
<|> (Tok -> Bool) -> ParsecT [Tok] u m Tok
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)
  Attribute -> ParsecT [Tok] u m Attribute
forall a. a -> ParsecT [Tok] u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attribute -> ParsecT [Tok] u m Attribute)
-> Attribute -> ParsecT [Tok] u m Attribute
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
  Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'.'
  [Tok]
xs <- ParsecT [Tok] u m Tok -> ParsecT [Tok] u m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (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
$
        (Text -> Bool) -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s.
Monad m =>
(Text -> Bool) -> ParsecT [Tok] s m Tok
satisfyWord (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True)
    ParsecT [Tok] u m Tok
-> 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 -> ParsecT s u m a
<|> (Tok -> Bool) -> ParsecT [Tok] u m Tok
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)
  Attribute -> ParsecT [Tok] u m Attribute
forall a. a -> ParsecT [Tok] u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attribute -> ParsecT [Tok] u m Attribute)
-> Attribute -> ParsecT [Tok] u m Attribute
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 <- ParsecT [Tok] u m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlAttributeName
  Char -> ParsecT [Tok] u m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'='
  [Tok]
val <- ParsecT [Tok] u m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
htmlDoubleQuotedAttributeValue
       ParsecT [Tok] u m [Tok]
-> 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 -> ParsecT s u m a
<|> ParsecT [Tok] u m Tok -> ParsecT [Tok] u m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ([TokType] -> ParsecT [Tok] u m Tok
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]
_  -> Int -> [Tok] -> [Tok]
forall a. Int -> [a] -> [a]
drop Int
1 ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall a b. (a -> b) -> a -> b
$ [Tok] -> [Tok]
forall a. HasCallStack => [a] -> [a]
init ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall a b. (a -> b) -> a -> b
$ [Tok]
val
               Tok (Symbol Char
'\'') SourcePos
_ Text
_:Tok
_:[Tok]
_ -> [Tok]
forall a. [a]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
               [Tok]
_ -> [Tok]
val
  Attribute -> ParsecT [Tok] u m Attribute
forall a. a -> ParsecT [Tok] u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attribute -> ParsecT [Tok] u m Attribute)
-> Attribute -> ParsecT [Tok] u m Attribute
forall a b. (a -> b) -> a -> b
$! ([Tok] -> Text
untokenize [Tok]
name, [Tok] -> Text
unEntity [Tok]
val')