{-# LANGUAGE DuplicateRecordFields #-}
-- |

module CollectInitials where

import Data.Typeable

import Component
import Events

type Location = [Int]

getStyleFromAttr :: Attributes e -> Maybe (Hash, String)
getStyleFromAttr :: forall e. Attributes e -> Maybe (Hash, Hash)
getStyleFromAttr Attributes e
attr = case Attributes e
attr of
  Style (Hash
hash, Hash
css) ->
    if Hash
hash forall a. Eq a => a -> a -> Bool
/= Hash
"-1" Bool -> Bool -> Bool
&& Hash
css forall a. Eq a => a -> a -> Bool
/= Hash
""
    then forall a. a -> Maybe a
Just (Hash
hash, Hash
css)  -- set the css to empty since it's been caught
    else forall a. Maybe a
Nothing
  Attributes e
_ -> forall a. Maybe a
Nothing

directedEventToInternalEvent :: (Typeable a, Typeable b) => Location -> Location -> DirectedEvent a b -> Event
directedEventToInternalEvent :: forall a b.
(Typeable a, Typeable b) =>
Location -> Location -> DirectedEvent a b -> Event
directedEventToInternalEvent Location
parentLocation Location
location DirectedEvent a b
directedEvent = case DirectedEvent a b
directedEvent of
  Parent a
event -> InternalEvent { $sel:event:FromFrontendEvent :: a
event=a
event, $sel:childId:FromFrontendEvent :: Identifier
childId=forall a. Maybe a
Nothing, $sel:handlerId:FromFrontendEvent :: Identifier
handlerId=forall a. a -> Maybe a
Just Location
parentLocation }
  Self b
event   -> InternalEvent { $sel:event:FromFrontendEvent :: b
event=b
event, $sel:childId:FromFrontendEvent :: Identifier
childId=forall a. Maybe a
Nothing, $sel:handlerId:FromFrontendEvent :: Identifier
handlerId=forall a. a -> Maybe a
Just Location
location }
  Browser {}   -> forall a. HasCallStack => Hash -> a
error Hash
"tried to turn a browser event into an internal event"

collectInitials :: Typeable event => Purview event m -> ([Event], [(Hash, String)])
collectInitials :: forall event (m :: * -> *).
Typeable event =>
Purview event m -> ([Event], [(Hash, Hash)])
collectInitials Purview event m
component = case Purview event m
component of
  Attribute Attributes event
attr Purview event m
cont ->
    let
      ([Event]
events, [(Hash, Hash)]
css) = forall event (m :: * -> *).
Typeable event =>
Purview event m -> ([Event], [(Hash, Hash)])
collectInitials Purview event m
cont
      possibleCss :: Maybe (Hash, Hash)
possibleCss = forall e. Attributes e -> Maybe (Hash, Hash)
getStyleFromAttr Attributes event
attr
    in
      case Maybe (Hash, Hash)
possibleCss of
        Just (Hash, Hash)
newCss -> ([Event]
events, (Hash, Hash)
newCss forall a. a -> [a] -> [a]
: [(Hash, Hash)]
css)
        Maybe (Hash, Hash)
Nothing     -> ([Event]
events, [(Hash, Hash)]
css)

  Html Hash
kind [Purview event m]
children ->
    let
      eventsAndCss :: [([Event], [(Hash, Hash)])]
eventsAndCss = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall event (m :: * -> *).
Typeable event =>
Purview event m -> ([Event], [(Hash, Hash)])
collectInitials [Purview event m]
children
      events :: [Event]
events = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> a
fst [([Event], [(Hash, Hash)])]
eventsAndCss
      css :: [(Hash, Hash)]
css = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [([Event], [(Hash, Hash)])]
eventsAndCss
    in
      ([Event]
events, [(Hash, Hash)]
css)

  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
      ([Event]
events, [(Hash, Hash)]
css) = forall event (m :: * -> *).
Typeable event =>
Purview event m -> ([Event], [(Hash, Hash)])
collectInitials (state -> Purview newEvent m
cont state
state)
      internalizedEvents :: [Event]
internalizedEvents = case (Identifier
ploc, Identifier
loc) of
        (Just Location
ploc, Just Location
loc) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b.
(Typeable a, Typeable b) =>
Location -> Location -> DirectedEvent a b -> Event
directedEventToInternalEvent Location
ploc Location
loc) [DirectedEvent event newEvent]
initEvents
        (Identifier, Identifier)
_                     -> forall a. HasCallStack => Hash -> a
error Hash
"EffectHandler missing locations"
    in
      ([Event]
internalizedEvents forall a. Semigroup a => a -> a -> a
<> [Event]
events, [(Hash, Hash)]
css)

  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
      ([Event]
events, [(Hash, Hash)]
css) = forall event (m :: * -> *).
Typeable event =>
Purview event m -> ([Event], [(Hash, Hash)])
collectInitials (state -> Purview newEvent m
cont state
state)
      internalizedEvents :: [Event]
internalizedEvents = case (Identifier
ploc, Identifier
loc) of
        (Just Location
ploc, Just Location
loc) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b.
(Typeable a, Typeable b) =>
Location -> Location -> DirectedEvent a b -> Event
directedEventToInternalEvent Location
ploc Location
loc) [DirectedEvent event newEvent]
initEvents
        (Identifier, Identifier)
_                     -> forall a. HasCallStack => Hash -> a
error Hash
"Handler missing locations"
    in
      ([Event]
internalizedEvents forall a. Semigroup a => a -> a -> a
<> [Event]
events, [(Hash, Hash)]
css)

  Receiver {} -> ([], [])
  Text Hash
val    -> ([], [])
  Value a
val   -> ([], [])