{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
module PrepareTree where
import Data.Typeable
import Component
prepareTree :: Typeable event => Purview event m -> Purview event m
prepareTree :: forall event (m :: * -> *).
Typeable event =>
Purview event m -> Purview event m
prepareTree = Location -> Location -> Purview event m -> Purview event m
forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' [] []
type Location = [Int]
addLocationToAttr :: Location -> Attributes e -> Attributes e
addLocationToAttr :: forall e. Location -> Attributes e -> Attributes e
addLocationToAttr Location
loc Attributes e
attr = case Attributes e
attr of
On String
str Identifier
_ Maybe String -> e
event' -> String -> Identifier -> (Maybe String -> e) -> Attributes e
forall event.
(Show event, Eq event, Typeable event) =>
String -> Identifier -> (Maybe String -> event) -> Attributes event
On String
str (Location -> Identifier
forall a. a -> Maybe a
Just Location
loc) Maybe String -> e
event'
Attributes e
_ -> Attributes e
attr
prepareTree'
:: Typeable event
=> Location
-> Location
-> Purview event m
-> Purview event m
prepareTree' :: forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' Location
parentLocation Location
location Purview event m
component = case Purview event m
component of
Attribute Attributes event
attr Purview event m
cont ->
let
child :: Purview event m
child = Location -> Location -> Purview event m -> Purview event m
forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' Location
parentLocation (Location
location Location -> Location -> Location
forall a. Semigroup a => a -> a -> a
<> [Int
0]) Purview event m
cont
newAttr :: Attributes event
newAttr = Location -> Attributes event -> Attributes event
forall e. Location -> Attributes e -> Attributes e
addLocationToAttr Location
location Attributes event
attr
in
Attributes event -> Purview event m -> Purview event m
forall event (m :: * -> *).
Attributes event -> Purview event m -> Purview event m
Attribute Attributes event
newAttr Purview event m
child
Html String
kind [Purview event m]
children ->
let
indexedChildren :: [(Int, Purview event m)]
indexedChildren = Location -> [Purview event m] -> [(Int, Purview event m)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Purview event m]
children
children' :: [Purview event m]
children' =
((Int, Purview event m) -> Purview event m)
-> [(Int, Purview event m)] -> [Purview event m]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
location', Purview event m
child) -> Location -> Location -> Purview event m -> Purview event m
forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' Location
parentLocation (Location
location Location -> Location -> Location
forall a. Semigroup a => a -> a -> a
<> [Int
location']) Purview event m
child) [(Int, Purview event m)]
indexedChildren
in
String -> [Purview event m] -> Purview event m
forall event (m :: * -> *).
String -> [Purview event m] -> Purview event m
Html String
kind [Purview event m]
children'
EffectHandler Identifier
_ploc Identifier
_loc [DirectedEvent event newEvent]
initEvents state
state newEvent
-> state -> m (state -> state, [DirectedEvent event newEvent])
handler state -> Purview newEvent m
cont ->
let
cont' :: state -> Purview newEvent m
cont' = (Purview newEvent m -> Purview newEvent m)
-> (state -> Purview newEvent m) -> state -> Purview newEvent m
forall a b. (a -> b) -> (state -> a) -> state -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Location -> Location -> Purview newEvent m -> Purview newEvent m
forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' Location
location (Location
location Location -> Location -> Location
forall a. Semigroup a => a -> a -> a
<> [Int
0])) state -> Purview newEvent m
cont
in
Identifier
-> Identifier
-> [DirectedEvent event newEvent]
-> state
-> (newEvent
-> state -> m (state -> state, [DirectedEvent event newEvent]))
-> (state -> Purview newEvent m)
-> Purview event m
forall state newEvent event (m :: * -> *).
(Show state, Eq state, Typeable state, Typeable newEvent) =>
Identifier
-> Identifier
-> [DirectedEvent event newEvent]
-> state
-> (newEvent
-> state -> m (state -> state, [DirectedEvent event newEvent]))
-> (state -> Purview newEvent m)
-> Purview event m
EffectHandler (Location -> Identifier
forall a. a -> Maybe a
Just Location
parentLocation) (Location -> Identifier
forall a. a -> Maybe a
Just Location
location) [DirectedEvent event newEvent]
initEvents state
state newEvent
-> state -> m (state -> state, [DirectedEvent event newEvent])
handler state -> Purview newEvent m
cont'
Handler Identifier
_ploc Identifier
_loc [DirectedEvent event newEvent]
initEvents state
state newEvent
-> state -> (state -> state, [DirectedEvent event newEvent])
handler state -> Purview newEvent m
cont ->
let
cont' :: state -> Purview newEvent m
cont' = (Purview newEvent m -> Purview newEvent m)
-> (state -> Purview newEvent m) -> state -> Purview newEvent m
forall a b. (a -> b) -> (state -> a) -> state -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Location -> Location -> Purview newEvent m -> Purview newEvent m
forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' Location
location (Location
location Location -> Location -> Location
forall a. Semigroup a => a -> a -> a
<> [Int
0])) state -> Purview newEvent m
cont
in
Identifier
-> Identifier
-> [DirectedEvent event newEvent]
-> state
-> (newEvent
-> state -> (state -> state, [DirectedEvent event newEvent]))
-> (state -> Purview newEvent m)
-> Purview event m
forall state newEvent event (m :: * -> *).
(Show state, Eq state, Typeable state, Typeable newEvent) =>
Identifier
-> Identifier
-> [DirectedEvent event newEvent]
-> state
-> (newEvent
-> state -> (state -> state, [DirectedEvent event newEvent]))
-> (state -> Purview newEvent m)
-> Purview event m
Handler (Location -> Identifier
forall a. a -> Maybe a
Just Location
parentLocation) (Location -> Identifier
forall a. a -> Maybe a
Just Location
location) [DirectedEvent event newEvent]
initEvents state
state newEvent
-> state -> (state -> state, [DirectedEvent event newEvent])
handler state -> Purview newEvent m
cont'
Receiver { String
name :: String
$sel:name:Attribute :: forall event (m :: * -> *). Purview event m -> String
name, Maybe String -> event
eventHandler :: Maybe String -> event
$sel:eventHandler:Attribute :: forall event (m :: * -> *).
Purview event m -> Maybe String -> event
eventHandler, state -> Purview event m
child :: state -> Purview event m
$sel:child:Attribute :: ()
child, state
state :: state
$sel:state:Attribute :: ()
state } ->
let
child' :: state -> Purview event m
child' = (Purview event m -> Purview event m)
-> (state -> Purview event m) -> state -> Purview event m
forall a b. (a -> b) -> (state -> a) -> state -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Location -> Location -> Purview event m -> Purview event m
forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' Location
location (Location
location Location -> Location -> Location
forall a. Semigroup a => a -> a -> a
<> [Int
0])) state -> Purview event m
child
in
Identifier
-> Identifier
-> String
-> (Maybe String -> event)
-> (state -> Purview event m)
-> state
-> Purview event m
forall event state (m :: * -> *).
(Show event, Eq event, Typeable event) =>
Identifier
-> Identifier
-> String
-> (Maybe String -> event)
-> (state -> Purview event m)
-> state
-> Purview event m
Receiver (Location -> Identifier
forall a. a -> Maybe a
Just Location
parentLocation) (Location -> Identifier
forall a. a -> Maybe a
Just Location
location) String
name Maybe String -> event
eventHandler state -> Purview event m
child' state
state
Text String
val -> String -> Purview event m
forall event (m :: * -> *). String -> Purview event m
Text String
val
Value a
val -> a -> Purview event m
forall a event (m :: * -> *). Show a => a -> Purview event m
Value a
val