{-# LANGUAGE PackageImports  #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE NamedFieldPuns  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE TypeFamilies  #-}
{-|
Module: IHP.HSX.Parser
Description: Parser for HSX code
Copyright: (c) digitally induced GmbH, 2022
-}
module IHP.HSX.Parser
( parseHsx
, Node (..)
, Attribute (..)
, AttributeValue (..)
, collapseSpace
) where

import Prelude
import Data.Text
import Data.Set
import Text.Megaparsec
import Text.Megaparsec.Char
import Data.Void
import qualified Data.Char as Char
import qualified Data.Text as Text
import Data.String.Conversions
import qualified Data.List as List
import Control.Monad (unless)
import qualified "template-haskell" Language.Haskell.TH.Syntax as Haskell
import qualified "template-haskell" Language.Haskell.TH as TH
import qualified Data.Set as Set
import qualified Data.Containers.ListUtils as List
import qualified IHP.HSX.HaskellParser as HaskellParser

data AttributeValue = TextValue !Text | ExpressionValue !Haskell.Exp deriving (AttributeValue -> AttributeValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeValue -> AttributeValue -> Bool
$c/= :: AttributeValue -> AttributeValue -> Bool
== :: AttributeValue -> AttributeValue -> Bool
$c== :: AttributeValue -> AttributeValue -> Bool
Eq, Int -> AttributeValue -> ShowS
[AttributeValue] -> ShowS
AttributeValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeValue] -> ShowS
$cshowList :: [AttributeValue] -> ShowS
show :: AttributeValue -> String
$cshow :: AttributeValue -> String
showsPrec :: Int -> AttributeValue -> ShowS
$cshowsPrec :: Int -> AttributeValue -> ShowS
Show)

data Attribute = StaticAttribute !Text !AttributeValue | SpreadAttributes !Haskell.Exp deriving (Attribute -> Attribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq, Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show)

data Node = Node !Text ![Attribute] ![Node] !Bool
    | TextNode !Text
    | PreEscapedTextNode !Text -- ^ Used in @script@ or @style@ bodies
    | SplicedNode !Haskell.Exp -- ^ Inline haskell expressions like @{myVar}@ or @{f "hello"}@
    | Children ![Node]
    | CommentNode !Text
    deriving (Node -> Node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show)

-- | Parses a HSX text and returns a 'Node'
--
-- __Example:__
--
-- > let filePath = "my-template"
-- > let line = 0
-- > let col = 0
-- > let position = Megaparsec.SourcePos filePath (Megaparsec.mkPos line) (Megaparsec.mkPos col)
-- > let hsxText = "<strong>Hello</strong>"
-- >
-- > let (Right node) = parseHsx position [] hsxText
parseHsx :: SourcePos -> [TH.Extension] -> Text -> Either (ParseErrorBundle Text Void) Node
parseHsx :: SourcePos
-> [Extension] -> Text -> Either (ParseErrorBundle Text Void) Node
parseHsx SourcePos
position [Extension]
extensions Text
code =
    let
        ?extensions = [Extension]
extensions
    in
        forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (forall {e} {s} {m :: * -> *}.
MonadParsec e s m =>
SourcePos -> m ()
setPosition SourcePos
position forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Node
parser) String
"" Text
code

type Parser a = (?extensions :: [TH.Extension]) => Parsec Void Text a

setPosition :: SourcePos -> m ()
setPosition SourcePos
pstateSourcePos = forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
updateParserState (\State s e
state -> State s e
state {
        statePosState :: PosState s
statePosState = (forall s e. State s e -> PosState s
statePosState State s e
state) { SourcePos
pstateSourcePos :: SourcePos
pstateSourcePos :: SourcePos
pstateSourcePos }
    })

parser :: Parser Node
parser :: Parser Node
parser = do
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    Node
node <- Parser Node
manyHsxElement forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Node
hsxElement
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
node

hsxElement :: Parser Node
hsxElement :: Parser Node
hsxElement = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Node
hsxComment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Node
hsxSelfClosingElement forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Node
hsxNormalElement

manyHsxElement :: Parser Node
manyHsxElement :: Parser Node
manyHsxElement = do
    [Node]
children <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Node
hsxChild
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Node] -> Node
Children ([Node] -> [Node]
stripTextNodeWhitespaces [Node]
children))

hsxSelfClosingElement :: Parser Node
hsxSelfClosingElement :: Parser Node
hsxSelfClosingElement = do
    Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'<'
    Text
name <- Parser Text
hsxElementName
    let isLeaf :: Bool
isLeaf = Text
name forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
leafs
    [Attribute]
attributes <-
      if Bool
isLeaf
        then forall a. Parser a -> Parser [Attribute]
hsxNodeAttributes (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
">" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"/>")
        else forall a. Parser a -> Parser [Attribute]
hsxNodeAttributes (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"/>")
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Attribute] -> [Node] -> Bool -> Node
Node Text
name [Attribute]
attributes [] Bool
isLeaf)

hsxNormalElement :: Parser Node
hsxNormalElement :: Parser Node
hsxNormalElement = do
    (Text
name, [Attribute]
attributes) <- Parser (Text, [Attribute])
hsxOpeningElement
    let parsePreEscapedTextChildren :: (Text -> Text) -> ParsecT Void Text Identity [Node]
parsePreEscapedTextChildren Text -> Text
transformText = do
                    let closingElement :: Text
closingElement = Text
"</" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
">"
                    Text
text <- forall a b. ConvertibleStrings a b => a -> b
cs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
closingElement)
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Node
PreEscapedTextNode (Text -> Text
transformText Text
text)]
    let parseNormalHSXChildren :: ParsecT Void Text Identity [Node]
parseNormalHSXChildren = [Node] -> [Node]
stripTextNodeWhitespaces forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Node
hsxChild) (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {s} {e} {m :: * -> *}.
(Token s ~ Char, Tokens s ~ Text, MonadParsec e s m,
 Semigroup (Tokens s), IsString (Tokens s)) =>
Text -> m ()
hsxClosingElement Text
name))))

    -- script and style tags have special handling for their children. Inside those tags
    -- we allow any kind of content. Using a haskell expression like @<script>{myHaskellExpr}</script>@
    -- will just literally output the string @{myHaskellExpr}@ without evaluating the haskell expression itself.
    --
    -- Here is an example HSX code explaining the problem:
    -- [hsx|<style>h1 { color: red; }</style>|]
    -- The @{ color: red; }@ would be parsed as a inline haskell expression without the special handling
    --
    -- Additionally we don't do the usual escaping for style and script bodies, as this will make e.g. the
    -- javascript unusuable.
    [Node]
children <- case Text
name of
            Text
"script" -> (Text -> Text) -> ParsecT Void Text Identity [Node]
parsePreEscapedTextChildren Text -> Text
Text.strip
            Text
"style" -> (Text -> Text) -> ParsecT Void Text Identity [Node]
parsePreEscapedTextChildren (Text -> Text
collapseSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip)
            Text
otherwise -> ParsecT Void Text Identity [Node]
parseNormalHSXChildren
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Attribute] -> [Node] -> Bool -> Node
Node Text
name [Attribute]
attributes [Node]
children Bool
False)

hsxOpeningElement :: Parser (Text, [Attribute])
hsxOpeningElement :: Parser (Text, [Attribute])
hsxOpeningElement = do
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'<'
    Text
name <- Parser Text
hsxElementName
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    [Attribute]
attributes <- forall a. Parser a -> Parser [Attribute]
hsxNodeAttributes (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'>')
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
name, [Attribute]
attributes)

hsxComment :: Parser Node
hsxComment :: Parser Node
hsxComment = do
    forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"<!--"
    String
body :: String <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (forall a b. a -> b -> a
const Bool
True)) (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"-->")
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Node
CommentNode (forall a b. ConvertibleStrings a b => a -> b
cs String
body))


hsxNodeAttributes :: Parser a -> Parser [Attribute]
hsxNodeAttributes :: forall a. Parser a -> Parser [Attribute]
hsxNodeAttributes Parser a
end = ParsecT Void Text Identity [Attribute]
staticAttributes
    where
        staticAttributes :: ParsecT Void Text Identity [Attribute]
staticAttributes = do
            [Attribute]
attributes <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (Parser Attribute
hsxNodeAttribute forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Attribute
hsxSplicedAttributes) Parser a
end
            let staticAttributes :: [Attribute]
staticAttributes = forall a. (a -> Bool) -> [a] -> [a]
List.filter Attribute -> Bool
isStaticAttribute [Attribute]
attributes
            let keys :: [Text]
keys = forall a b. (a -> b) -> [a] -> [b]
List.map (\(StaticAttribute Text
name AttributeValue
_) -> Text
name) [Attribute]
staticAttributes
            let uniqueKeys :: [Text]
uniqueKeys = forall a. Ord a => [a] -> [a]
List.nubOrd [Text]
keys
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text]
keys forall a. Eq a => a -> a -> Bool
== [Text]
uniqueKeys) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Duplicate attribute found in tag: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ([Text]
keys forall a. Eq a => [a] -> [a] -> [a]
List.\\ [Text]
uniqueKeys))
            forall (f :: * -> *) a. Applicative f => a -> f a
pure [Attribute]
attributes

isStaticAttribute :: Attribute -> Bool
isStaticAttribute (StaticAttribute Text
_ AttributeValue
_) = Bool
True
isStaticAttribute Attribute
_ = Bool
False

hsxSplicedAttributes :: Parser Attribute
hsxSplicedAttributes :: Parser Attribute
hsxSplicedAttributes = do
    (SourcePos
pos, Tokens Text
name) <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"{...") (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"}") do
            SourcePos
pos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
            Tokens Text
code <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'}')
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourcePos
pos, Tokens Text
code)
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    Exp
haskellExpression <- SourcePos -> Text -> Parser Exp
parseHaskellExpression SourcePos
pos (forall a b. ConvertibleStrings a b => a -> b
cs Tokens Text
name)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Attribute
SpreadAttributes Exp
haskellExpression)

parseHaskellExpression :: SourcePos -> Text -> Parser Haskell.Exp
parseHaskellExpression :: SourcePos -> Text -> Parser Exp
parseHaskellExpression SourcePos
sourcePos Text
input = do
    case SourcePos -> [Extension] -> String -> Either (Int, Int, String) Exp
HaskellParser.parseHaskellExpression SourcePos
sourcePos ?extensions::[Extension]
?extensions (forall a b. ConvertibleStrings a b => a -> b
cs Text
input) of
        Right Exp
expression -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
expression
        Left (Int
line, Int
col, String
error) -> do
            SourcePos
pos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
            forall {e} {s} {m :: * -> *}.
MonadParsec e s m =>
SourcePos -> m ()
setPosition SourcePos
pos { sourceLine :: Pos
sourceLine = Int -> Pos
mkPos Int
line, sourceColumn :: Pos
sourceColumn = Int -> Pos
mkPos Int
col }
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show String
error)

hsxNodeAttribute :: Parser Attribute
hsxNodeAttribute :: Parser Attribute
hsxNodeAttribute = do
    Text
key <- Parser Text
hsxAttributeName
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

    -- Boolean attributes like <input disabled/> will be represented as <input disabled="disabled"/>
    -- as there is currently no other way to represent them with blaze-html.
    --
    -- There's a special case for data attributes: Data attributes like <form data-disable-javascript-submission/> will be represented as <form data-disable-javascript-submission="true"/>
    --
    -- See: https://html.spec.whatwg.org/multipage/common-microsyntaxes.html#boolean-attributes
    let attributeWithoutValue :: ParsecT Void Text Identity Attribute
attributeWithoutValue = do
            let value :: Text
value = if Text
"data-" Text -> Text -> Bool
`Text.isPrefixOf` Text
key
                    then Text
"true"
                    else Text
key
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> AttributeValue -> Attribute
StaticAttribute Text
key (Text -> AttributeValue
TextValue Text
value))

    -- Parsing normal attributes like <input value="Hello"/>
    let attributeWithValue :: ParsecT Void Text Identity Attribute
attributeWithValue = do
            Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
            forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
            AttributeValue
value <- Parser AttributeValue
hsxQuotedValue forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser AttributeValue
hsxSplicedValue
            forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> AttributeValue -> Attribute
StaticAttribute Text
key AttributeValue
value)

    ParsecT Void Text Identity Attribute
attributeWithValue forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Attribute
attributeWithoutValue


hsxAttributeName :: Parser Text
hsxAttributeName :: Parser Text
hsxAttributeName = do
        Text
name <- ParsecT Void Text Identity (Tokens Text)
rawAttribute
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
isValidAttributeName Text
name) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid attribute name: " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs Text
name)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name
    where
        isValidAttributeName :: Text -> Bool
isValidAttributeName Text
name =
            Text
"data-" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
            Bool -> Bool -> Bool
|| Text
"aria-" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
            Bool -> Bool -> Bool
|| Text
"hx-" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
            Bool -> Bool -> Bool
|| Text
"hx-" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
            Bool -> Bool -> Bool
|| Text
name forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
attributes

        rawAttribute :: ParsecT Void Text Identity (Tokens Text)
rawAttribute = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (\Token Text
c -> Char -> Bool
Char.isAlphaNum Token Text
c Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'_')


hsxQuotedValue :: Parser AttributeValue
hsxQuotedValue :: Parser AttributeValue
hsxQuotedValue = do
    Text
value <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\"'))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> AttributeValue
TextValue Text
value)

hsxSplicedValue :: Parser AttributeValue
hsxSplicedValue :: Parser AttributeValue
hsxSplicedValue = do
    (SourcePos
pos, Tokens Text
value) <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'{') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'}') do
        SourcePos
pos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
        Tokens Text
code <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'}')
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourcePos
pos, Tokens Text
code)
    Exp
haskellExpression <- SourcePos -> Text -> Parser Exp
parseHaskellExpression SourcePos
pos (forall a b. ConvertibleStrings a b => a -> b
cs Tokens Text
value)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> AttributeValue
ExpressionValue Exp
haskellExpression)

hsxClosingElement :: Text -> m ()
hsxClosingElement Text
name = (forall {s} {m :: * -> *} {e}.
(Token s ~ Char, MonadParsec e s m, Semigroup (Tokens s),
 IsString (Tokens s)) =>
Tokens s -> m ()
hsxClosingElement' Text
name) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
friendlyErrorMessage
    where
        friendlyErrorMessage :: String
friendlyErrorMessage = forall a. Show a => a -> String
show (Text -> String
Text.unpack (Text
"</" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
">"))
        hsxClosingElement' :: Tokens s -> m ()
hsxClosingElement' Tokens s
name = do
            Tokens s
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens s
"</" forall a. Semigroup a => a -> a -> a
<> Tokens s
name)
            forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
            forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char (Char
'>')
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

hsxChild :: Parser Node
hsxChild :: Parser Node
hsxChild = Parser Node
hsxElement forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Node
hsxSplicedNode forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Node
hsxElement) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Node
hsxText

-- | Parses a hsx text node
--
-- Stops parsing when hitting a variable, like `{myVar}`
hsxText :: Parser Node
hsxText :: Parser Node
hsxText = Text -> Node
buildTextNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"text") (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'{' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'}' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'<' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'>')

-- | Builds a TextNode and strips all surround whitespace from the input string
buildTextNode :: Text -> Node
buildTextNode :: Text -> Node
buildTextNode Text
value = Text -> Node
TextNode (Text -> Text
collapseSpace Text
value)

data TokenTree = TokenLeaf Text | TokenNode [TokenTree] deriving (Int -> TokenTree -> ShowS
[TokenTree] -> ShowS
TokenTree -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenTree] -> ShowS
$cshowList :: [TokenTree] -> ShowS
show :: TokenTree -> String
$cshow :: TokenTree -> String
showsPrec :: Int -> TokenTree -> ShowS
$cshowsPrec :: Int -> TokenTree -> ShowS
Show)

hsxSplicedNode :: Parser Node
hsxSplicedNode :: Parser Node
hsxSplicedNode = do
        (SourcePos
pos, Text
expression) <- ParsecT Void Text Identity (SourcePos, Text)
doParse
        Exp
haskellExpression <- SourcePos -> Text -> Parser Exp
parseHaskellExpression SourcePos
pos (forall a b. ConvertibleStrings a b => a -> b
cs Text
expression)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Node
SplicedNode Exp
haskellExpression)
    where
        doParse :: ParsecT Void Text Identity (SourcePos, Text)
doParse = do
            (SourcePos
pos, TokenTree
tree) <- ParsecT Void Text Identity (SourcePos, TokenTree)
node
            let value :: Text
value = (Text -> TokenTree -> Text
treeToString Text
"" TokenTree
tree)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourcePos
pos, Text -> Text
Text.init forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.tail Text
value)

        parseTree :: ParsecT Void Text Identity TokenTree
parseTree = (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (SourcePos, TokenTree)
node) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TokenTree
leaf
        node :: ParsecT Void Text Identity (SourcePos, TokenTree)
node = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'{') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'}') do
                SourcePos
pos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
                [TokenTree]
tree <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity TokenTree
parseTree
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourcePos
pos, [TokenTree] -> TokenTree
TokenNode [TokenTree]
tree)
        leaf :: ParsecT Void Text Identity TokenTree
leaf = Text -> TokenTree
TokenLeaf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'{' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'}')
        treeToString :: Text -> TokenTree -> Text
        treeToString :: Text -> TokenTree -> Text
treeToString Text
acc (TokenLeaf Text
value)  = Text
acc forall a. Semigroup a => a -> a -> a
<> Text
value
        treeToString Text
acc (TokenNode [])     = Text
acc
        treeToString Text
acc (TokenNode (TokenTree
x:[TokenTree]
xs)) = ((Text -> TokenTree -> Text
treeToString (Text
acc forall a. Semigroup a => a -> a -> a
<> Text
"{") TokenTree
x) forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
Text.concat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> TokenTree -> Text
treeToString Text
"") [TokenTree]
xs)) forall a. Semigroup a => a -> a -> a
<> Text
"}"


hsxElementName :: Parser Text
hsxElementName :: Parser Text
hsxElementName = do
    Text
name <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"identifier") (\Token Text
c -> Char -> Bool
Char.isAlphaNum Token Text
c Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'-')
    let isValidParent :: Bool
isValidParent = Text
name forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
parents
    let isValidLeaf :: Bool
isValidLeaf = Text
name forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
leafs
    let isValidCustomWebComponent :: Bool
isValidCustomWebComponent = Text
"-" Text -> Text -> Bool
`Text.isInfixOf` Text
name
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
isValidParent Bool -> Bool -> Bool
|| Bool
isValidLeaf Bool -> Bool -> Bool
|| Bool
isValidCustomWebComponent) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid tag name: " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs Text
name)
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name

hsxIdentifier :: Parser Text
hsxIdentifier :: Parser Text
hsxIdentifier = do
    Text
name <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"identifier") (\Token Text
c -> Char -> Bool
Char.isAlphaNum Token Text
c Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'_')
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name


attributes :: Set Text
attributes :: Set Text
attributes = forall a. Ord a => [a] -> Set a
Set.fromList
        [ Text
"accept", Text
"accept-charset", Text
"accesskey", Text
"action", Text
"alt", Text
"async"
        , Text
"autocomplete", Text
"autofocus", Text
"autoplay", Text
"challenge", Text
"charset"
        , Text
"checked", Text
"cite", Text
"class", Text
"cols", Text
"colspan", Text
"content"
        , Text
"contenteditable", Text
"contextmenu", Text
"controls", Text
"coords", Text
"data"
        , Text
"datetime", Text
"defer", Text
"dir", Text
"disabled", Text
"draggable", Text
"enctype"
        , Text
"form", Text
"formaction", Text
"formenctype", Text
"formmethod", Text
"formnovalidate"
        , Text
"for"
        , Text
"formtarget", Text
"headers", Text
"height", Text
"hidden", Text
"high", Text
"href"
        , Text
"hreflang", Text
"http-equiv", Text
"icon", Text
"id", Text
"ismap", Text
"item", Text
"itemprop"
        , Text
"itemscope", Text
"itemtype"
        , Text
"keytype", Text
"label", Text
"lang", Text
"list", Text
"loop", Text
"low", Text
"manifest", Text
"max"
        , Text
"maxlength", Text
"media", Text
"method", Text
"min", Text
"multiple", Text
"name"
        , Text
"novalidate", Text
"onbeforeonload", Text
"onbeforeprint", Text
"onblur", Text
"oncanplay"
        , Text
"oncanplaythrough", Text
"onchange", Text
"oncontextmenu", Text
"onclick"
        , Text
"ondblclick", Text
"ondrag", Text
"ondragend", Text
"ondragenter", Text
"ondragleave"
        , Text
"ondragover", Text
"ondragstart", Text
"ondrop", Text
"ondurationchange", Text
"onemptied"
        , Text
"onended", Text
"onerror", Text
"onfocus", Text
"onformchange", Text
"onforminput"
        , Text
"onhaschange", Text
"oninput", Text
"oninvalid", Text
"onkeydown", Text
"onkeyup"
        , Text
"onload", Text
"onloadeddata", Text
"onloadedmetadata", Text
"onloadstart"
        , Text
"onmessage", Text
"onmousedown", Text
"onmousemove", Text
"onmouseout", Text
"onmouseover"
        , Text
"onmouseup", Text
"onmousewheel", Text
"ononline", Text
"onpagehide", Text
"onpageshow"
        , Text
"onpause", Text
"onplay", Text
"onplaying", Text
"onprogress", Text
"onpropstate"
        , Text
"onratechange", Text
"onreadystatechange", Text
"onredo", Text
"onresize", Text
"onscroll"
        , Text
"onseeked", Text
"onseeking", Text
"onselect", Text
"onstalled", Text
"onstorage"
        , Text
"onsubmit", Text
"onsuspend", Text
"ontimeupdate", Text
"onundo", Text
"onunload"
        , Text
"onvolumechange", Text
"onwaiting", Text
"open", Text
"optimum", Text
"pattern", Text
"ping"
        , Text
"placeholder", Text
"preload", Text
"pubdate", Text
"radiogroup", Text
"readonly", Text
"rel"
        , Text
"required", Text
"reversed", Text
"rows", Text
"rowspan", Text
"sandbox", Text
"scope"
        , Text
"scoped", Text
"seamless", Text
"selected", Text
"shape", Text
"size", Text
"sizes", Text
"span"
        , Text
"spellcheck", Text
"src", Text
"srcdoc", Text
"srcset", Text
"start", Text
"step", Text
"style", Text
"subject"
        , Text
"summary", Text
"tabindex", Text
"target", Text
"title", Text
"type", Text
"usemap", Text
"value"
        , Text
"width", Text
"wrap", Text
"xmlns"
        , Text
"ontouchstart", Text
"download"
        , Text
"allowtransparency", Text
"minlength", Text
"maxlength", Text
"property"
        , Text
"role"
        , Text
"d", Text
"viewBox", Text
"cx", Text
"cy", Text
"r", Text
"x", Text
"y", Text
"text-anchor", Text
"alignment-baseline"
        , Text
"line-spacing", Text
"letter-spacing"
        , Text
"integrity", Text
"crossorigin", Text
"poster"
        , Text
"accent-height", Text
"accumulate", Text
"additive", Text
"alphabetic", Text
"amplitude"
        , Text
"arabic-form", Text
"ascent", Text
"attributeName", Text
"attributeType", Text
"azimuth"
        , Text
"baseFrequency", Text
"baseProfile", Text
"bbox", Text
"begin", Text
"bias", Text
"by", Text
"calcMode"
        , Text
"cap-height", Text
"class", Text
"clipPathUnits", Text
"contentScriptType"
        , Text
"contentStyleType", Text
"cx", Text
"cy", Text
"d", Text
"descent", Text
"diffuseConstant", Text
"divisor"
        , Text
"dur", Text
"dx", Text
"dy", Text
"edgeMode", Text
"elevation", Text
"end", Text
"exponent"
        , Text
"externalResourcesRequired", Text
"filterRes", Text
"filterUnits", Text
"font-family"
        , Text
"font-size", Text
"font-stretch", Text
"font-style", Text
"font-variant", Text
"font-weight"
        , Text
"format", Text
"from", Text
"fx", Text
"fy", Text
"g1", Text
"g2", Text
"glyph-name", Text
"glyphRef"
        , Text
"gradientTransform", Text
"gradientUnits", Text
"hanging", Text
"height", Text
"horiz-adv-x"
        , Text
"horiz-origin-x", Text
"horiz-origin-y", Text
"id", Text
"ideographic", Text
"in", Text
"in2"
        , Text
"intercept", Text
"k", Text
"k1", Text
"k2", Text
"k3", Text
"k4", Text
"kernelMatrix", Text
"kernelUnitLength"
        , Text
"keyPoints", Text
"keySplines", Text
"keyTimes", Text
"lang", Text
"lengthAdjust"
        , Text
"limitingConeAngle", Text
"local", Text
"markerHeight", Text
"markerUnits", Text
"markerWidth"
        , Text
"maskContentUnits", Text
"maskUnits", Text
"mathematical", Text
"max", Text
"media", Text
"method"
        , Text
"min", Text
"mode", Text
"name", Text
"numOctaves", Text
"offset", Text
"onabort", Text
"onactivate"
        , Text
"onbegin", Text
"onclick", Text
"onend", Text
"onerror", Text
"onfocusin", Text
"onfocusout", Text
"onload"
        , Text
"onmousedown", Text
"onmousemove", Text
"onmouseout", Text
"onmouseover", Text
"onmouseup"
        , Text
"onrepeat", Text
"onresize", Text
"onscroll", Text
"onunload", Text
"onzoom", Text
"operator", Text
"order"
        , Text
"orient", Text
"orientation", Text
"origin", Text
"overline-position", Text
"overline-thickness"
        , Text
"panose-1", Text
"path", Text
"pathLength", Text
"patternContentUnits", Text
"patternTransform"
        , Text
"patternUnits", Text
"points", Text
"pointsAtX", Text
"pointsAtY", Text
"pointsAtZ"
        , Text
"preserveAlpha", Text
"preserveAspectRatio", Text
"primitiveUnits", Text
"r", Text
"radius"
        , Text
"refX", Text
"refY", Text
"rendering-intent", Text
"repeatCount", Text
"repeatDur"
        , Text
"requiredExtensions", Text
"requiredFeatures", Text
"restart", Text
"result", Text
"rotate", Text
"rx"
        , Text
"ry", Text
"scale", Text
"seed", Text
"slope", Text
"spacing", Text
"specularConstant"
        , Text
"specularExponent", Text
"spreadMethod", Text
"startOffset", Text
"stdDeviation", Text
"stemh"
        , Text
"stemv", Text
"stitchTiles", Text
"strikethrough-position", Text
"strikethrough-thickness"
        , Text
"string", Text
"style", Text
"surfaceScale", Text
"systemLanguage", Text
"tableValues", Text
"target"
        , Text
"targetX", Text
"targetY", Text
"textLength", Text
"title", Text
"to", Text
"transform", Text
"type", Text
"u1"
        , Text
"u2", Text
"underline-position", Text
"underline-thickness", Text
"unicode", Text
"unicode-range"
        , Text
"units-per-em", Text
"v-alphabetic", Text
"v-hanging", Text
"v-ideographic", Text
"v-mathematical"
        , Text
"values", Text
"version", Text
"vert-adv-y", Text
"vert-origin-x", Text
"vert-origin-y", Text
"viewBox"
        , Text
"viewTarget", Text
"width", Text
"widths", Text
"x", Text
"x-height", Text
"x1", Text
"x2"
        , Text
"xChannelSelector", Text
"xlink:actuate", Text
"xlink:arcrole", Text
"xlink:href"
        , Text
"xlink:role", Text
"xlink:show", Text
"xlink:title", Text
"xlink:type", Text
"xml:base"
        , Text
"xml:lang", Text
"xml:space", Text
"y", Text
"y1", Text
"y2", Text
"yChannelSelector", Text
"z", Text
"zoomAndPan"
        , Text
"alignment-baseline", Text
"baseline-shift", Text
"clip-path", Text
"clip-rule"
        , Text
"clip", Text
"color-interpolation-filters", Text
"color-interpolation"
        , Text
"color-profile", Text
"color-rendering", Text
"color", Text
"cursor", Text
"direction"
        , Text
"display", Text
"dominant-baseline", Text
"enable-background", Text
"fill-opacity"
        , Text
"fill-rule", Text
"fill", Text
"filter", Text
"flood-color", Text
"flood-opacity"
        , Text
"font-size-adjust", Text
"glyph-orientation-horizontal"
        , Text
"glyph-orientation-vertical", Text
"image-rendering", Text
"kerning", Text
"letter-spacing"
        , Text
"lighting-color", Text
"marker-end", Text
"marker-mid", Text
"marker-start", Text
"mask"
        , Text
"opacity", Text
"overflow", Text
"pointer-events", Text
"shape-rendering", Text
"stop-color"
        , Text
"stop-opacity", Text
"stroke-dasharray", Text
"stroke-dashoffset", Text
"stroke-linecap"
        , Text
"stroke-linejoin", Text
"stroke-miterlimit", Text
"stroke-opacity", Text
"stroke-width"
        , Text
"stroke", Text
"text-anchor", Text
"text-decoration", Text
"text-rendering", Text
"unicode-bidi"
        , Text
"visibility", Text
"word-spacing", Text
"writing-mode", Text
"is"
        , Text
"cellspacing", Text
"cellpadding", Text
"bgcolor", Text
"classes"
        , Text
"loading"
        , Text
"frameborder", Text
"allow", Text
"allowfullscreen", Text
"nonce", Text
"referrerpolicy", Text
"slot"
        ]

parents :: Set Text
parents :: Set Text
parents = forall a. Ord a => [a] -> Set a
Set.fromList
          [ Text
"a"
          , Text
"abbr"
          , Text
"address"
          , Text
"animate"
          , Text
"animateMotion"
          , Text
"animateTransform"
          , Text
"article"
          , Text
"aside"
          , Text
"audio"
          , Text
"b"
          , Text
"bdi"
          , Text
"bdo"
          , Text
"blink"
          , Text
"blockquote"
          , Text
"body"
          , Text
"button"
          , Text
"canvas"
          , Text
"caption"
          , Text
"circle"
          , Text
"cite"
          , Text
"clipPath"
          , Text
"code"
          , Text
"colgroup"
          , Text
"command"
          , Text
"data"
          , Text
"datalist"
          , Text
"dd"
          , Text
"defs"
          , Text
"del"
          , Text
"desc"
          , Text
"details"
          , Text
"dfn"
          , Text
"dialog"
          , Text
"discard"
          , Text
"div"
          , Text
"dl"
          , Text
"dt"
          , Text
"ellipse"
          , Text
"em"
          , Text
"feBlend"
          , Text
"feColorMatrix"
          , Text
"feComponentTransfer"
          , Text
"feComposite"
          , Text
"feConvolveMatrix"
          , Text
"feDiffuseLighting"
          , Text
"feDisplacementMap"
          , Text
"feDistantLight"
          , Text
"feDropShadow"
          , Text
"feFlood"
          , Text
"feFuncA"
          , Text
"feFuncB"
          , Text
"feFuncG"
          , Text
"feFuncR"
          , Text
"feGaussianBlur"
          , Text
"feImage"
          , Text
"feMerge"
          , Text
"feMergeNode"
          , Text
"feMorphology"
          , Text
"feOffset"
          , Text
"fePointLight"
          , Text
"feSpecularLighting"
          , Text
"feSpotLight"
          , Text
"feTile"
          , Text
"feTurbulence"
          , Text
"fieldset"
          , Text
"figcaption"
          , Text
"figure"
          , Text
"filter"
          , Text
"footer"
          , Text
"foreignObject"
          , Text
"form"
          , Text
"g"
          , Text
"h1"
          , Text
"h2"
          , Text
"h3"
          , Text
"h4"
          , Text
"h5"
          , Text
"h6"
          , Text
"hatch"
          , Text
"hatchpath"
          , Text
"head"
          , Text
"header"
          , Text
"hgroup"
          , Text
"html"
          , Text
"i"
          , Text
"iframe"
          , Text
"ins"
          , Text
"ion-icon"
          , Text
"kbd"
          , Text
"label"
          , Text
"legend"
          , Text
"li"
          , Text
"line"
          , Text
"linearGradient"
          , Text
"loading"
          , Text
"main"
          , Text
"map"
          , Text
"mark"
          , Text
"marker"
          , Text
"marquee"
          , Text
"mask"
          , Text
"menu"
          , Text
"mesh"
          , Text
"meshgradient"
          , Text
"meshpatch"
          , Text
"meshrow"
          , Text
"metadata"
          , Text
"meter"
          , Text
"mpath"
          , Text
"nav"
          , Text
"noscript"
          , Text
"object"
          , Text
"ol"
          , Text
"optgroup"
          , Text
"option"
          , Text
"output"
          , Text
"p"
          , Text
"path"
          , Text
"pattern"
          , Text
"picture"
          , Text
"polygon"
          , Text
"polyline"
          , Text
"pre"
          , Text
"progress"
          , Text
"q"
          , Text
"radialGradient"
          , Text
"rect"
          , Text
"rp"
          , Text
"rt"
          , Text
"ruby"
          , Text
"s"
          , Text
"samp"
          , Text
"script"
          , Text
"section"
          , Text
"select"
          , Text
"set"
          , Text
"slot"
          , Text
"small"
          , Text
"source"
          , Text
"span"
          , Text
"stop"
          , Text
"strong"
          , Text
"style"
          , Text
"sub"
          , Text
"summary"
          , Text
"sup"
          , Text
"svg"
          , Text
"switch"
          , Text
"symbol"
          , Text
"table"
          , Text
"tbody"
          , Text
"td"
          , Text
"template"
          , Text
"text"
          , Text
"textPath"
          , Text
"textarea"
          , Text
"tfoot"
          , Text
"th"
          , Text
"thead"
          , Text
"time"
          , Text
"title"
          , Text
"tr"
          , Text
"track"
          , Text
"tspan"
          , Text
"u"
          , Text
"ul"
          , Text
"unknown"
          , Text
"use"
          , Text
"var"
          , Text
"video"
          , Text
"view"
          , Text
"wbr"
          ]

leafs :: Set Text
leafs :: Set Text
leafs = forall a. Ord a => [a] -> Set a
Set.fromList
        [ Text
"area"
        , Text
"base"
        , Text
"br"
        , Text
"col"
        , Text
"embed"
        , Text
"hr"
        , Text
"img"
        , Text
"input"
        , Text
"link"
        , Text
"meta"
        , Text
"param"
        ]

stripTextNodeWhitespaces :: [Node] -> [Node]
stripTextNodeWhitespaces [Node]
nodes = [Node] -> [Node]
stripLastTextNodeWhitespaces ([Node] -> [Node]
stripFirstTextNodeWhitespaces [Node]
nodes)

stripLastTextNodeWhitespaces :: [Node] -> [Node]
stripLastTextNodeWhitespaces [Node]
nodes =
    let strippedLastElement :: Maybe Node
strippedLastElement = if forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Node]
nodes forall a. Ord a => a -> a -> Bool
> Int
0
            then case forall a. [a] -> a
List.last [Node]
nodes of
                TextNode Text
text -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Node
TextNode (Text -> Text
Text.stripEnd Text
text)
                Node
otherwise -> forall a. Maybe a
Nothing
            else forall a. Maybe a
Nothing
    in case Maybe Node
strippedLastElement of
        Just Node
last -> (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> ([a], [a])
List.splitAt ((forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Node]
nodes) forall a. Num a => a -> a -> a
- Int
1) [Node]
nodes) forall a. Semigroup a => a -> a -> a
<> [Node
last]
        Maybe Node
Nothing -> [Node]
nodes

stripFirstTextNodeWhitespaces :: [Node] -> [Node]
stripFirstTextNodeWhitespaces [Node]
nodes =
    let strippedFirstElement :: Maybe Node
strippedFirstElement = if forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Node]
nodes forall a. Ord a => a -> a -> Bool
> Int
0
            then case forall a. [a] -> a
List.head [Node]
nodes of
                TextNode Text
text -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Node
TextNode (Text -> Text
Text.stripStart Text
text)
                Node
otherwise -> forall a. Maybe a
Nothing
            else forall a. Maybe a
Nothing
    in case Maybe Node
strippedFirstElement of
        Just Node
first -> Node
firstforall a. a -> [a] -> [a]
:(forall a. [a] -> [a]
List.tail [Node]
nodes)
        Maybe Node
Nothing -> [Node]
nodes

-- | Replaces multiple space characters with a single one
collapseSpace :: Text -> Text
collapseSpace :: Text -> Text
collapseSpace Text
text = forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ ShowS
filterDuplicateSpaces (forall a b. ConvertibleStrings a b => a -> b
cs Text
text)
    where
        filterDuplicateSpaces :: String -> String
        filterDuplicateSpaces :: ShowS
filterDuplicateSpaces String
string = String -> Bool -> String
filterDuplicateSpaces' String
string Bool
False

        filterDuplicateSpaces' :: String -> Bool -> String
        filterDuplicateSpaces' :: String -> Bool -> String
filterDuplicateSpaces' (Char
char:String
rest) Bool
True | Char -> Bool
Char.isSpace Char
char = String -> Bool -> String
filterDuplicateSpaces' String
rest Bool
True
        filterDuplicateSpaces' (Char
char:String
rest) Bool
False | Char -> Bool
Char.isSpace Char
char = Char
' 'forall a. a -> [a] -> [a]
:(String -> Bool -> String
filterDuplicateSpaces' String
rest Bool
True)
        filterDuplicateSpaces' (Char
char:String
rest) Bool
isRemovingSpaces = Char
charforall a. a -> [a] -> [a]
:(String -> Bool -> String
filterDuplicateSpaces' String
rest Bool
False)
        filterDuplicateSpaces' [] Bool
isRemovingSpaces = []