{-# LANGUAGE NamedFieldPuns #-}
module Rendering where
import Data.Aeson
import Data.ByteString.Lazy.Char8 (unpack)
import Unsafe.Coerce
import Component
isOn :: Attributes a -> Bool
isOn :: forall a. Attributes a -> Bool
isOn (On String
_ Identifier
_ Maybe String -> a
_) = Bool
True
isOn Attributes a
_ = Bool
False
isGeneric :: Attributes a -> Bool
isGeneric :: forall a. Attributes a -> Bool
isGeneric (Generic String
_ String
_) = Bool
True
isGeneric Attributes a
_ = Bool
False
isClass :: Attributes a -> Bool
isClass :: forall a. Attributes a -> Bool
isClass (Generic String
"class" String
_) = Bool
True
isClass Attributes a
_ = Bool
False
getStyle :: Attributes a -> String
getStyle :: forall a. Attributes a -> String
getStyle (Style (String
hash, String
style')) =
if String
hash forall a. Eq a => a -> a -> Bool
== String
"-1" then String
style' else String
""
getStyle Attributes a
_ = String
""
getClassBasedStyle :: Attributes a -> String
getClassBasedStyle :: forall a. Attributes a -> String
getClassBasedStyle (Style (String
hash, String
style')) =
if String
style' forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
&& Bool -> Bool
not (Char
' ' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
hash) then String
hash else String
""
getClassBasedStyle Attributes a
_ = String
""
renderGeneric :: Attributes a -> String
renderGeneric :: forall a. Attributes a -> String
renderGeneric Attributes a
attr = case Attributes a
attr of
(Generic String
name String
value) -> String
" " forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> String
"=" forall a. Semigroup a => a -> a -> a
<> ByteString -> String
unpack (forall a. ToJSON a => a -> ByteString
encode String
value)
Attributes a
_ -> String
""
renderAttributes :: [Attributes a] -> String
renderAttributes :: forall a. [Attributes a] -> String
renderAttributes [Attributes a]
attrs =
let
styles :: String
styles = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Attributes a -> String
getStyle [Attributes a]
attrs
renderedStyle :: String
renderedStyle = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
styles) then String
" style=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
styles else String
""
classStyles :: [String]
classStyles = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Attributes a -> String
getClassBasedStyle [Attributes a]
attrs
existingClasses :: [String]
existingClasses = (\(Generic String
_ String
name) -> String
name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter forall a. Attributes a -> Bool
isClass [Attributes a]
attrs
combinedClasses :: [String]
combinedClasses = [String]
classStyles forall a. Semigroup a => a -> a -> a
<> [String]
existingClasses
renderedClasses :: String
renderedClasses =
if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
combinedClasses)
then String
" class=\"" forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords [String]
combinedClasses forall a. Semigroup a => a -> a -> a
<> String
"\""
else String
""
listeners :: [Attributes a]
listeners = forall a. (a -> Bool) -> [a] -> [a]
filter forall a. Attributes a -> Bool
isOn [Attributes a]
attrs
renderedListeners :: String
renderedListeners = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\(On String
name Identifier
ident Maybe String -> a
action) -> String
" " forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> String
"-location=" forall a. Semigroup a => a -> a -> a
<> ByteString -> String
unpack (forall a. ToJSON a => a -> ByteString
encode Identifier
ident))
[Attributes a]
listeners
noticeToBind :: String
noticeToBind = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attributes a]
listeners then String
"" else String
" bubbling-bound"
generics :: [Attributes a]
generics = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Attributes a -> Bool
isClass) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a. Attributes a -> Bool
isGeneric [Attributes a]
attrs
renderedGenerics :: String
renderedGenerics = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Attributes a -> String
renderGeneric [Attributes a]
generics
in
String
renderedStyle forall a. Semigroup a => a -> a -> a
<> String
noticeToBind forall a. Semigroup a => a -> a -> a
<> String
renderedListeners forall a. Semigroup a => a -> a -> a
<> String
renderedGenerics forall a. Semigroup a => a -> a -> a
<> String
renderedClasses
render :: Purview action m -> String
render :: forall action (m :: * -> *). Purview action m -> String
render = forall action (m :: * -> *).
[Attributes action] -> Purview action m -> String
render' []
render' :: [Attributes action] -> Purview action m -> String
render' :: forall action (m :: * -> *).
[Attributes action] -> Purview action m -> String
render' [Attributes action]
attrs Purview action m
tree = case Purview action m
tree of
Html String
kind [Purview action m]
rest ->
String
"<" forall a. Semigroup a => a -> a -> a
<> String
kind forall a. Semigroup a => a -> a -> a
<> forall a. [Attributes a] -> String
renderAttributes [Attributes action]
attrs forall a. Semigroup a => a -> a -> a
<> String
">"
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall action (m :: * -> *).
[Attributes action] -> Purview action m -> String
render' []) [Purview action m]
rest forall a. Semigroup a => a -> a -> a
<>
String
"</" forall a. Semigroup a => a -> a -> a
<> String
kind forall a. Semigroup a => a -> a -> a
<> String
">"
Text String
val -> String
val
Attribute Attributes action
attr Purview action m
rest ->
forall action (m :: * -> *).
[Attributes action] -> Purview action m -> String
render' (Attributes action
attrforall a. a -> [a] -> [a]
:[Attributes action]
attrs) Purview action m
rest
EffectHandler Identifier
parentLocation Identifier
location [DirectedEvent action newEvent]
initEvents state
state newEvent
-> state -> m (state -> state, [DirectedEvent action newEvent])
_ state -> Purview newEvent m
cont ->
String
"<div handler=" forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode) Identifier
location forall a. Semigroup a => a -> a -> a
<> String
">" forall a. Semigroup a => a -> a -> a
<>
forall action (m :: * -> *).
[Attributes action] -> Purview action m -> String
render' [Attributes action]
attrs (forall a b. a -> b
unsafeCoerce state -> Purview newEvent m
cont state
state) forall a. Semigroup a => a -> a -> a
<>
String
"</div>"
Handler { Identifier
$sel:identifier:Attribute :: forall event (m :: * -> *). Purview event m -> Identifier
identifier :: Identifier
identifier, state
$sel:state:Attribute :: ()
state :: state
state, state -> Purview newEvent m
$sel:continuation:Attribute :: ()
continuation :: state -> Purview newEvent m
continuation } ->
String
"<div handler=" forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode) Identifier
identifier forall a. Semigroup a => a -> a -> a
<> String
">" forall a. Semigroup a => a -> a -> a
<>
forall action (m :: * -> *).
[Attributes action] -> Purview action m -> String
render' [Attributes action]
attrs (forall a b. a -> b
unsafeCoerce state -> Purview newEvent m
continuation state
state) forall a. Semigroup a => a -> a -> a
<>
String
"</div>"
Receiver { Identifier
$sel:parentIdentifier:Attribute :: forall event (m :: * -> *). Purview event m -> Identifier
parentIdentifier :: Identifier
parentIdentifier, Identifier
identifier :: Identifier
$sel:identifier:Attribute :: forall event (m :: * -> *). Purview event m -> Identifier
identifier, String
$sel:name:Attribute :: forall action (m :: * -> *). Purview action m -> String
name :: String
name, state -> Purview action m
$sel:child:Attribute :: ()
child :: state -> Purview action m
child, state
state :: state
$sel:state:Attribute :: ()
state } ->
String
"<div" forall a. Semigroup a => a -> a -> a
<>
String
" handler=" forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode) Identifier
identifier forall a. Semigroup a => a -> a -> a
<>
String
" parent-handler=" forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode) Identifier
parentIdentifier forall a. Semigroup a => a -> a -> a
<>
String
" receiver-name=\"" forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> String
"\"" forall a. Semigroup a => a -> a -> a
<>
String
">" forall a. Semigroup a => a -> a -> a
<>
forall action (m :: * -> *).
[Attributes action] -> Purview action m -> String
render' [Attributes action]
attrs (state -> Purview action m
child state
state) forall a. Semigroup a => a -> a -> a
<>
String
"</div>"
Value a
a -> forall a. Show a => a -> String
show a
a