{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}

module Events where

import Prelude hiding (print)
import           Data.Text (Text)
import           Data.Typeable
import           Data.Aeson
import           GHC.Generics


type Identifier = Maybe [Int]
type ParentIdentifier = Identifier

{-|

This for events intended for the front end

-}
data ForFrontEndEvent m = ForFrontEndEvent
  { forall m. ForFrontEndEvent m -> Text
event :: Text
  , forall m. ForFrontEndEvent m -> m
message :: m
  } deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall m x. Rep (ForFrontEndEvent m) x -> ForFrontEndEvent m
forall m x. ForFrontEndEvent m -> Rep (ForFrontEndEvent m) x
$cto :: forall m x. Rep (ForFrontEndEvent m) x -> ForFrontEndEvent m
$cfrom :: forall m x. ForFrontEndEvent m -> Rep (ForFrontEndEvent m) x
Generic, Int -> ForFrontEndEvent m -> ShowS
forall m. Show m => Int -> ForFrontEndEvent m -> ShowS
forall m. Show m => [ForFrontEndEvent m] -> ShowS
forall m. Show m => ForFrontEndEvent m -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForFrontEndEvent m] -> ShowS
$cshowList :: forall m. Show m => [ForFrontEndEvent m] -> ShowS
show :: ForFrontEndEvent m -> String
$cshow :: forall m. Show m => ForFrontEndEvent m -> String
showsPrec :: Int -> ForFrontEndEvent m -> ShowS
$cshowsPrec :: forall m. Show m => Int -> ForFrontEndEvent m -> ShowS
Show)

instance ToJSON m => ToJSON (ForFrontEndEvent m) where
  toEncoding :: ForFrontEndEvent m -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

{-|

These encapsulate events that come from the front end in addition to events
that are internal.  For example, state changes or messages being sent to
handlers higher up in the tree.

-}
data Event where
  FromFrontendEvent
    :: { Event -> Text
kind :: Text
       -- ^ for example, "click" or "blur"
       , Event -> Identifier
childLocation :: Identifier
       , Event -> Identifier
location :: Identifier
       , Event -> Maybe String
value :: Maybe String
       }
    -> Event

  InternalEvent
    :: ( Show event
       , Eq event
       , Typeable event
       )
    => { ()
event :: event
       , Event -> Identifier
childId :: Identifier
       , Event -> Identifier
handlerId :: Identifier
       }
    -> Event

  StateChangeEvent
    :: ( Eq state, Show state, Typeable state )
    => (state -> state) -> Identifier -> Event

  JavascriptCallEvent
    :: String -> String -> Event


instance Show Event where
  show :: Event -> String
show (FromFrontendEvent Text
event Identifier
message Identifier
location Maybe String
value) =
      String
"{ event: "
      forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
event
      forall a. Semigroup a => a -> a -> a
<> String
", childLocation: "
      forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Identifier
message
      forall a. Semigroup a => a -> a -> a
<> String
", location: "
      forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Identifier
location
      forall a. Semigroup a => a -> a -> a
<> String
", value: "
      forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Maybe String
value forall a. Semigroup a => a -> a -> a
<> String
" }"

  show (StateChangeEvent state -> state
_ Identifier
location) =
    String
"{ event: \"newState\", location: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Identifier
location forall a. Semigroup a => a -> a -> a
<> String
" }"

  show (InternalEvent event
event Identifier
childId Identifier
handlerId)
    =  String
"{ event: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show event
event
    forall a. Semigroup a => a -> a -> a
<> String
", childId: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Identifier
childId
    forall a. Semigroup a => a -> a -> a
<> String
", handlerId: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Identifier
handlerId
    forall a. Semigroup a => a -> a -> a
<> String
" }"

  show (JavascriptCallEvent String
name String
value) =
    String
"{ event: \"callJS\" }"

instance Eq Event where
  (FromFrontendEvent { $sel:childLocation:FromFrontendEvent :: Event -> Identifier
childLocation=Identifier
messageA, $sel:kind:FromFrontendEvent :: Event -> Text
kind=Text
eventA, $sel:location:FromFrontendEvent :: Event -> Identifier
location=Identifier
locationA, $sel:value:FromFrontendEvent :: Event -> Maybe String
value=Maybe String
valueA })
    == :: Event -> Event -> Bool
== (FromFrontendEvent { $sel:childLocation:FromFrontendEvent :: Event -> Identifier
childLocation=Identifier
messageB, $sel:kind:FromFrontendEvent :: Event -> Text
kind=Text
eventB, $sel:location:FromFrontendEvent :: Event -> Identifier
location=Identifier
locationB, $sel:value:FromFrontendEvent :: Event -> Maybe String
value=Maybe String
valueB }) =
    Text
eventA forall a. Eq a => a -> a -> Bool
== Text
eventB Bool -> Bool -> Bool
&& Identifier
messageA forall a. Eq a => a -> a -> Bool
== Identifier
messageB Bool -> Bool -> Bool
&& Identifier
locationA forall a. Eq a => a -> a -> Bool
== Identifier
locationB Bool -> Bool -> Bool
&& Maybe String
valueA forall a. Eq a => a -> a -> Bool
== Maybe String
valueB
  (FromFrontendEvent {}) == Event
_ = Bool
False

  (StateChangeEvent state -> state
_ Identifier
_) == Event
_ = Bool
False

  (InternalEvent event
event Identifier
childId Identifier
handlerId) == (InternalEvent event
event' Identifier
childId' Identifier
handlerId') =
    case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast event
event of
      Just event
castEvent -> Identifier
childId forall a. Eq a => a -> a -> Bool
== Identifier
childId' Bool -> Bool -> Bool
&& Identifier
handlerId forall a. Eq a => a -> a -> Bool
== Identifier
handlerId' Bool -> Bool -> Bool
&& event
castEvent forall a. Eq a => a -> a -> Bool
== event
event'
      Maybe event
Nothing        -> Bool
False
  (InternalEvent {}) == Event
_ = Bool
False

  (JavascriptCallEvent {}) == Event
_ = Bool
False


instance FromJSON Event where
  parseJSON :: Value -> Parser Event
parseJSON (Object Object
o) =
      Text -> Identifier -> Identifier -> Maybe String -> Event
FromFrontendEvent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"childLocation") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"location" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value"
  parseJSON Value
_ = forall a. HasCallStack => String -> a
error String
"fail"

{-|

This is for creating events that should go to a parent handler,
or sent back in to the same handler.

-}
data DirectedEvent a b where
  Parent :: (Show a, Eq a) => a -> DirectedEvent a b
  Self :: (Show b, Eq b) => b -> DirectedEvent a b
  Browser :: String -> String -> DirectedEvent a b