{-# 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
(AttributeValue -> AttributeValue -> Bool)
-> (AttributeValue -> AttributeValue -> Bool) -> Eq AttributeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttributeValue -> AttributeValue -> Bool
== :: AttributeValue -> AttributeValue -> Bool
$c/= :: AttributeValue -> AttributeValue -> Bool
/= :: AttributeValue -> AttributeValue -> Bool
Eq, Int -> AttributeValue -> ShowS
[AttributeValue] -> ShowS
AttributeValue -> String
(Int -> AttributeValue -> ShowS)
-> (AttributeValue -> String)
-> ([AttributeValue] -> ShowS)
-> Show AttributeValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttributeValue -> ShowS
showsPrec :: Int -> AttributeValue -> ShowS
$cshow :: AttributeValue -> String
show :: AttributeValue -> String
$cshowList :: [AttributeValue] -> ShowS
showList :: [AttributeValue] -> ShowS
Show)

data Attribute = StaticAttribute !Text !AttributeValue | SpreadAttributes !Haskell.Exp deriving (Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
/= :: Attribute -> Attribute -> Bool
Eq, Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Attribute -> ShowS
showsPrec :: Int -> Attribute -> ShowS
$cshow :: Attribute -> String
show :: Attribute -> String
$cshowList :: [Attribute] -> ShowS
showList :: [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 -- ^ A Comment that is rendered in the final HTML
    | NoRenderCommentNode -- ^ A comment that is not rendered in the final HTML
    deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
/= :: Node -> Node -> Bool
Eq, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Node -> ShowS
showsPrec :: Int -> Node -> ShowS
$cshow :: Node -> String
show :: Node -> String
$cshowList :: [Node] -> ShowS
showList :: [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 = ?extensions::[Extension]
[Extension]
extensions
    in
        Parsec Void Text Node
-> String -> Text -> Either (ParseErrorBundle Text Void) Node
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (SourcePos -> ParsecT Void Text Identity ()
forall {e} {s} {m :: * -> *}.
MonadParsec e s m =>
SourcePos -> m ()
setPosition SourcePos
position ParsecT Void Text Identity ()
-> Parsec Void Text Node -> Parsec Void Text Node
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Node
Parser Node
parser) String
"" Text
code

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

setPosition :: SourcePos -> m ()
setPosition SourcePos
pstateSourcePos = (State s e -> State s e) -> m ()
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 = (statePosState state) { pstateSourcePos }
    })

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

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

manyHsxElement :: Parser Node
manyHsxElement :: Parser Node
manyHsxElement = do
    [Node]
children <- Parsec Void Text Node -> ParsecT Void Text Identity [Node]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parsec Void Text Node
Parser Node
hsxChild
    Node -> Parsec Void Text Node
forall a. a -> ParsecT Void Text Identity a
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
    Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<'
    Text
name <- Parsec Void Text Text
Parser Text
hsxElementName
    let isLeaf :: Bool
isLeaf = Text
name Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
leafs
    [Attribute]
attributes <-
      if Bool
isLeaf
        then Parser (Tokens Text) -> Parser [Attribute]
forall a. Parser a -> Parser [Attribute]
hsxNodeAttributes (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
">" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"/>")
        else Parser (Tokens Text) -> Parser [Attribute]
forall a. Parser a -> Parser [Attribute]
hsxNodeAttributes (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"/>")
    ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    Node -> Parsec Void Text Node
forall a. a -> ParsecT Void Text Identity a
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) <- Parsec Void Text (Text, [Attribute])
Parser (Text, [Attribute])
hsxOpeningElement
    let parsePreEscapedTextChildren :: (Text -> Text) -> ParsecT Void Text Identity [Node]
parsePreEscapedTextChildren Text -> Text
transformText = do
                    let closingElement :: Text
closingElement = Text
"</" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
                    Text
text <- [Token Text] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Token Text] -> Text)
-> ParsecT Void Text Identity [Token Text] -> Parsec Void Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity [Token Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
closingElement)
                    [Node] -> ParsecT Void Text Identity [Node]
forall a. a -> ParsecT Void Text Identity a
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 ([Node] -> [Node])
-> ParsecT Void Text Identity [Node]
-> ParsecT Void Text Identity [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [Node]
-> ParsecT Void Text Identity [Node]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Parsec Void Text Node
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [Node]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (Parsec Void Text Node -> Parsec Void Text Node
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parsec Void Text Node
Parser Node
hsxChild) (ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ParsecT Void Text Identity ()
forall {s} {e} {m :: * -> *}.
(Token s ~ Char, Tokens s ~ Text, MonadParsec e s m) =>
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 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip)
            Text
otherwise -> ParsecT Void Text Identity [Node]
parseNormalHSXChildren
    Node -> Parsec Void Text Node
forall a. a -> ParsecT Void Text Identity a
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
    Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<'
    Text
name <- Parsec Void Text Text
Parser Text
hsxElementName
    ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    [Attribute]
attributes <- Parser Char -> Parser [Attribute]
forall a. Parser a -> Parser [Attribute]
hsxNodeAttributes (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>')
    (Text, [Attribute]) -> Parsec Void Text (Text, [Attribute])
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
name, [Attribute]
attributes)

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

hsxNoRenderComment :: Parser Node
hsxNoRenderComment :: Parser Node
hsxNoRenderComment = do
    Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"{-"
    ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity [Token Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Bool -> Token Text -> Bool
forall a b. a -> b -> a
const Bool
True)) (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"-}")
    ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    Node -> Parsec Void Text Node
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
NoRenderCommentNode


hsxNodeAttributes :: Parser a -> Parser [Attribute]
hsxNodeAttributes :: forall a. Parser a -> Parser [Attribute]
hsxNodeAttributes Parser a
end = Parsec Void Text [Attribute]
staticAttributes
    where
        staticAttributes :: Parsec Void Text [Attribute]
staticAttributes = do
            [Attribute]
attributes <- ParsecT Void Text Identity Attribute
-> ParsecT Void Text Identity a -> Parsec Void Text [Attribute]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (ParsecT Void Text Identity Attribute
Parser Attribute
hsxNodeAttribute ParsecT Void Text Identity Attribute
-> ParsecT Void Text Identity Attribute
-> ParsecT Void Text Identity Attribute
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Attribute
Parser Attribute
hsxSplicedAttributes) ParsecT Void Text Identity a
Parser a
end
            let staticAttributes :: [Attribute]
staticAttributes = (Attribute -> Bool) -> [Attribute] -> [Attribute]
forall a. (a -> Bool) -> [a] -> [a]
List.filter Attribute -> Bool
isStaticAttribute [Attribute]
attributes
            let keys :: [Text]
keys = (Attribute -> Text) -> [Attribute] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
List.map (\(StaticAttribute Text
name AttributeValue
_) -> Text
name) [Attribute]
staticAttributes
            let uniqueKeys :: [Text]
uniqueKeys = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
List.nubOrd [Text]
keys
            Bool
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text]
keys [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
uniqueKeys) (String -> ParsecT Void Text Identity ()
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Void Text Identity ())
-> String -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ String
"Duplicate attribute found in tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show ([Text]
keys [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
List.\\ [Text]
uniqueKeys))
            [Attribute] -> Parsec Void Text [Attribute]
forall a. a -> ParsecT Void Text Identity a
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) <- ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (SourcePos, Tokens Text)
-> ParsecT Void Text Identity (SourcePos, Tokens Text)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (do Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'{'; ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space; Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"...") (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"}") do
            SourcePos
pos <- ParsecT Void Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
            Tokens Text
code <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}')
            (SourcePos, Tokens Text)
-> ParsecT Void Text Identity (SourcePos, Tokens Text)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourcePos
pos, Tokens Text
code)
    ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    Exp
haskellExpression <- SourcePos -> Text -> Parser Exp
parseHaskellExpression SourcePos
pos (Tokens Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Tokens Text
name)
    Attribute -> ParsecT Void Text Identity Attribute
forall a. a -> ParsecT Void Text Identity a
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]
[Extension]
?extensions (Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
input) of
        Right Exp
expression -> Exp -> Parsec Void Text Exp
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
expression
        Left (Int
line, Int
col, String
error) -> do
            SourcePos
pos <- ParsecT Void Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
            SourcePos -> ParsecT Void Text Identity ()
forall {e} {s} {m :: * -> *}.
MonadParsec e s m =>
SourcePos -> m ()
setPosition SourcePos
pos { sourceLine = mkPos line, sourceColumn = mkPos col }
            String -> Parsec Void Text Exp
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ShowS
forall a. Show a => a -> String
show String
error)

hsxNodeAttribute :: Parser Attribute
hsxNodeAttribute :: Parser Attribute
hsxNodeAttribute = do
    Text
key <- Parsec Void Text Text
Parser Text
hsxAttributeName
    ParsecT Void Text Identity ()
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
            Attribute -> ParsecT Void Text Identity Attribute
forall a. a -> ParsecT Void Text Identity a
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
            Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
            ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
            AttributeValue
value <- Parsec Void Text AttributeValue
Parser AttributeValue
hsxQuotedValue Parsec Void Text AttributeValue
-> Parsec Void Text AttributeValue
-> Parsec Void Text AttributeValue
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text AttributeValue
Parser AttributeValue
hsxSplicedValue
            ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
            Attribute -> ParsecT Void Text Identity Attribute
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> AttributeValue -> Attribute
StaticAttribute Text
key AttributeValue
value)

    ParsecT Void Text Identity Attribute
attributeWithValue ParsecT Void Text Identity Attribute
-> ParsecT Void Text Identity Attribute
-> ParsecT Void Text Identity Attribute
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
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 <- Parsec Void Text Text
ParsecT Void Text Identity (Tokens Text)
rawAttribute
        Bool
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
isValidAttributeName Text
name) (String -> ParsecT Void Text Identity ()
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Void Text Identity ())
-> String -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid attribute name: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
name)
        Text -> Parsec Void Text Text
forall a. a -> ParsecT Void Text Identity a
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 Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
attributes

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


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

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

hsxChild :: Parser Node
hsxChild :: Parser Node
hsxChild = Parsec Void Text Node
Parser Node
hsxElement Parsec Void Text Node
-> Parsec Void Text Node -> Parsec Void Text Node
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Node
Parser Node
hsxSplicedNode Parsec Void Text Node
-> Parsec Void Text Node -> Parsec Void Text Node
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Node -> Parsec Void Text Node
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity ()
-> Parsec Void Text Node -> Parsec Void Text Node
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parsec Void Text Node
Parser Node
hsxElement) Parsec Void Text Node
-> Parsec Void Text Node -> Parsec Void Text Node
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Node
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 (Text -> Node) -> Parsec Void Text Text -> Parsec Void Text Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"text") (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'{' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
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
(Int -> TokenTree -> ShowS)
-> (TokenTree -> String)
-> ([TokenTree] -> ShowS)
-> Show TokenTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenTree -> ShowS
showsPrec :: Int -> TokenTree -> ShowS
$cshow :: TokenTree -> String
show :: TokenTree -> String
$cshowList :: [TokenTree] -> ShowS
showList :: [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 (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
expression)
        Node -> Parsec Void Text Node
forall a. a -> ParsecT Void Text Identity a
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)
            (SourcePos, Text) -> ParsecT Void Text Identity (SourcePos, Text)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourcePos
pos, HasCallStack => Text -> Text
Text -> Text
Text.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text
Text -> Text
Text.tail Text
value)

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


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

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


attributes :: Set Text
attributes :: Set Text
attributes = [Text] -> Set Text
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"
        , Text
"kind"
        , Text
"html"
        , Text
"sse-connect", Text
"sse-swap"
        ]

parents :: Set Text
parents :: Set Text
parents = [Text] -> Set Text
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 = [Text] -> Set Text
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"
        , Text
"!DOCTYPE"
        ]

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 [Node] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Node]
nodes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            then case [Node] -> Node
forall a. HasCallStack => [a] -> a
List.last [Node]
nodes of
                TextNode Text
text -> Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Text -> Node
TextNode (Text -> Text
Text.stripEnd Text
text)
                Node
otherwise -> Maybe Node
forall a. Maybe a
Nothing
            else Maybe Node
forall a. Maybe a
Nothing
    in case Maybe Node
strippedLastElement of
        Just Node
last -> (([Node], [Node]) -> [Node]
forall a b. (a, b) -> a
fst (([Node], [Node]) -> [Node]) -> ([Node], [Node]) -> [Node]
forall a b. (a -> b) -> a -> b
$ Int -> [Node] -> ([Node], [Node])
forall a. Int -> [a] -> ([a], [a])
List.splitAt (([Node] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Node]
nodes) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Node]
nodes) [Node] -> [Node] -> [Node]
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 [Node] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Node]
nodes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            then case [Node] -> Node
forall a. HasCallStack => [a] -> a
List.head [Node]
nodes of
                TextNode Text
text -> Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Text -> Node
TextNode (Text -> Text
Text.stripStart Text
text)
                Node
otherwise -> Maybe Node
forall a. Maybe a
Nothing
            else Maybe Node
forall a. Maybe a
Nothing
    in case Maybe Node
strippedFirstElement of
        Just Node
first -> Node
firstNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:([Node] -> [Node]
forall a. HasCallStack => [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 = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
filterDuplicateSpaces (Text -> String
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
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:(String -> Bool -> String
filterDuplicateSpaces' String
rest Bool
True)
        filterDuplicateSpaces' (Char
char:String
rest) Bool
isRemovingSpaces = Char
charChar -> ShowS
forall a. a -> [a] -> [a]
:(String -> Bool -> String
filterDuplicateSpaces' String
rest Bool
False)
        filterDuplicateSpaces' [] Bool
isRemovingSpaces = []