{-# 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)
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 -> ([], [])