{-# 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 (Hash, Hash) -> (Hash, Hash) -> Bool
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 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
kind' Bool -> Bool -> Bool
&& Identifier
ident Identifier -> Identifier -> Bool
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 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
name' Bool -> Bool -> Bool
&& Hash
value Hash -> Hash -> Bool
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 " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> Hash
show Hash
kind Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
ident
show (Style (Hash, Hash)
str) = Hash
"Style " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Hash, Hash) -> Hash
forall a. Show a => a -> Hash
show (Hash, Hash)
str
show (Generic Hash
attrKey Hash
attrValue) = Hash
"Generic " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> Hash
show Hash
attrKey Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
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 "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
parentLocation Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
location Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> state -> Hash
forall a. Show a => a -> Hash
show state
state Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview newEvent m -> Hash
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 "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
parentLocation Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
location Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> state -> Hash
forall a. Show a => a -> Hash
show state
state Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview newEvent m -> Hash
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 "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
parentLocation Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
location Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> Hash
show Hash
name Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview event m -> Hash
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 " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Attributes event -> Hash
forall a. Show a => a -> Hash
show Attributes event
attrs Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview event m -> Hash
forall a. Show a => a -> Hash
show Purview event m
cont
show (Text Hash
str) = ShowS
forall a. Show a => a -> Hash
show Hash
str
show (Html Hash
kind [Purview event m]
children) =
Hash
kind Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" [ " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Purview event m -> Hash) -> [Purview event m] -> Hash
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Hash -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) Hash
" " ShowS -> (Purview event m -> Hash) -> Purview event m -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Purview event m -> Hash
forall a. Show a => a -> Hash
show) [Purview event m]
children Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" ] "
show (Value a
value) = a -> Hash
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 = Purview event m -> Hash
forall a. Show a => a -> Hash
show Purview event m
a Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Purview event m -> Hash
forall a. Show a => a -> Hash
show Purview event m
b