{-# 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 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

{-|

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: "
      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"

{-|

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