{-# LANGUAGE BangPatterns #-}
-- |

module CleanTree where

import Data.Typeable
import Data.List

import Component



removeClassCSS :: [(Hash, String)] -> Attributes e -> Attributes e
removeClassCSS :: forall e. [(Hash, Hash)] -> Attributes e -> Attributes e
removeClassCSS [(Hash, Hash)]
foundCSS Attributes e
attr = case Attributes e
attr of
  Style (Hash
hash, Hash
css) ->
    if Hash
hash Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
/= Hash
"-1"
    then case ((Hash, Hash) -> Bool) -> [(Hash, Hash)] -> Maybe (Hash, Hash)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Hash, Hash) -> (Hash, Hash) -> Bool
forall a. Eq a => a -> a -> Bool
== (Hash
hash, Hash
css)) [(Hash, Hash)]
foundCSS of
      Just (Hash, Hash)
_  -> (Hash, Hash) -> Attributes e
forall event. (Hash, Hash) -> Attributes event
Style (Hash
hash, Hash
"")
      Maybe (Hash, Hash)
Nothing -> (Hash, Hash) -> Attributes e
forall event. (Hash, Hash) -> Attributes event
Style (Hash
hash, Hash
css)
    else Attributes e
attr
  Attributes e
_ -> Attributes e
attr

cleanTree :: Typeable event => [(Hash, String)] -> Purview event m -> Purview event m
cleanTree :: forall event (m :: * -> *).
Typeable event =>
[(Hash, Hash)] -> Purview event m -> Purview event m
cleanTree [(Hash, Hash)]
css Purview event m
component = case Purview event m
component of
  Attribute Attributes event
attr Purview event m
cont ->
    let
      tree :: Purview event m
tree = [(Hash, Hash)] -> Purview event m -> Purview event m
forall event (m :: * -> *).
Typeable event =>
[(Hash, Hash)] -> Purview event m -> Purview event m
cleanTree [(Hash, Hash)]
css Purview event m
cont
      cleanedAttr :: Attributes event
cleanedAttr = [(Hash, Hash)] -> Attributes event -> Attributes event
forall e. [(Hash, Hash)] -> Attributes e -> Attributes e
removeClassCSS [(Hash, Hash)]
css 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
cleanedAttr Purview event m
tree

  Html Hash
kind [Purview event m]
children ->
    let
      cleanChildren :: [Purview event m]
cleanChildren = (Purview event m -> Purview event m)
-> [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 ([(Hash, Hash)] -> Purview event m -> Purview event m
forall event (m :: * -> *).
Typeable event =>
[(Hash, Hash)] -> Purview event m -> Purview event m
cleanTree [(Hash, Hash)]
css) [Purview event m]
children
    in
      Hash -> [Purview event m] -> Purview event m
forall event (m :: * -> *).
Hash -> [Purview event m] -> Purview event m
Html Hash
kind [Purview event m]
cleanChildren

  EffectHandler ParentIdentifier
ploc ParentIdentifier
loc [DirectedEvent event newEvent]
initEvents state
state newEvent
-> state -> m (state -> state, [DirectedEvent event newEvent])
handler state -> Purview newEvent m
cont  ->
    let
      cleanCont :: state -> Purview newEvent m
cleanCont = (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 ([(Hash, Hash)] -> Purview newEvent m -> Purview newEvent m
forall event (m :: * -> *).
Typeable event =>
[(Hash, Hash)] -> Purview event m -> Purview event m
cleanTree [(Hash, Hash)]
css) state -> Purview newEvent m
cont
    in
      ParentIdentifier
-> ParentIdentifier
-> [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) =>
ParentIdentifier
-> ParentIdentifier
-> [DirectedEvent event newEvent]
-> state
-> (newEvent
    -> state -> m (state -> state, [DirectedEvent event newEvent]))
-> (state -> Purview newEvent m)
-> Purview event m
EffectHandler ParentIdentifier
ploc ParentIdentifier
loc [] state
state newEvent
-> state -> m (state -> state, [DirectedEvent event newEvent])
handler state -> Purview newEvent m
cleanCont

  Handler ParentIdentifier
ploc ParentIdentifier
loc [DirectedEvent event newEvent]
initEvents state
state newEvent
-> state -> (state -> state, [DirectedEvent event newEvent])
handler state -> Purview newEvent m
cont ->
    let
      cleanCont :: state -> Purview newEvent m
cleanCont = (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 ([(Hash, Hash)] -> Purview newEvent m -> Purview newEvent m
forall event (m :: * -> *).
Typeable event =>
[(Hash, Hash)] -> Purview event m -> Purview event m
cleanTree [(Hash, Hash)]
css) state -> Purview newEvent m
cont
    in
      ParentIdentifier
-> ParentIdentifier
-> [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) =>
ParentIdentifier
-> ParentIdentifier
-> [DirectedEvent event newEvent]
-> state
-> (newEvent
    -> state -> (state -> state, [DirectedEvent event newEvent]))
-> (state -> Purview newEvent m)
-> Purview event m
Handler ParentIdentifier
ploc ParentIdentifier
loc [] state
state newEvent
-> state -> (state -> state, [DirectedEvent event newEvent])
handler state -> Purview newEvent m
cleanCont

  r :: Purview event m
r@Receiver {} -> Purview event m
r
  t :: Purview event m
t@(Text Hash
val)  -> Purview event m
t
  v :: Purview event m
v@(Value a
val) -> Purview event m
v