{-# 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 = T.pack . show
getEventProperties :: e -> Object
getEventProperties _ = HM.empty
data Dynamic where
Dynamic :: forall a. EventType a => TypeRep a -> a -> Dynamic
toDyn :: EventType a => a -> Dynamic
toDyn v = Dynamic typeRep v
fromDynamic :: forall a . (EventType a) => Dynamic -> Maybe a
fromDynamic (Dynamic t v) | Just HRefl <- t `eqTypeRep` rep = Just v
| otherwise = Nothing
where rep = 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 s t v = Signal s t (toDyn v)
asSignal :: EventType a => Event -> Maybe a
asSignal (Signal _ _ v) = fromDynamic v
asSignal _ = Nothing
asRawEvent :: Event -> Maybe SDL.Event
asRawEvent (RawEvent e) = Just e
asRawEvent _ = Nothing
asNotifyEvent :: Event -> Maybe Notify.Event
asNotifyEvent (NotifyEvent e) = Just e
asNotifyEvent _ = Nothing
data EventData = EventData T.Text Value
deriving (Show, Typeable)
instance EventType EventData where
getEventType (EventData t _) = t
getEventProperties (EventData _ o) = HM.singleton "data" o
asEventData :: Event -> Maybe EventData
asEventData (Signal _ Nothing v) = fromDynamic v
asEventData _ = Nothing