{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
module PrepareTree where

import Data.Typeable

import Component




{-|

This walks through the tree and collects actions that should be run
only once, and sets their run value to True.  It's up to something
else to actually send the actions.

It also assigns a location to message and effect handlers.

-}
prepareTree :: Typeable event => Purview event m -> Purview event m
prepareTree :: forall event (m :: * -> *).
Typeable event =>
Purview event m -> Purview event m
prepareTree = 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' -> forall event.
(Show event, Eq event, Typeable event) =>
String -> Identifier -> (Maybe String -> event) -> Attributes event
On String
str (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 = forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' Location
parentLocation (Location
location forall a. Semigroup a => a -> a -> a
<> [Int
0]) Purview event m
cont
      newAttr :: Attributes event
newAttr = forall e. Location -> Attributes e -> Attributes e
addLocationToAttr Location
location Attributes event
attr
    in
      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 = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Purview event m]
children
      children' :: [Purview event m]
children' =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
location', Purview event m
child) -> forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' Location
parentLocation (Location
location forall a. Semigroup a => a -> a -> a
<> [Int
location']) Purview event m
child) [(Int, Purview event m)]
indexedChildren
    in
      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' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' Location
location (Location
location forall a. Semigroup a => a -> a -> a
<> [Int
0])) state -> Purview newEvent m
cont
    in
      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 (forall a. a -> Maybe a
Just Location
parentLocation) (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' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' Location
location (Location
location forall a. Semigroup a => a -> a -> a
<> [Int
0])) state -> Purview newEvent m
cont
    in
      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 (forall a. a -> Maybe a
Just Location
parentLocation) (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
$sel:name:Attribute :: forall event (m :: * -> *). Purview event m -> String
name :: String
name, Maybe String -> event
$sel:eventHandler:Attribute :: forall event (m :: * -> *).
Purview event m -> Maybe String -> event
eventHandler :: Maybe String -> event
eventHandler, state -> Purview event m
$sel:child:Attribute :: ()
child :: state -> Purview event m
child, state
$sel:state:Attribute :: ()
state :: state
state } ->
    let
      child' :: state -> Purview event m
child' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall event (m :: * -> *).
Typeable event =>
Location -> Location -> Purview event m -> Purview event m
prepareTree' Location
location (Location
location forall a. Semigroup a => a -> a -> a
<> [Int
0])) state -> Purview event m
child
    in
      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 (forall a. a -> Maybe a
Just Location
parentLocation) (forall a. a -> Maybe a
Just Location
location) String
name Maybe String -> event
eventHandler state -> Purview event m
child' state
state

  Text String
val -> forall event (m :: * -> *). String -> Purview event m
Text String
val

  Value a
val -> forall a event (m :: * -> *). Show a => a -> Purview event m
Value a
val