{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
module Component where
import Data.Aeson
import Data.Typeable
import Events
data Attributes action where
On :: ToJSON action => String -> action -> Attributes action
Style :: String -> Attributes action
Generic :: String -> String -> Attributes action
instance Eq (Attributes action) where
(Style String
a) == :: Attributes action -> Attributes action -> Bool
== (Style String
b) = String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b
(Style String
_) == Attributes action
_ = Bool
False
(On String
kind action
action) == (On String
kind' action
action') = String
kind String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
kind' Bool -> Bool -> Bool
&& action -> ByteString
forall a. ToJSON a => a -> ByteString
encode action
action ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== action -> ByteString
forall a. ToJSON a => a -> ByteString
encode action
action'
(On String
_ action
_) == Attributes action
_ = Bool
False
(Generic String
name String
value) == (Generic String
name' String
value') = String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name' Bool -> Bool -> Bool
&& String
value String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
value'
(Generic String
_ String
_) == Attributes action
_ = Bool
False
type Identifier = Maybe [Int]
type ParentIdentifier = Identifier
data Purview parentAction action m where
Attribute :: Attributes action -> Purview parentAction action m -> Purview parentAction action m
Text :: String -> Purview parentAction action m
Html :: String -> [Purview parentAction action m] -> Purview parentAction action m
Value :: Show a => a -> Purview parentAction action m
EffectHandler
:: ( FromJSON newAction
, ToJSON newAction
, ToJSON parentAction
, FromJSON state
, ToJSON state
, Typeable state
, Eq state
)
=> ParentIdentifier
-> Identifier
-> state
-> (newAction-> state -> m (state -> state, [DirectedEvent parentAction newAction]))
-> (state -> Purview newAction any m)
-> Purview parentAction newAction m
Once
:: (ToJSON action)
=> ((action -> Event) -> Event)
-> Bool
-> Purview parentAction action m
-> Purview parentAction action m
Hide :: Purview parentAction newAction m -> Purview parentAction any m
instance Show (Purview parentAction action m) where
show :: Purview parentAction action m -> String
show (EffectHandler ParentIdentifier
parentLocation ParentIdentifier
location state
state action
-> state -> m (state -> state, [DirectedEvent parentAction action])
_action state -> Purview action any m
cont) =
String
"EffectHandler "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParentIdentifier -> String
forall a. Show a => a -> String
show ParentIdentifier
parentLocation String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParentIdentifier -> String
forall a. Show a => a -> String
show ParentIdentifier
location String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show (state -> ByteString
forall a. ToJSON a => a -> ByteString
encode state
state) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview action any m -> String
forall a. Show a => a -> String
show (state -> Purview action any m
cont state
state)
show (Once (action -> Event) -> Event
_ Bool
hasRun Purview parentAction action m
cont) = String
"Once " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bool -> String
forall a. Show a => a -> String
show Bool
hasRun String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview parentAction action m -> String
forall a. Show a => a -> String
show Purview parentAction action m
cont
show (Attribute Attributes action
_attrs Purview parentAction action m
cont) = String
"Attr " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview parentAction action m -> String
forall a. Show a => a -> String
show Purview parentAction action m
cont
show (Text String
str) = ShowS
forall a. Show a => a -> String
show String
str
show (Html String
kind [Purview parentAction action m]
children) =
String
kind String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" [ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Purview parentAction action m -> String)
-> [Purview parentAction action m] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) String
" " ShowS
-> (Purview parentAction action m -> String)
-> Purview parentAction action m
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Purview parentAction action m -> String
forall a. Show a => a -> String
show) [Purview parentAction action m]
children String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ] "
show (Value a
value) = a -> String
forall a. Show a => a -> String
show a
value
show (Hide Purview parentAction newAction m
a) = String
"Hide " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview parentAction newAction m -> String
forall a. Show a => a -> String
show Purview parentAction newAction m
a
instance Eq (Purview parentAction action m) where
Purview parentAction action m
a == :: Purview parentAction action m
-> Purview parentAction action m -> Bool
== Purview parentAction action m
b = Purview parentAction action m -> String
forall a. Show a => a -> String
show Purview parentAction action m
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Purview parentAction action m -> String
forall a. Show a => a -> String
show Purview parentAction action m
b
simpleHandler
:: ( FromJSON action
, FromJSON state
, ToJSON action
, ToJSON parentAction
, ToJSON state
, Typeable state
, Eq state
, Applicative m
)
=> state
-> (action -> state -> state)
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
simpleHandler :: forall action state parentAction (m :: * -> *) any1 any2.
(FromJSON action, FromJSON state, ToJSON action,
ToJSON parentAction, ToJSON state, Typeable state, Eq state,
Applicative m) =>
state
-> (action -> state -> state)
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
simpleHandler state
state action -> state -> state
handler =
state
-> (action
-> state
-> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
forall action state parentAction (m :: * -> *) any1 any2.
(FromJSON action, FromJSON state, ToJSON action,
ToJSON parentAction, ToJSON state, Typeable state, Eq state) =>
state
-> (action
-> state
-> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
effectHandler state
state (\action
action state
state -> (state -> state, [DirectedEvent parentAction action])
-> m (state -> state, [DirectedEvent parentAction action])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (state -> state -> state
forall a b. a -> b -> a
const (state -> state -> state) -> state -> state -> state
forall a b. (a -> b) -> a -> b
$ action -> state -> state
handler action
action state
state, []))
messageHandler
:: ( FromJSON action
, FromJSON state
, ToJSON action
, ToJSON parentAction
, ToJSON state
, Typeable state
, Eq state
, Applicative m
)
=> state
-> (action -> state -> (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
messageHandler :: forall action state parentAction (m :: * -> *) any1 any2.
(FromJSON action, FromJSON state, ToJSON action,
ToJSON parentAction, ToJSON state, Typeable state, Eq state,
Applicative m) =>
state
-> (action
-> state -> (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
messageHandler state
state action
-> state -> (state -> state, [DirectedEvent parentAction action])
handler =
state
-> (action
-> state
-> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
forall action state parentAction (m :: * -> *) any1 any2.
(FromJSON action, FromJSON state, ToJSON action,
ToJSON parentAction, ToJSON state, Typeable state, Eq state) =>
state
-> (action
-> state
-> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
effectHandler state
state (\action
action state
state -> (state -> state, [DirectedEvent parentAction action])
-> m (state -> state, [DirectedEvent parentAction action])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (action
-> state -> (state -> state, [DirectedEvent parentAction action])
handler action
action state
state))
effectHandler
:: ( FromJSON action
, FromJSON state
, ToJSON action
, ToJSON parentAction
, ToJSON state
, Typeable state
, Eq state
)
=> state
-> (action -> state -> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
effectHandler :: forall action state parentAction (m :: * -> *) any1 any2.
(FromJSON action, FromJSON state, ToJSON action,
ToJSON parentAction, ToJSON state, Typeable state, Eq state) =>
state
-> (action
-> state
-> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
effectHandler state
state action
-> state -> m (state -> state, [DirectedEvent parentAction action])
handler =
Purview parentAction action m -> Purview parentAction any2 m
forall parentAction state (m :: * -> *) any.
Purview parentAction state m -> Purview parentAction any m
Hide (Purview parentAction action m -> Purview parentAction any2 m)
-> ((state -> Purview action any1 m)
-> Purview parentAction action m)
-> (state -> Purview action any1 m)
-> Purview parentAction any2 m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParentIdentifier
-> ParentIdentifier
-> state
-> (action
-> state
-> m (state -> state, [DirectedEvent parentAction action]))
-> (state -> Purview action any1 m)
-> Purview parentAction action m
forall newAction parentAction state (m :: * -> *) any.
(FromJSON newAction, ToJSON newAction, ToJSON parentAction,
FromJSON state, ToJSON state, Typeable state, Eq state) =>
ParentIdentifier
-> ParentIdentifier
-> state
-> (newAction
-> state
-> m (state -> state, [DirectedEvent parentAction newAction]))
-> (state -> Purview newAction any m)
-> Purview parentAction newAction m
EffectHandler ParentIdentifier
forall a. Maybe a
Nothing ParentIdentifier
forall a. Maybe a
Nothing state
state action
-> state -> m (state -> state, [DirectedEvent parentAction action])
handler
once
:: ToJSON action
=> ((action -> Event) -> Event)
-> Purview parentAction action m
-> Purview parentAction action m
once :: forall action parentAction (m :: * -> *).
ToJSON action =>
((action -> Event) -> Event)
-> Purview parentAction action m -> Purview parentAction action m
once (action -> Event) -> Event
sendAction = ((action -> Event) -> Event)
-> Bool
-> Purview parentAction action m
-> Purview parentAction action m
forall action parentAction (m :: * -> *).
ToJSON action =>
((action -> Event) -> Event)
-> Bool
-> Purview parentAction action m
-> Purview parentAction action m
Once (action -> Event) -> Event
sendAction Bool
False
div :: [Purview parentAction action m] -> Purview parentAction action m
div :: forall parentAction action (m :: * -> *).
[Purview parentAction action m] -> Purview parentAction action m
div = String
-> [Purview parentAction action m] -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String
-> [Purview parentAction action m] -> Purview parentAction action m
Html String
"div"
span :: [Purview parentAction action m] -> Purview parentAction action m
span :: forall parentAction action (m :: * -> *).
[Purview parentAction action m] -> Purview parentAction action m
span = String
-> [Purview parentAction action m] -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String
-> [Purview parentAction action m] -> Purview parentAction action m
Html String
"span"
h1 :: [Purview parentAction action m] -> Purview parentAction action m
h1 :: forall parentAction action (m :: * -> *).
[Purview parentAction action m] -> Purview parentAction action m
h1 = String
-> [Purview parentAction action m] -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String
-> [Purview parentAction action m] -> Purview parentAction action m
Html String
"h1"
h2 :: [Purview parentAction action m] -> Purview parentAction action m
h2 :: forall parentAction action (m :: * -> *).
[Purview parentAction action m] -> Purview parentAction action m
h2 = String
-> [Purview parentAction action m] -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String
-> [Purview parentAction action m] -> Purview parentAction action m
Html String
"h2"
h3 :: [Purview parentAction action m] -> Purview parentAction action m
h3 :: forall parentAction action (m :: * -> *).
[Purview parentAction action m] -> Purview parentAction action m
h3 = String
-> [Purview parentAction action m] -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String
-> [Purview parentAction action m] -> Purview parentAction action m
Html String
"h3"
h4 :: [Purview parentAction action m] -> Purview parentAction action m
h4 :: forall parentAction action (m :: * -> *).
[Purview parentAction action m] -> Purview parentAction action m
h4 = String
-> [Purview parentAction action m] -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String
-> [Purview parentAction action m] -> Purview parentAction action m
Html String
"h4"
p :: [Purview parentAction action m] -> Purview parentAction action m
p :: forall parentAction action (m :: * -> *).
[Purview parentAction action m] -> Purview parentAction action m
p = String
-> [Purview parentAction action m] -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String
-> [Purview parentAction action m] -> Purview parentAction action m
Html String
"p"
button :: [Purview parentAction action m] -> Purview parentAction action m
button :: forall parentAction action (m :: * -> *).
[Purview parentAction action m] -> Purview parentAction action m
button = String
-> [Purview parentAction action m] -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String
-> [Purview parentAction action m] -> Purview parentAction action m
Html String
"button"
form :: [Purview parentAction action m] -> Purview parentAction action m
form :: forall parentAction action (m :: * -> *).
[Purview parentAction action m] -> Purview parentAction action m
form = String
-> [Purview parentAction action m] -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String
-> [Purview parentAction action m] -> Purview parentAction action m
Html String
"form"
input :: [Purview parentAction action m] -> Purview parentAction action m
input :: forall parentAction action (m :: * -> *).
[Purview parentAction action m] -> Purview parentAction action m
input = String
-> [Purview parentAction action m] -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String
-> [Purview parentAction action m] -> Purview parentAction action m
Html String
"input"
text :: String -> Purview parentAction action m
text :: forall parentAction action (m :: * -> *).
String -> Purview parentAction action m
text = String -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String -> Purview parentAction action m
Text
style :: String -> Purview parentAction action m -> Purview parentAction action m
style :: forall parentAction action (m :: * -> *).
String
-> Purview parentAction action m -> Purview parentAction action m
style = Attributes action
-> Purview parentAction action m -> Purview parentAction action m
forall action parentAction (m :: * -> *).
Attributes action
-> Purview parentAction action m -> Purview parentAction action m
Attribute (Attributes action
-> Purview parentAction action m -> Purview parentAction action m)
-> (String -> Attributes action)
-> String
-> Purview parentAction action m
-> Purview parentAction action m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes action
forall action. String -> Attributes action
Style
onClick :: ToJSON action => action -> Purview parentAction action m -> Purview parentAction action m
onClick :: forall action parentAction (m :: * -> *).
ToJSON action =>
action
-> Purview parentAction action m -> Purview parentAction action m
onClick = Attributes action
-> Purview parentAction action m -> Purview parentAction action m
forall action parentAction (m :: * -> *).
Attributes action
-> Purview parentAction action m -> Purview parentAction action m
Attribute (Attributes action
-> Purview parentAction action m -> Purview parentAction action m)
-> (action -> Attributes action)
-> action
-> Purview parentAction action m
-> Purview parentAction action m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> action -> Attributes action
forall action.
ToJSON action =>
String -> action -> Attributes action
On String
"click"
onSubmit :: ToJSON action => action -> Purview parentAction action m -> Purview parentAction action m
onSubmit :: forall action parentAction (m :: * -> *).
ToJSON action =>
action
-> Purview parentAction action m -> Purview parentAction action m
onSubmit = Attributes action
-> Purview parentAction action m -> Purview parentAction action m
forall action parentAction (m :: * -> *).
Attributes action
-> Purview parentAction action m -> Purview parentAction action m
Attribute (Attributes action
-> Purview parentAction action m -> Purview parentAction action m)
-> (action -> Attributes action)
-> action
-> Purview parentAction action m
-> Purview parentAction action m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> action -> Attributes action
forall action.
ToJSON action =>
String -> action -> Attributes action
On String
"submit"
identifier :: String -> Purview parentAction action m -> Purview parentAction action m
identifier :: forall parentAction action (m :: * -> *).
String
-> Purview parentAction action m -> Purview parentAction action m
identifier = Attributes action
-> Purview parentAction action m -> Purview parentAction action m
forall action parentAction (m :: * -> *).
Attributes action
-> Purview parentAction action m -> Purview parentAction action m
Attribute (Attributes action
-> Purview parentAction action m -> Purview parentAction action m)
-> (String -> Attributes action)
-> String
-> Purview parentAction action m
-> Purview parentAction action m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Attributes action
forall action. String -> String -> Attributes action
Generic String
"id"
classes :: [String] -> Purview parentAction action m -> Purview parentAction action m
classes :: forall parentAction action (m :: * -> *).
[String]
-> Purview parentAction action m -> Purview parentAction action m
classes [String]
xs = Attributes action
-> Purview parentAction action m -> Purview parentAction action m
forall action parentAction (m :: * -> *).
Attributes action
-> Purview parentAction action m -> Purview parentAction action m
Attribute (Attributes action
-> Purview parentAction action m -> Purview parentAction action m)
-> (String -> Attributes action)
-> String
-> Purview parentAction action m
-> Purview parentAction action m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Attributes action
forall action. String -> String -> Attributes action
Generic String
"class" (String
-> Purview parentAction action m -> Purview parentAction action m)
-> String
-> Purview parentAction action m
-> Purview parentAction action m
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
xs