{-# 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
data ForFrontEndEvent m = ForFrontEndEvent
{ forall m. ForFrontEndEvent m -> Text
event :: Text
, forall m. ForFrontEndEvent m -> m
message :: m
} deriving ((forall x. ForFrontEndEvent m -> Rep (ForFrontEndEvent m) x)
-> (forall x. Rep (ForFrontEndEvent m) x -> ForFrontEndEvent m)
-> Generic (ForFrontEndEvent m)
forall x. Rep (ForFrontEndEvent m) x -> ForFrontEndEvent m
forall x. ForFrontEndEvent m -> Rep (ForFrontEndEvent m) x
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
$cfrom :: forall m x. ForFrontEndEvent m -> Rep (ForFrontEndEvent m) x
from :: forall x. ForFrontEndEvent m -> Rep (ForFrontEndEvent m) x
$cto :: forall m x. Rep (ForFrontEndEvent m) x -> ForFrontEndEvent m
to :: forall x. Rep (ForFrontEndEvent m) x -> ForFrontEndEvent m
Generic, Int -> ForFrontEndEvent m -> ShowS
[ForFrontEndEvent m] -> ShowS
ForFrontEndEvent m -> String
(Int -> ForFrontEndEvent m -> ShowS)
-> (ForFrontEndEvent m -> String)
-> ([ForFrontEndEvent m] -> ShowS)
-> Show (ForFrontEndEvent m)
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
$cshowsPrec :: forall m. Show m => Int -> ForFrontEndEvent m -> ShowS
showsPrec :: Int -> ForFrontEndEvent m -> ShowS
$cshow :: forall m. Show m => ForFrontEndEvent m -> String
show :: ForFrontEndEvent m -> String
$cshowList :: forall m. Show m => [ForFrontEndEvent m] -> ShowS
showList :: [ForFrontEndEvent m] -> ShowS
Show)
instance ToJSON m => ToJSON (ForFrontEndEvent m) where
toEncoding :: ForFrontEndEvent m -> Encoding
toEncoding = Options -> ForFrontEndEvent m -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
data Event where
FromFrontendEvent
:: { Event -> Text
kind :: Text
, 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: "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
event
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", childLocation: "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
message
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", location: "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
location
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", value: "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe String -> String
forall a. Show a => a -> String
show Maybe String
value String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" }"
show (StateChangeEvent state -> state
_ Identifier
location) =
String
"{ event: \"newState\", location: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
location String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" }"
show (InternalEvent event
event Identifier
childId Identifier
handlerId)
= String
"{ event: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> event -> String
forall a. Show a => a -> String
show event
event
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", childId: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
childId
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", handlerId: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Identifier -> String
forall a. Show a => a -> String
show Identifier
handlerId
String -> ShowS
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
eventB Bool -> Bool -> Bool
&& Identifier
messageA Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
messageB Bool -> Bool -> Bool
&& Identifier
locationA Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
locationB Bool -> Bool -> Bool
&& Maybe String
valueA Maybe String -> Maybe String -> Bool
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 event -> Maybe event
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast event
event of
Just event
castEvent -> Identifier
childId Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
childId' Bool -> Bool -> Bool
&& Identifier
handlerId Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
handlerId' Bool -> Bool -> Bool
&& event
castEvent event -> event -> Bool
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 (Text -> Identifier -> Identifier -> Maybe String -> Event)
-> Parser Text
-> Parser (Identifier -> Identifier -> Maybe String -> Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event" Parser (Identifier -> Identifier -> Maybe String -> Event)
-> Parser Identifier
-> Parser (Identifier -> Maybe String -> Event)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Identifier
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"childLocation") Parser (Identifier -> Maybe String -> Event)
-> Parser Identifier -> Parser (Maybe String -> Event)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Identifier
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"location" Parser (Maybe String -> Event)
-> Parser (Maybe String) -> Parser Event
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value"
parseJSON Value
_ = String -> Parser Event
forall a. HasCallStack => String -> a
error String
"fail"
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