{-# 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
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
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
data Event
= Signal T.Text (Maybe T.Text) Dynamic
| RawEvent SDL.Event
| NotifyEvent Notify.Event
signal
:: EventType a
=> T.Text
-> Maybe T.Text
-> 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)
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
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
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
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
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