{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
module Reflex.SDL2.Base
  ( ReflexSDL2T (..)
  , runReflexSDL2T
  ) where


import           Control.Monad.Fix        (MonadFix)
import           Control.Monad.Exception  (MonadException)
import           Control.Monad.Reader
import           Data.Kind                (Type)
import           Reflex
import           Reflex.Host.Class

import           Reflex.SDL2.Class
import           Reflex.SDL2.Internal


------------------------------------------------------------------------------
-- | Provides an implementation of the 'HasSDL2Events' type class.
newtype ReflexSDL2T t (m :: Type -> Type) a =
  ReflexSDL2T { forall t (m :: * -> *) a.
ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a
unReflexSDL2T :: ReaderT (SystemEvents t) m a }


runReflexSDL2T :: ReflexSDL2T t m a -> SystemEvents t -> m a
runReflexSDL2T :: forall t (m :: * -> *) a.
ReflexSDL2T t m a -> SystemEvents t -> m a
runReflexSDL2T = ReaderT (SystemEvents t) m a -> SystemEvents t -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT (SystemEvents t) m a -> SystemEvents t -> m a)
-> (ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a)
-> ReflexSDL2T t m a
-> SystemEvents t
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a
forall t (m :: * -> *) a.
ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a
unReflexSDL2T


deriving instance (ReflexHost t, Functor m)        => Functor (ReflexSDL2T t m)
deriving instance (ReflexHost t, Applicative m)    => Applicative (ReflexSDL2T t m)
deriving instance (ReflexHost t, Monad m)          => Monad (ReflexSDL2T t m)
deriving instance (ReflexHost t, MonadFix m)       => MonadFix (ReflexSDL2T t m)
deriving instance (ReflexHost t, MonadIO m)        => MonadIO (ReflexSDL2T t m)
deriving instance ReflexHost t                     => MonadTrans (ReflexSDL2T t)
deriving instance (ReflexHost t, MonadException m) => MonadException (ReflexSDL2T t m)
deriving instance (ReflexHost t, TriggerEvent t m) => TriggerEvent t (ReflexSDL2T t m)


askSys :: Monad m => (SystemEvents t -> a) -> ReflexSDL2T t m a
askSys :: forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys = ReaderT (SystemEvents t) m a -> ReflexSDL2T t m a
forall t (m :: * -> *) a.
ReaderT (SystemEvents t) m a -> ReflexSDL2T t m a
ReflexSDL2T (ReaderT (SystemEvents t) m a -> ReflexSDL2T t m a)
-> ((SystemEvents t -> a) -> ReaderT (SystemEvents t) m a)
-> (SystemEvents t -> a)
-> ReflexSDL2T t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SystemEvents t -> a) -> ReaderT (SystemEvents t) m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks


instance (ReflexHost t, Monad m) => HasSDL2Events t (ReflexSDL2T t m) where
  getTicksEvent :: ReflexSDL2T t m (Event t Word32)
getTicksEvent = (SystemEvents t -> Event t Word32)
-> ReflexSDL2T t m (Event t Word32)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t Word32
forall t. SystemEvents t -> Event t Word32
sysTicksEvent
  getAnySDLEvent :: ReflexSDL2T t m (Event t EventPayload)
getAnySDLEvent = (SystemEvents t -> Event t EventPayload)
-> ReflexSDL2T t m (Event t EventPayload)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t EventPayload
forall t. SystemEvents t -> Event t EventPayload
sysAnySDLEvent
  getWindowShownEvent :: ReflexSDL2T t m (Event t WindowShownEventData)
getWindowShownEvent = (SystemEvents t -> Event t WindowShownEventData)
-> ReflexSDL2T t m (Event t WindowShownEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowShownEventData
forall t. SystemEvents t -> Event t WindowShownEventData
sysWindowShownEvent
  getWindowHiddenEvent :: ReflexSDL2T t m (Event t WindowHiddenEventData)
getWindowHiddenEvent = (SystemEvents t -> Event t WindowHiddenEventData)
-> ReflexSDL2T t m (Event t WindowHiddenEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowHiddenEventData
forall t. SystemEvents t -> Event t WindowHiddenEventData
sysWindowHiddenEvent
  getWindowExposedEvent :: ReflexSDL2T t m (Event t WindowExposedEventData)
getWindowExposedEvent = (SystemEvents t -> Event t WindowExposedEventData)
-> ReflexSDL2T t m (Event t WindowExposedEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowExposedEventData
forall t. SystemEvents t -> Event t WindowExposedEventData
sysWindowExposedEvent
  getWindowMovedEvent :: ReflexSDL2T t m (Event t WindowMovedEventData)
getWindowMovedEvent = (SystemEvents t -> Event t WindowMovedEventData)
-> ReflexSDL2T t m (Event t WindowMovedEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowMovedEventData
forall t. SystemEvents t -> Event t WindowMovedEventData
sysWindowMovedEvent
  getWindowResizedEvent :: ReflexSDL2T t m (Event t WindowResizedEventData)
getWindowResizedEvent = (SystemEvents t -> Event t WindowResizedEventData)
-> ReflexSDL2T t m (Event t WindowResizedEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowResizedEventData
forall t. SystemEvents t -> Event t WindowResizedEventData
sysWindowResizedEvent
  getWindowSizeChangedEvent :: ReflexSDL2T t m (Event t WindowSizeChangedEventData)
getWindowSizeChangedEvent = (SystemEvents t -> Event t WindowSizeChangedEventData)
-> ReflexSDL2T t m (Event t WindowSizeChangedEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowSizeChangedEventData
forall t. SystemEvents t -> Event t WindowSizeChangedEventData
sysWindowSizeChangedEvent
  getWindowMinimizedEvent :: ReflexSDL2T t m (Event t WindowMinimizedEventData)
getWindowMinimizedEvent = (SystemEvents t -> Event t WindowMinimizedEventData)
-> ReflexSDL2T t m (Event t WindowMinimizedEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowMinimizedEventData
forall t. SystemEvents t -> Event t WindowMinimizedEventData
sysWindowMinimizedEvent
  getWindowMaximizedEvent :: ReflexSDL2T t m (Event t WindowMaximizedEventData)
getWindowMaximizedEvent = (SystemEvents t -> Event t WindowMaximizedEventData)
-> ReflexSDL2T t m (Event t WindowMaximizedEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowMaximizedEventData
forall t. SystemEvents t -> Event t WindowMaximizedEventData
sysWindowMaximizedEvent
  getWindowRestoredEvent :: ReflexSDL2T t m (Event t WindowRestoredEventData)
getWindowRestoredEvent = (SystemEvents t -> Event t WindowRestoredEventData)
-> ReflexSDL2T t m (Event t WindowRestoredEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowRestoredEventData
forall t. SystemEvents t -> Event t WindowRestoredEventData
sysWindowRestoredEvent
  getWindowGainedMouseFocusEvent :: ReflexSDL2T t m (Event t WindowGainedMouseFocusEventData)
getWindowGainedMouseFocusEvent = (SystemEvents t -> Event t WindowGainedMouseFocusEventData)
-> ReflexSDL2T t m (Event t WindowGainedMouseFocusEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowGainedMouseFocusEventData
forall t. SystemEvents t -> Event t WindowGainedMouseFocusEventData
sysWindowGainedMouseFocusEvent
  getWindowLostMouseFocusEvent :: ReflexSDL2T t m (Event t WindowLostMouseFocusEventData)
getWindowLostMouseFocusEvent = (SystemEvents t -> Event t WindowLostMouseFocusEventData)
-> ReflexSDL2T t m (Event t WindowLostMouseFocusEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowLostMouseFocusEventData
forall t. SystemEvents t -> Event t WindowLostMouseFocusEventData
sysWindowLostMouseFocusEvent
  getWindowGainedKeyboardFocusEvent :: ReflexSDL2T t m (Event t WindowGainedKeyboardFocusEventData)
getWindowGainedKeyboardFocusEvent = (SystemEvents t -> Event t WindowGainedKeyboardFocusEventData)
-> ReflexSDL2T t m (Event t WindowGainedKeyboardFocusEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowGainedKeyboardFocusEventData
forall t.
SystemEvents t -> Event t WindowGainedKeyboardFocusEventData
sysWindowGainedKeyboardFocusEvent
  getWindowLostKeyboardFocusEvent :: ReflexSDL2T t m (Event t WindowLostKeyboardFocusEventData)
getWindowLostKeyboardFocusEvent = (SystemEvents t -> Event t WindowLostKeyboardFocusEventData)
-> ReflexSDL2T t m (Event t WindowLostKeyboardFocusEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowLostKeyboardFocusEventData
forall t.
SystemEvents t -> Event t WindowLostKeyboardFocusEventData
sysWindowLostKeyboardFocusEvent
  getWindowClosedEvent :: ReflexSDL2T t m (Event t WindowClosedEventData)
getWindowClosedEvent = (SystemEvents t -> Event t WindowClosedEventData)
-> ReflexSDL2T t m (Event t WindowClosedEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t WindowClosedEventData
forall t. SystemEvents t -> Event t WindowClosedEventData
sysWindowClosedEvent
  getKeyboardEvent :: ReflexSDL2T t m (Event t KeyboardEventData)
getKeyboardEvent = (SystemEvents t -> Event t KeyboardEventData)
-> ReflexSDL2T t m (Event t KeyboardEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t KeyboardEventData
forall t. SystemEvents t -> Event t KeyboardEventData
sysKeyboardEvent
  getTextEditingEvent :: ReflexSDL2T t m (Event t TextEditingEventData)
getTextEditingEvent = (SystemEvents t -> Event t TextEditingEventData)
-> ReflexSDL2T t m (Event t TextEditingEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t TextEditingEventData
forall t. SystemEvents t -> Event t TextEditingEventData
sysTextEditingEvent
  getTextInputEvent :: ReflexSDL2T t m (Event t TextInputEventData)
getTextInputEvent = (SystemEvents t -> Event t TextInputEventData)
-> ReflexSDL2T t m (Event t TextInputEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t TextInputEventData
forall t. SystemEvents t -> Event t TextInputEventData
sysTextInputEvent
  getKeymapChangedEvent :: ReflexSDL2T t m (Event t ())
getKeymapChangedEvent = (SystemEvents t -> Event t ()) -> ReflexSDL2T t m (Event t ())
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t ()
forall t. SystemEvents t -> Event t ()
sysKeymapChangedEvent
  getMouseMotionEvent :: ReflexSDL2T t m (Event t MouseMotionEventData)
getMouseMotionEvent = (SystemEvents t -> Event t MouseMotionEventData)
-> ReflexSDL2T t m (Event t MouseMotionEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t MouseMotionEventData
forall t. SystemEvents t -> Event t MouseMotionEventData
sysMouseMotionEvent
  getMouseButtonEvent :: ReflexSDL2T t m (Event t MouseButtonEventData)
getMouseButtonEvent = (SystemEvents t -> Event t MouseButtonEventData)
-> ReflexSDL2T t m (Event t MouseButtonEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t MouseButtonEventData
forall t. SystemEvents t -> Event t MouseButtonEventData
sysMouseButtonEvent
  getMouseWheelEvent :: ReflexSDL2T t m (Event t MouseWheelEventData)
getMouseWheelEvent = (SystemEvents t -> Event t MouseWheelEventData)
-> ReflexSDL2T t m (Event t MouseWheelEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t MouseWheelEventData
forall t. SystemEvents t -> Event t MouseWheelEventData
sysMouseWheelEvent
  getJoyAxisEvent :: ReflexSDL2T t m (Event t JoyAxisEventData)
getJoyAxisEvent = (SystemEvents t -> Event t JoyAxisEventData)
-> ReflexSDL2T t m (Event t JoyAxisEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t JoyAxisEventData
forall t. SystemEvents t -> Event t JoyAxisEventData
sysJoyAxisEvent
  getJoyBallEvent :: ReflexSDL2T t m (Event t JoyBallEventData)
getJoyBallEvent = (SystemEvents t -> Event t JoyBallEventData)
-> ReflexSDL2T t m (Event t JoyBallEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t JoyBallEventData
forall t. SystemEvents t -> Event t JoyBallEventData
sysJoyBallEvent
  getJoyHatEvent :: ReflexSDL2T t m (Event t JoyHatEventData)
getJoyHatEvent = (SystemEvents t -> Event t JoyHatEventData)
-> ReflexSDL2T t m (Event t JoyHatEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t JoyHatEventData
forall t. SystemEvents t -> Event t JoyHatEventData
sysJoyHatEvent
  getJoyButtonEvent :: ReflexSDL2T t m (Event t JoyButtonEventData)
getJoyButtonEvent = (SystemEvents t -> Event t JoyButtonEventData)
-> ReflexSDL2T t m (Event t JoyButtonEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t JoyButtonEventData
forall t. SystemEvents t -> Event t JoyButtonEventData
sysJoyButtonEvent
  getJoyDeviceEvent :: ReflexSDL2T t m (Event t JoyDeviceEventData)
getJoyDeviceEvent = (SystemEvents t -> Event t JoyDeviceEventData)
-> ReflexSDL2T t m (Event t JoyDeviceEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t JoyDeviceEventData
forall t. SystemEvents t -> Event t JoyDeviceEventData
sysJoyDeviceEvent
  getControllerAxisEvent :: ReflexSDL2T t m (Event t ControllerAxisEventData)
getControllerAxisEvent = (SystemEvents t -> Event t ControllerAxisEventData)
-> ReflexSDL2T t m (Event t ControllerAxisEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t ControllerAxisEventData
forall t. SystemEvents t -> Event t ControllerAxisEventData
sysControllerAxisEvent
  getControllerButtonEvent :: ReflexSDL2T t m (Event t ControllerButtonEventData)
getControllerButtonEvent = (SystemEvents t -> Event t ControllerButtonEventData)
-> ReflexSDL2T t m (Event t ControllerButtonEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t ControllerButtonEventData
forall t. SystemEvents t -> Event t ControllerButtonEventData
sysControllerButtonEvent
  getControllerDeviceEvent :: ReflexSDL2T t m (Event t ControllerDeviceEventData)
getControllerDeviceEvent = (SystemEvents t -> Event t ControllerDeviceEventData)
-> ReflexSDL2T t m (Event t ControllerDeviceEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t ControllerDeviceEventData
forall t. SystemEvents t -> Event t ControllerDeviceEventData
sysControllerDeviceEvent
  getAudioDeviceEvent :: ReflexSDL2T t m (Event t AudioDeviceEventData)
getAudioDeviceEvent = (SystemEvents t -> Event t AudioDeviceEventData)
-> ReflexSDL2T t m (Event t AudioDeviceEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t AudioDeviceEventData
forall t. SystemEvents t -> Event t AudioDeviceEventData
sysAudioDeviceEvent
  getQuitEvent :: ReflexSDL2T t m (Event t ())
getQuitEvent = (SystemEvents t -> Event t ()) -> ReflexSDL2T t m (Event t ())
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t ()
forall t. SystemEvents t -> Event t ()
sysQuitEvent
  getUserEvent :: ReflexSDL2T t m (Event t UserEventData)
getUserEvent = (SystemEvents t -> Event t UserEventData)
-> ReflexSDL2T t m (Event t UserEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t UserEventData
forall t. SystemEvents t -> Event t UserEventData
sysUserEvent
  getSysWMEvent :: ReflexSDL2T t m (Event t SysWMEventData)
getSysWMEvent = (SystemEvents t -> Event t SysWMEventData)
-> ReflexSDL2T t m (Event t SysWMEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t SysWMEventData
forall t. SystemEvents t -> Event t SysWMEventData
sysSysWMEvent
  getTouchFingerEvent :: ReflexSDL2T t m (Event t TouchFingerEventData)
getTouchFingerEvent = (SystemEvents t -> Event t TouchFingerEventData)
-> ReflexSDL2T t m (Event t TouchFingerEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t TouchFingerEventData
forall t. SystemEvents t -> Event t TouchFingerEventData
sysTouchFingerEvent
  getMultiGestureEvent :: ReflexSDL2T t m (Event t MultiGestureEventData)
getMultiGestureEvent = (SystemEvents t -> Event t MultiGestureEventData)
-> ReflexSDL2T t m (Event t MultiGestureEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t MultiGestureEventData
forall t. SystemEvents t -> Event t MultiGestureEventData
sysMultiGestureEvent
  getDollarGestureEvent :: ReflexSDL2T t m (Event t DollarGestureEventData)
getDollarGestureEvent = (SystemEvents t -> Event t DollarGestureEventData)
-> ReflexSDL2T t m (Event t DollarGestureEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t DollarGestureEventData
forall t. SystemEvents t -> Event t DollarGestureEventData
sysDollarGestureEvent
  getDropEvent :: ReflexSDL2T t m (Event t DropEventData)
getDropEvent = (SystemEvents t -> Event t DropEventData)
-> ReflexSDL2T t m (Event t DropEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t DropEventData
forall t. SystemEvents t -> Event t DropEventData
sysDropEvent
  getClipboardUpdateEvent :: ReflexSDL2T t m (Event t ())
getClipboardUpdateEvent = (SystemEvents t -> Event t ()) -> ReflexSDL2T t m (Event t ())
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t ()
forall t. SystemEvents t -> Event t ()
sysClipboardUpdateEvent
  getUnknownEvent :: ReflexSDL2T t m (Event t UnknownEventData)
getUnknownEvent = (SystemEvents t -> Event t UnknownEventData)
-> ReflexSDL2T t m (Event t UnknownEventData)
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> Event t UnknownEventData
forall t. SystemEvents t -> Event t UnknownEventData
sysUnknownEvent
  getQuitVar :: ReflexSDL2T t m (MVar ())
getQuitVar = (SystemEvents t -> MVar ()) -> ReflexSDL2T t m (MVar ())
forall (m :: * -> *) t a.
Monad m =>
(SystemEvents t -> a) -> ReflexSDL2T t m a
askSys SystemEvents t -> MVar ()
forall t. SystemEvents t -> MVar ()
sysQuitVar


------------------------------------------------------------------------------
-- | 'ReflexSDL2T' is an instance of 'PostBuild'.
instance (Reflex t, PostBuild t m, ReflexHost t, Monad m) => PostBuild t (ReflexSDL2T t m) where
  getPostBuild :: ReflexSDL2T t m (Event t ())
getPostBuild = m (Event t ()) -> ReflexSDL2T t m (Event t ())
forall (m :: * -> *) a. Monad m => m a -> ReflexSDL2T t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild


------------------------------------------------------------------------------
-- | 'ReflexSDL2T' is an instance of 'PerformEvent'.
instance (ReflexHost t, PerformEvent t m) => PerformEvent t (ReflexSDL2T t m) where
  type Performable (ReflexSDL2T t m) = ReflexSDL2T t (Performable m)
  performEvent_ :: Event t (Performable (ReflexSDL2T t m) ()) -> ReflexSDL2T t m ()
performEvent_ = ReaderT (SystemEvents t) m () -> ReflexSDL2T t m ()
forall t (m :: * -> *) a.
ReaderT (SystemEvents t) m a -> ReflexSDL2T t m a
ReflexSDL2T (ReaderT (SystemEvents t) m () -> ReflexSDL2T t m ())
-> (Event t (ReflexSDL2T t (Performable m) ())
    -> ReaderT (SystemEvents t) m ())
-> Event t (ReflexSDL2T t (Performable m) ())
-> ReflexSDL2T t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (ReaderT (SystemEvents t) (Performable m) ())
-> ReaderT (SystemEvents t) m ()
Event t (Performable (ReaderT (SystemEvents t) m) ())
-> ReaderT (SystemEvents t) m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ (Event t (ReaderT (SystemEvents t) (Performable m) ())
 -> ReaderT (SystemEvents t) m ())
-> (Event t (ReflexSDL2T t (Performable m) ())
    -> Event t (ReaderT (SystemEvents t) (Performable m) ()))
-> Event t (ReflexSDL2T t (Performable m) ())
-> ReaderT (SystemEvents t) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReflexSDL2T t (Performable m) ()
 -> ReaderT (SystemEvents t) (Performable m) ())
-> Event t (ReflexSDL2T t (Performable m) ())
-> Event t (ReaderT (SystemEvents t) (Performable m) ())
forall a b. (a -> b) -> Event t a -> Event t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ReflexSDL2T t (Performable m) ()
-> ReaderT (SystemEvents t) (Performable m) ()
forall t (m :: * -> *) a.
ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a
unReflexSDL2T
  performEvent :: forall a.
Event t (Performable (ReflexSDL2T t m) a)
-> ReflexSDL2T t m (Event t a)
performEvent  = ReaderT (SystemEvents t) m (Event t a)
-> ReflexSDL2T t m (Event t a)
forall t (m :: * -> *) a.
ReaderT (SystemEvents t) m a -> ReflexSDL2T t m a
ReflexSDL2T (ReaderT (SystemEvents t) m (Event t a)
 -> ReflexSDL2T t m (Event t a))
-> (Event t (ReflexSDL2T t (Performable m) a)
    -> ReaderT (SystemEvents t) m (Event t a))
-> Event t (ReflexSDL2T t (Performable m) a)
-> ReflexSDL2T t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (ReaderT (SystemEvents t) (Performable m) a)
-> ReaderT (SystemEvents t) m (Event t a)
Event t (Performable (ReaderT (SystemEvents t) m) a)
-> ReaderT (SystemEvents t) m (Event t a)
forall a.
Event t (Performable (ReaderT (SystemEvents t) m) a)
-> ReaderT (SystemEvents t) m (Event t a)
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent  (Event t (ReaderT (SystemEvents t) (Performable m) a)
 -> ReaderT (SystemEvents t) m (Event t a))
-> (Event t (ReflexSDL2T t (Performable m) a)
    -> Event t (ReaderT (SystemEvents t) (Performable m) a))
-> Event t (ReflexSDL2T t (Performable m) a)
-> ReaderT (SystemEvents t) m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReflexSDL2T t (Performable m) a
 -> ReaderT (SystemEvents t) (Performable m) a)
-> Event t (ReflexSDL2T t (Performable m) a)
-> Event t (ReaderT (SystemEvents t) (Performable m) a)
forall a b. (a -> b) -> Event t a -> Event t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ReflexSDL2T t (Performable m) a
-> ReaderT (SystemEvents t) (Performable m) a
forall t (m :: * -> *) a.
ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a
unReflexSDL2T


------------------------------------------------------------------------------
-- | 'ReflexSDL2T' is an instance of 'Adjustable'.
instance ( Reflex t
         , ReflexHost t
         , Adjustable t m
         , Monad m
         ) => Adjustable t (ReflexSDL2T t m) where
  runWithReplace :: forall a b.
ReflexSDL2T t m a
-> Event t (ReflexSDL2T t m b) -> ReflexSDL2T t m (a, Event t b)
runWithReplace ReflexSDL2T t m a
ma Event t (ReflexSDL2T t m b)
evmb =
    ReaderT (SystemEvents t) m (a, Event t b)
-> ReflexSDL2T t m (a, Event t b)
forall t (m :: * -> *) a.
ReaderT (SystemEvents t) m a -> ReflexSDL2T t m a
ReflexSDL2T (ReaderT (SystemEvents t) m (a, Event t b)
 -> ReflexSDL2T t m (a, Event t b))
-> ReaderT (SystemEvents t) m (a, Event t b)
-> ReflexSDL2T t m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ ReaderT (SystemEvents t) m a
-> Event t (ReaderT (SystemEvents t) m b)
-> ReaderT (SystemEvents t) m (a, Event t b)
forall a b.
ReaderT (SystemEvents t) m a
-> Event t (ReaderT (SystemEvents t) m b)
-> ReaderT (SystemEvents t) m (a, Event t b)
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a
forall t (m :: * -> *) a.
ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a
unReflexSDL2T ReflexSDL2T t m a
ma) (ReflexSDL2T t m b -> ReaderT (SystemEvents t) m b
forall t (m :: * -> *) a.
ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a
unReflexSDL2T (ReflexSDL2T t m b -> ReaderT (SystemEvents t) m b)
-> Event t (ReflexSDL2T t m b)
-> Event t (ReaderT (SystemEvents t) m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (ReflexSDL2T t m b)
evmb)
  traverseDMapWithKeyWithAdjust :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> ReflexSDL2T t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> ReflexSDL2T t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a. k a -> v a -> ReflexSDL2T t m (v' a)
kvma DMap k v
dMapKV = ReaderT (SystemEvents t) m (DMap k v', Event t (PatchDMap k v'))
-> ReflexSDL2T t m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) a.
ReaderT (SystemEvents t) m a -> ReflexSDL2T t m a
ReflexSDL2T (ReaderT (SystemEvents t) m (DMap k v', Event t (PatchDMap k v'))
 -> ReflexSDL2T t m (DMap k v', Event t (PatchDMap k v')))
-> (Event t (PatchDMap k v)
    -> ReaderT
         (SystemEvents t) m (DMap k v', Event t (PatchDMap k v')))
-> Event t (PatchDMap k v)
-> ReflexSDL2T t m (DMap k v', Event t (PatchDMap k v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall a. k a -> v a -> ReaderT (SystemEvents t) m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> ReaderT (SystemEvents t) m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> ReaderT (SystemEvents t) m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> ReaderT (SystemEvents t) m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (\k a
ka -> ReflexSDL2T t m (v' a) -> ReaderT (SystemEvents t) m (v' a)
forall t (m :: * -> *) a.
ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a
unReflexSDL2T (ReflexSDL2T t m (v' a) -> ReaderT (SystemEvents t) m (v' a))
-> (v a -> ReflexSDL2T t m (v' a))
-> v a
-> ReaderT (SystemEvents t) m (v' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k a -> v a -> ReflexSDL2T t m (v' a)
forall a. k a -> v a -> ReflexSDL2T t m (v' a)
kvma k a
ka) DMap k v
dMapKV
  traverseDMapWithKeyWithAdjustWithMove :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> ReflexSDL2T t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> ReflexSDL2T t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a. k a -> v a -> ReflexSDL2T t m (v' a)
kvma DMap k v
dMapKV = ReaderT
  (SystemEvents t) m (DMap k v', Event t (PatchDMapWithMove k v'))
-> ReflexSDL2T t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) a.
ReaderT (SystemEvents t) m a -> ReflexSDL2T t m a
ReflexSDL2T (ReaderT
   (SystemEvents t) m (DMap k v', Event t (PatchDMapWithMove k v'))
 -> ReflexSDL2T t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> (Event t (PatchDMapWithMove k v)
    -> ReaderT
         (SystemEvents t) m (DMap k v', Event t (PatchDMapWithMove k v')))
-> Event t (PatchDMapWithMove k v)
-> ReflexSDL2T t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall a. k a -> v a -> ReaderT (SystemEvents t) m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> ReaderT
     (SystemEvents t) m (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> ReaderT (SystemEvents t) m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> ReaderT
     (SystemEvents t) m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (\k a
ka -> ReflexSDL2T t m (v' a) -> ReaderT (SystemEvents t) m (v' a)
forall t (m :: * -> *) a.
ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a
unReflexSDL2T (ReflexSDL2T t m (v' a) -> ReaderT (SystemEvents t) m (v' a))
-> (v a -> ReflexSDL2T t m (v' a))
-> v a
-> ReaderT (SystemEvents t) m (v' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k a -> v a -> ReflexSDL2T t m (v' a)
forall a. k a -> v a -> ReflexSDL2T t m (v' a)
kvma k a
ka) DMap k v
dMapKV
  traverseIntMapWithKeyWithAdjust :: forall v v'.
(Key -> v -> ReflexSDL2T t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> ReflexSDL2T t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Key -> v -> ReflexSDL2T t m v'
f IntMap v
im = ReaderT (SystemEvents t) m (IntMap v', Event t (PatchIntMap v'))
-> ReflexSDL2T t m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) a.
ReaderT (SystemEvents t) m a -> ReflexSDL2T t m a
ReflexSDL2T (ReaderT (SystemEvents t) m (IntMap v', Event t (PatchIntMap v'))
 -> ReflexSDL2T t m (IntMap v', Event t (PatchIntMap v')))
-> (Event t (PatchIntMap v)
    -> ReaderT
         (SystemEvents t) m (IntMap v', Event t (PatchIntMap v')))
-> Event t (PatchIntMap v)
-> ReflexSDL2T t m (IntMap v', Event t (PatchIntMap v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Key -> v -> ReaderT (SystemEvents t) m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> ReaderT (SystemEvents t) m (IntMap v', Event t (PatchIntMap v'))
forall v v'.
(Key -> v -> ReaderT (SystemEvents t) m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> ReaderT (SystemEvents t) m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Key -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust (\Key
ka -> ReflexSDL2T t m v' -> ReaderT (SystemEvents t) m v'
forall t (m :: * -> *) a.
ReflexSDL2T t m a -> ReaderT (SystemEvents t) m a
unReflexSDL2T (ReflexSDL2T t m v' -> ReaderT (SystemEvents t) m v')
-> (v -> ReflexSDL2T t m v') -> v -> ReaderT (SystemEvents t) m v'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> v -> ReflexSDL2T t m v'
f Key
ka) IntMap v
im


------------------------------------------------------------------------------
-- | 'ReflexSDL2T' is an instance of 'MonadHold'.
instance ( ReflexHost t
         , Applicative m
         , Monad m
         , MonadSample t m
         ) => MonadSample t (ReflexSDL2T t m) where
  sample :: forall a. Behavior t a -> ReflexSDL2T t m a
sample = m a -> ReflexSDL2T t m a
forall (m :: * -> *) a. Monad m => m a -> ReflexSDL2T t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReflexSDL2T t m a)
-> (Behavior t a -> m a) -> Behavior t a -> ReflexSDL2T t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior t a -> m a
forall a. Behavior t a -> m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample


------------------------------------------------------------------------------
-- | 'ReflexSDL2T' is an instance of 'MonadHold'.
instance (ReflexHost t, MonadHold t m) => MonadHold t (ReflexSDL2T t m) where
  hold :: forall a. a -> Event t a -> ReflexSDL2T t m (Behavior t a)
hold a
a = m (Behavior t a) -> ReflexSDL2T t m (Behavior t a)
forall (m :: * -> *) a. Monad m => m a -> ReflexSDL2T t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Behavior t a) -> ReflexSDL2T t m (Behavior t a))
-> (Event t a -> m (Behavior t a))
-> Event t a
-> ReflexSDL2T t m (Behavior t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Event t a -> m (Behavior t a)
forall a. a -> Event t a -> m (Behavior t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold a
a
  holdDyn :: forall a. a -> Event t a -> ReflexSDL2T t m (Dynamic t a)
holdDyn a
a = m (Dynamic t a) -> ReflexSDL2T t m (Dynamic t a)
forall (m :: * -> *) a. Monad m => m a -> ReflexSDL2T t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> ReflexSDL2T t m (Dynamic t a))
-> (Event t a -> m (Dynamic t a))
-> Event t a
-> ReflexSDL2T t m (Dynamic t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Event t a -> m (Dynamic t a)
forall a. a -> Event t a -> m (Dynamic t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn a
a
  holdIncremental :: forall p.
Patch p =>
PatchTarget p -> Event t p -> ReflexSDL2T t m (Incremental t p)
holdIncremental PatchTarget p
p = m (Incremental t p) -> ReflexSDL2T t m (Incremental t p)
forall (m :: * -> *) a. Monad m => m a -> ReflexSDL2T t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Incremental t p) -> ReflexSDL2T t m (Incremental t p))
-> (Event t p -> m (Incremental t p))
-> Event t p
-> ReflexSDL2T t m (Incremental t p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchTarget p -> Event t p -> m (Incremental t p)
forall p.
Patch p =>
PatchTarget p -> Event t p -> m (Incremental t p)
forall {k} (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental PatchTarget p
p
  buildDynamic :: forall a. PushM t a -> Event t a -> ReflexSDL2T t m (Dynamic t a)
buildDynamic PushM t a
ma = m (Dynamic t a) -> ReflexSDL2T t m (Dynamic t a)
forall (m :: * -> *) a. Monad m => m a -> ReflexSDL2T t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> ReflexSDL2T t m (Dynamic t a))
-> (Event t a -> m (Dynamic t a))
-> Event t a
-> ReflexSDL2T t m (Dynamic t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PushM t a -> Event t a -> m (Dynamic t a)
forall a. PushM t a -> Event t a -> m (Dynamic t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic PushM t a
ma
  headE :: forall a. Event t a -> ReflexSDL2T t m (Event t a)
headE = m (Event t a) -> ReflexSDL2T t m (Event t a)
forall (m :: * -> *) a. Monad m => m a -> ReflexSDL2T t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> ReflexSDL2T t m (Event t a))
-> (Event t a -> m (Event t a))
-> Event t a
-> ReflexSDL2T t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t a -> m (Event t a)
forall a. Event t a -> m (Event t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
headE