{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
module Component where
import Data.Typeable
import Events
type Hash = String
data Attributes event where
On :: ( Show event
, Eq event
, Typeable event
)
=> String
-> Identifier
-> (Maybe String -> event)
-> Attributes event
Style :: (Hash, String) -> Attributes event
Generic :: String -> String -> Attributes event
instance Eq (Attributes event) where
(Style (Hash, Hash)
a) == :: Attributes event -> Attributes event -> Bool
== (Style (Hash, Hash)
b) = (Hash, Hash)
a forall a. Eq a => a -> a -> Bool
== (Hash, Hash)
b
(Style (Hash, Hash)
_) == Attributes event
_ = Bool
False
(On Hash
kind Identifier
ident Maybe Hash -> event
_event) == (On Hash
kind' Identifier
ident' Maybe Hash -> event
_event') =
Hash
kind forall a. Eq a => a -> a -> Bool
== Hash
kind' Bool -> Bool -> Bool
&& Identifier
ident forall a. Eq a => a -> a -> Bool
== Identifier
ident'
(On {}) == Attributes event
_ = Bool
False
(Generic Hash
name Hash
value) == (Generic Hash
name' Hash
value') = Hash
name forall a. Eq a => a -> a -> Bool
== Hash
name' Bool -> Bool -> Bool
&& Hash
value forall a. Eq a => a -> a -> Bool
== Hash
value'
(Generic Hash
_ Hash
_) == Attributes event
_ = Bool
False
instance Show (Attributes event) where
show :: Attributes event -> Hash
show (On Hash
kind Identifier
ident Maybe Hash -> event
evt) = Hash
"On " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Hash
kind forall a. Semigroup a => a -> a -> a
<> Hash
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Identifier
ident
show (Style (Hash, Hash)
str) = Hash
"Style " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show (Hash, Hash)
str
show (Generic Hash
attrKey Hash
attrValue) = Hash
"Generic " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Hash
attrKey forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Hash
attrValue
data Purview event m where
Attribute :: Attributes event -> Purview event m -> Purview event m
Text :: String -> Purview event m
Html :: String -> [Purview event m] -> Purview event m
Value :: Show a => a -> Purview event m
Receiver
:: ( Show event
, Eq event
, Typeable event
)
=> { forall event (m :: * -> *). Purview event m -> Identifier
parentIdentifier :: ParentIdentifier
, forall event (m :: * -> *). Purview event m -> Identifier
identifier :: Identifier
, forall event (m :: * -> *). Purview event m -> Hash
name :: String
, forall event (m :: * -> *). Purview event m -> Maybe Hash -> event
eventHandler :: Maybe String -> event
, ()
child :: state -> Purview event m
, ()
state :: state
}
-> Purview event m
EffectHandler
:: ( Show state
, Eq state
, Typeable state
, Typeable newEvent
)
=> { parentIdentifier :: ParentIdentifier
, identifier :: Identifier
, ()
initialEvents :: [DirectedEvent event newEvent]
, state :: state
, ()
effectReducer :: newEvent
-> state
-> m (state -> state, [DirectedEvent event newEvent])
, ()
continuation :: state -> Purview newEvent m
}
-> Purview event m
Handler
:: ( Show state
, Eq state
, Typeable state
, Typeable newEvent
)
=> { parentIdentifier :: ParentIdentifier
, identifier :: Identifier
, initialEvents :: [DirectedEvent event newEvent]
, state :: state
, ()
reducer :: newEvent
-> state
-> (state -> state, [DirectedEvent event newEvent])
, continuation :: state -> Purview newEvent m
}
-> Purview event m
instance Show (Purview event m) where
show :: Purview event m -> Hash
show (EffectHandler Identifier
parentLocation Identifier
location [DirectedEvent event newEvent]
initialEvents state
state newEvent
-> state -> m (state -> state, [DirectedEvent event newEvent])
_event state -> Purview newEvent m
cont) =
Hash
"EffectHandler "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Identifier
parentLocation forall a. Semigroup a => a -> a -> a
<> Hash
" "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Identifier
location forall a. Semigroup a => a -> a -> a
<> Hash
" "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show state
state forall a. Semigroup a => a -> a -> a
<> Hash
" "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show (state -> Purview newEvent m
cont state
state)
show (Handler Identifier
parentLocation Identifier
location [DirectedEvent event newEvent]
initialEvents state
state newEvent
-> state -> (state -> state, [DirectedEvent event newEvent])
_event state -> Purview newEvent m
cont) =
Hash
"Handler "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Identifier
parentLocation forall a. Semigroup a => a -> a -> a
<> Hash
" "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Identifier
location forall a. Semigroup a => a -> a -> a
<> Hash
" "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show state
state forall a. Semigroup a => a -> a -> a
<> Hash
" "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show (state -> Purview newEvent m
cont state
state)
show (Receiver Identifier
parentLocation Identifier
location Hash
name Maybe Hash -> event
handler state -> Purview event m
child state
state) =
Hash
"Receiver "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Identifier
parentLocation forall a. Semigroup a => a -> a -> a
<> Hash
" "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Identifier
location forall a. Semigroup a => a -> a -> a
<> Hash
" "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Hash
name forall a. Semigroup a => a -> a -> a
<> Hash
" "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show (state -> Purview event m
child state
state)
show (Attribute Attributes event
attrs Purview event m
cont) = Hash
"Attr " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Attributes event
attrs forall a. Semigroup a => a -> a -> a
<> Hash
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Hash
show Purview event m
cont
show (Text Hash
str) = forall a. Show a => a -> Hash
show Hash
str
show (Html Hash
kind [Purview event m]
children) =
Hash
kind forall a. Semigroup a => a -> a -> a
<> Hash
" [ " forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Semigroup a => a -> a -> a
(<>) Hash
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Hash
show) [Purview event m]
children forall a. Semigroup a => a -> a -> a
<> Hash
" ] "
show (Value a
value) = forall a. Show a => a -> Hash
show a
value
instance Eq (Purview event m) where
Purview event m
a == :: Purview event m -> Purview event m -> Bool
== Purview event m
b = forall a. Show a => a -> Hash
show Purview event m
a forall a. Eq a => a -> a -> Bool
== forall a. Show a => a -> Hash
show Purview event m
b