{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module MiniLight.Event (
  Event (..),
  EventType (..),
  EventData (..),
  signal,
  asSignal,
  asRawEvent,
  asNotifyEvent,
  asEventData,
) where

import qualified SDL
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import Data.Type.Equality
import Type.Reflection
import qualified System.FSNotify as Notify

-- | EventType says some type can be used as an event type.
class Typeable e => EventType e where
  getEventType :: e -> T.Text
  default getEventType :: Show e => e -> T.Text
  getEventType = String -> Text
T.pack (String -> Text) -> (e -> String) -> e -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall a. Show a => a -> String
show

  getEventProperties :: e -> Object
  getEventProperties _ = Object
forall k v. HashMap k v
HM.empty

-- | This type is same as 'Dynamic' from @Data.Dynamic@, but it requires 'EventType' contraint.
data Dynamic where
  Dynamic :: forall a. EventType a => TypeRep a -> a -> Dynamic

toDyn :: EventType a => a -> Dynamic
toDyn :: a -> Dynamic
toDyn v :: a
v = TypeRep a -> a -> Dynamic
forall a. EventType a => TypeRep a -> a -> Dynamic
Dynamic TypeRep a
forall k (a :: k). Typeable a => TypeRep a
typeRep a
v

fromDynamic :: forall a . (EventType a) => Dynamic -> Maybe a
fromDynamic :: Dynamic -> Maybe a
fromDynamic (Dynamic t :: TypeRep a
t v :: a
v) | Just HRefl <- TypeRep a
t TypeRep a -> TypeRep a -> Maybe (a :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep a
rep = a -> Maybe a
forall a. a -> Maybe a
Just a
v
                          | Bool
otherwise                       = Maybe a
forall a. Maybe a
Nothing
  where rep :: TypeRep a
rep = TypeRep a
forall k (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep a

-- | Event type representation
data Event
  = Signal T.Text (Maybe T.Text) Dynamic
  | RawEvent SDL.Event
  | NotifyEvent Notify.Event

-- | Create a signal event.
signal
  :: EventType a
  => T.Text  -- ^ source component ID
  -> Maybe T.Text  -- ^ target component ID, leave Nothing if this is a global event
  -> a
  -> Event
signal :: Text -> Maybe Text -> a -> Event
signal s :: Text
s t :: Maybe Text
t v :: a
v = Text -> Maybe Text -> Dynamic -> Event
Signal Text
s Maybe Text
t (a -> Dynamic
forall a. EventType a => a -> Dynamic
toDyn a
v)

-- | Cast a signal event to some 'EventType'.
asSignal :: EventType a => Event -> Maybe a
asSignal :: Event -> Maybe a
asSignal (Signal _ _ v :: Dynamic
v) = Dynamic -> Maybe a
forall a. EventType a => Dynamic -> Maybe a
fromDynamic Dynamic
v
asSignal _              = Maybe a
forall a. Maybe a
Nothing

-- | Cast an event to some 'SDL.Event'
asRawEvent :: Event -> Maybe SDL.Event
asRawEvent :: Event -> Maybe Event
asRawEvent (RawEvent e :: Event
e) = Event -> Maybe Event
forall a. a -> Maybe a
Just Event
e
asRawEvent _            = Maybe Event
forall a. Maybe a
Nothing

-- | Cast an event to some 'Notify.Event'
asNotifyEvent :: Event -> Maybe Notify.Event
asNotifyEvent :: Event -> Maybe Event
asNotifyEvent (NotifyEvent e :: Event
e) = Event -> Maybe Event
forall a. a -> Maybe a
Just Event
e
asNotifyEvent _               = Maybe Event
forall a. Maybe a
Nothing

-- | Canonical datatype of 'Event'. It consists of event name and event data itself.
-- This type is usually used for global events.
data EventData = EventData T.Text Value
  deriving (Int -> EventData -> ShowS
[EventData] -> ShowS
EventData -> String
(Int -> EventData -> ShowS)
-> (EventData -> String)
-> ([EventData] -> ShowS)
-> Show EventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventData] -> ShowS
$cshowList :: [EventData] -> ShowS
show :: EventData -> String
$cshow :: EventData -> String
showsPrec :: Int -> EventData -> ShowS
$cshowsPrec :: Int -> EventData -> ShowS
Show, Typeable)

instance EventType EventData where
  getEventType :: EventData -> Text
getEventType (EventData t :: Text
t _) = Text
t
  getEventProperties :: EventData -> Object
getEventProperties (EventData _ o :: Value
o) = Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton "data" Value
o

-- | Cast a signal event to 'EventData'
asEventData :: Event -> Maybe EventData
asEventData :: Event -> Maybe EventData
asEventData (Signal _ Nothing v :: Dynamic
v) = Dynamic -> Maybe EventData
forall a. EventType a => Dynamic -> Maybe a
fromDynamic Dynamic
v
asEventData _                    = Maybe EventData
forall a. Maybe a
Nothing