{-# 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 (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 :: SyntaxSpec m il bl
fencedDivSpec = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxBlockSpecs :: [BlockSpec m il bl]
syntaxBlockSpecs = [BlockSpec m il bl
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 :: BlockSpec m il bl
fencedDivBlockSpec = BlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
    { blockType :: Text
blockType           = 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 :: Column
indentspaces = SourcePos -> Column
sourceColumn SourcePos
pos Column -> Column -> Column
forall a. Num a => a -> a -> a
- SourcePos -> Column
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 :: Column
fencelength = [Tok] -> Column
forall (t :: * -> *) a. Foldable t => t a -> Column
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
$ Column
fencelength Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
>= Column
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 (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
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDiv bl) =>
BlockSpec m il bl
fencedDivBlockSpec){
                          blockData :: Dynamic
blockData = (Column, Column, Attributes) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn
                               (Column
fencelength, Column
indentspaces, Attributes
attrs),
                          blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
forall a b. a -> b -> a
const Bool
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 :: Column
closelength = [Tok] -> Column
forall (t :: * -> *) a. Foldable t => t a -> Column
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 :: Column
fencelength = BlockNode m il bl -> Column
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDiv bl) =>
BlockNode m il bl -> Column
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
$ Column
closelength Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
>= Column
fencelength
             -- ensure that there aren't subordinate open fenced divs
             -- with fencelength <= closelength:
             Forest (BlockData m il bl)
ns <- BPState m il bl -> Forest (BlockData m il bl)
forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack (BPState m il bl -> Forest (BlockData m il bl))
-> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m (Forest (BlockData m il bl))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] (BPState m il bl) m (BPState m il bl)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
             Bool -> ParsecT [Tok] (BPState m il bl) m ()
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) -> Forest (BlockData 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 -> Column
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, HasDiv bl) =>
BlockNode m il bl -> Column
getFenceLength BlockNode m il bl
n) Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
<= Column
closelength) (Forest (BlockData m il bl) -> Bool)
-> Forest (BlockData m il bl) -> Bool
forall a b. (a -> b) -> a -> b
$
               (BlockNode m il bl -> Bool)
-> Forest (BlockData m il bl) -> Forest (BlockData 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)))
               Forest (BlockData 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 (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 ((Column
_, Column
indentspaces, Attributes
_)
                              :: (Int, Int, Attributes)) = Dynamic
-> (Column, Column, Attributes) -> (Column, Column, 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))
                                   (Column
3, Column
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
                       Column
_ <- Column -> ParsecT [Tok] (BPState m il bl) m Column
forall (m :: * -> *) u.
Monad m =>
Column -> ParsecT [Tok] u m Column
gobbleUpToSpaces Column
indentspaces
                       (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, 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 ((Column
_, Column
_, Attributes
attrs) :: (Int, Int, Attributes)) =
                   Dynamic
-> (Column, Column, Attributes) -> (Column, Column, 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)) (Column
3, Column
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 :: BlockNode m il bl -> Column
getFenceLength BlockNode m il bl
node =
  let ((Column
fencelength, Column
_, Attributes
_)
         :: (Int, Int, Attributes)) = Dynamic
-> (Column, Column, Attributes) -> (Column, Column, 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))
                        (Column
3, Column
0, Attributes
forall a. Monoid a => a
mempty)
  in Column
fencelength

bracketedSpanSpec
             :: (Monad m, IsInline il, HasSpan il)
             => SyntaxSpec m il bl
bracketedSpanSpec :: SyntaxSpec m il bl
bracketedSpanSpec = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxBracketedSpecs :: [BracketedSpec il]
syntaxBracketedSpecs = [ BracketedSpec il
bsSpec ]
  }
  where
   bsSpec :: BracketedSpec il
bsSpec = BracketedSpec :: forall il.
Text
-> Bool
-> Maybe Char
-> Maybe Char
-> (ReferenceMap -> Text -> Parsec [Tok] () (il -> il))
-> BracketedSpec il
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 (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 (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 :: InlineParser m a
pRawSpan = InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (InlineParser m a -> InlineParser m a)
-> InlineParser m a -> InlineParser 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] -> InlineParser m a) -> InlineParser m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
   \case
    Left [Tok]
ticks     -> a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser 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 -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser m a
forall a b. (a -> b) -> a -> b
$! Format -> Text -> a
forall a. IsInline a => Format -> Text -> a
rawInline Format
f Text
raw)
       InlineParser m a -> InlineParser m a -> InlineParser m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (a -> InlineParser m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> InlineParser m a) -> a -> InlineParser 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 :: SyntaxSpec m il bl
rawAttributeSpec = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxBlockSpecs :: [BlockSpec m il bl]
syntaxBlockSpecs = [ BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
rawAttributeBlockSpec ]
  , syntaxInlineParsers :: [InlineParser m il]
syntaxInlineParsers = [ InlineParser m il
forall a (m :: * -> *). (IsInline a, Monad m) => InlineParser m a
pRawSpan ]
  }

rawAttributeBlockSpec :: (Monad m, IsBlock il bl)
                              => BlockSpec m il bl
rawAttributeBlockSpec :: BlockSpec m il bl
rawAttributeBlockSpec = BlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = 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 :: Column
indentspaces = SourcePos -> Column
sourceColumn SourcePos
pos Column -> Column -> Column
forall a. Num a => a -> a -> a
- SourcePos -> Column
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 :: Column
fencelength = [Tok] -> Column
forall (t :: * -> *) a. Foldable t => t a -> Column
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
$ Column
fencelength Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
>= Column
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
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
rawAttributeBlockSpec){
                          blockData :: Dynamic
blockData = (Char, Column, Column, Format) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn
                               (Char
c, Column
fencelength, Column
indentspaces, Format
fmt),
                          blockStartPos :: [SourcePos]
blockStartPos = [SourcePos
pos] } []
             BlockStartResult -> BlockParser m il bl BlockStartResult
forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = Bool -> BlockSpec m il bl -> Bool
forall a b. a -> b -> a
const Bool
False
     , blockContainsLines :: Bool
blockContainsLines  = Bool
True
     , blockParagraph :: Bool
blockParagraph      = Bool
False
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \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, Column
fencelength, Column
_, Format
_)
                    :: (Char, Int, Int, Format)) = Dynamic
-> (Char, Column, Column, Format) -> (Char, Column, Column, 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
'`', Column
3, Column
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] -> Column
forall (t :: * -> *) a. Foldable t => t a -> Column
length [Tok]
ts Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
>= Column
fencelength
             (Tok -> Bool) -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [Tok] (BPState m il bl) m ()
 -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
             ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) il bl. Monad m => BlockParser m il bl ()
endOfBlock
             (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockNode m il bl
node))
               BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do let ((Char
_, Column
_, Column
indentspaces, Format
_)
                              :: (Char, Int, Int, Format)) = Dynamic
-> (Char, Column, Column, Format) -> (Char, Column, Column, 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
'`', Column
3, Column
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
                       Column
_ <- Column -> ParsecT [Tok] (BPState m il bl) m Column
forall (m :: * -> *) u.
Monad m =>
Column -> ParsecT [Tok] u m Column
gobbleUpToSpaces Column
indentspaces
                       (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, 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
_, Column
_, Column
_, Format
fmt) :: (Char, Int, Int, Format)) =
                   Dynamic
-> (Char, Column, Column, Format) -> (Char, Column, Column, 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
'`', Column
3, Column
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
$ Column -> [Tok] -> [Tok]
forall a. Column -> [a] -> [a]
drop Column
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 (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 :: SyntaxSpec m il bl
attributesSpec = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxAttributeParsers :: forall u (m1 :: * -> *).
Monad m1 =>
[ParsecT [Tok] u m1 Attributes]
syntaxAttributeParsers = [ParsecT [Tok] u m1 Attributes
forall u (m :: * -> *). Monad m => ParsecT [Tok] u m Attributes
pAttributes]
  }

pAttributes :: forall u m . Monad m => ParsecT [Tok] u m Attributes
pAttributes :: 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 (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 (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 :: 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 (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 :: 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 (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 :: 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 (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 :: 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]
_  -> Column -> [Tok] -> [Tok]
forall a. Column -> [a] -> [a]
drop Column
1 ([Tok] -> [Tok]) -> [Tok] -> [Tok]
forall a b. (a -> b) -> a -> b
$ [Tok] -> [Tok]
forall a. [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 (m :: * -> *) a. MonadPlus m => m a
mzero
               [Tok]
_ -> [Tok]
val
  Attribute -> ParsecT [Tok] u m Attribute
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')