{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
module Component where

import           Data.Typeable
import           Events

type Hash = String

{-|

Attributes are collected until an 'HTML' constructor is hit, where they
are applied during rendering.

-}
data Attributes event where
  On :: ( Show event
        , Eq event
        , Typeable event
        )
     => String
     -> Identifier
     -> (Maybe String -> event)  -- the string here is information from the browser
     -> Attributes event
        -- ^ part of creating handlers for different events, e.g. On "click"
  Style :: (Hash, String) -> Attributes event
        -- ^ hash of the css, the css
  Generic :: String -> String -> Attributes event
        -- ^ for creating new Attributes to put on HTML, e.g. Generic "type" "radio" for type="radio".

instance Eq (Attributes event) where
  (Style (Hash, Hash)
a) == :: Attributes event -> Attributes event -> Bool
== (Style (Hash, Hash)
b) = (Hash, Hash)
a (Hash, Hash) -> (Hash, Hash) -> Bool
forall a. Eq a => a -> a -> Bool
== (Hash, Hash)
b
  (Style (Hash, Hash)
_) == Attributes event
_ = Bool
False

  (On Hash
kind Identifier
ident Maybe Hash -> event
_event) == (On Hash
kind' Identifier
ident' Maybe Hash -> event
_event') =
    Hash
kind Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
kind' Bool -> Bool -> Bool
&& Identifier
ident Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
ident'
  (On {}) == Attributes event
_ = Bool
False

  (Generic Hash
name Hash
value) == (Generic Hash
name' Hash
value') = Hash
name Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
name' Bool -> Bool -> Bool
&& Hash
value Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
value'
  (Generic Hash
_ Hash
_) == Attributes event
_ = Bool
False

instance Show (Attributes event) where
  show :: Attributes event -> Hash
show (On Hash
kind Identifier
ident Maybe Hash -> event
evt) = Hash
"On " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> Hash
show Hash
kind Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
ident
  show (Style (Hash, Hash)
str) = Hash
"Style " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Hash, Hash) -> Hash
forall a. Show a => a -> Hash
show (Hash, Hash)
str
  show (Generic Hash
attrKey Hash
attrValue) = Hash
"Generic " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> Hash
show Hash
attrKey Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> Hash
show Hash
attrValue

{-|

This is what you end up building using the various helpers.  It's hopefully rare
that you have to use these directly, but it may be useful to better understand
what's happening behind the scenes.

-}
data Purview event m where
  Attribute :: Attributes event -> Purview event m -> Purview event m
  Text :: String -> Purview event m
  Html :: String -> [Purview event m] -> Purview event m
  Value :: Show a => a -> Purview event m

  Receiver
    :: ( Show event
       , Eq event
       , Typeable event
       )
    => { forall event (m :: * -> *). Purview event m -> Identifier
parentIdentifier :: ParentIdentifier
       , forall event (m :: * -> *). Purview event m -> Identifier
identifier :: Identifier
       , forall event (m :: * -> *). Purview event m -> Hash
name :: String  -- the name to be used to send an event
       , forall event (m :: * -> *). Purview event m -> Maybe Hash -> event
eventHandler :: Maybe String -> event  -- what to do with an event from the fn
       , ()
child :: state -> Purview event m
       , ()
state :: state
       }
    -> Purview event m

  EffectHandler
    :: ( Show state
       , Eq state
       , Typeable state
       , Typeable newEvent
       )
    => { parentIdentifier :: ParentIdentifier
       -- ^ The location of the parent effect handler (provided by prepareTree)
       , identifier       :: Identifier
       -- ^ The location of this effect handler (provided by prepareTree)
       , ()
initialEvents    :: [DirectedEvent event newEvent]
       , state            :: state
       -- ^ The initial state
       , ()
effectReducer    :: newEvent
                          -> state
                          -> m (state -> state, [DirectedEvent event newEvent])
       -- ^ Receive an event, change the state, and send messages
       , ()
continuation     :: state -> Purview newEvent m
       }
    -> Purview event m

  Handler
    :: ( Show state
       , Eq state
       , Typeable state
       , Typeable newEvent
       )
    => { parentIdentifier :: ParentIdentifier
       , identifier       :: Identifier
       , initialEvents    :: [DirectedEvent event newEvent]
       , state            :: state
       , ()
reducer          :: newEvent
                          -> state
                          -> (state -> state, [DirectedEvent event newEvent])
       , continuation     :: state -> Purview newEvent m
       }
    -> Purview event m

instance Show (Purview event m) where
  show :: Purview event m -> Hash
show (EffectHandler Identifier
parentLocation Identifier
location [DirectedEvent event newEvent]
initialEvents state
state newEvent
-> state -> m (state -> state, [DirectedEvent event newEvent])
_event state -> Purview newEvent m
cont) =
    Hash
"EffectHandler "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
parentLocation Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
location Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> state -> Hash
forall a. Show a => a -> Hash
show state
state Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview newEvent m -> Hash
forall a. Show a => a -> Hash
show (state -> Purview newEvent m
cont state
state)
  show (Handler Identifier
parentLocation Identifier
location [DirectedEvent event newEvent]
initialEvents state
state newEvent
-> state -> (state -> state, [DirectedEvent event newEvent])
_event state -> Purview newEvent m
cont) =
    Hash
"Handler "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
parentLocation Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
location Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> state -> Hash
forall a. Show a => a -> Hash
show state
state Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview newEvent m -> Hash
forall a. Show a => a -> Hash
show (state -> Purview newEvent m
cont state
state)
  show (Receiver Identifier
parentLocation Identifier
location Hash
name Maybe Hash -> event
handler state -> Purview event m
child state
state) =
    Hash
"Receiver "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
parentLocation Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> Hash
forall a. Show a => a -> Hash
show Identifier
location Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> Hash
show Hash
name Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" "
      Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview event m -> Hash
forall a. Show a => a -> Hash
show (state -> Purview event m
child state
state)
  show (Attribute Attributes event
attrs Purview event m
cont) = Hash
"Attr " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Attributes event -> Hash
forall a. Show a => a -> Hash
show Attributes event
attrs Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Purview event m -> Hash
forall a. Show a => a -> Hash
show Purview event m
cont
  show (Text Hash
str) = ShowS
forall a. Show a => a -> Hash
show Hash
str
  show (Html Hash
kind [Purview event m]
children) =
    Hash
kind Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" [ " Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Purview event m -> Hash) -> [Purview event m] -> Hash
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Hash -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) Hash
" " ShowS -> (Purview event m -> Hash) -> Purview event m -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Purview event m -> Hash
forall a. Show a => a -> Hash
show) [Purview event m]
children Hash -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash
" ] "
  show (Value a
value) = a -> Hash
forall a. Show a => a -> Hash
show a
value

instance Eq (Purview event m) where
  Purview event m
a == :: Purview event m -> Purview event m -> Bool
== Purview event m
b = Purview event m -> Hash
forall a. Show a => a -> Hash
show Purview event m
a Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Purview event m -> Hash
forall a. Show a => a -> Hash
show Purview event m
b