{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
-- | This module contains the bare minimum needed to get started writing
-- reflex apps using sdl2.
--
-- For a tutorial see
-- [app/Main.hs](https://github.com/reflex-frp/reflex-sdl2/blob/master/app/Main.hs)
module Reflex.SDL2
  ( -- * All SDL events, packaged into reflex events
    SystemEvents(..)
    -- * Running an app
  , host
    -- * Debugging
  , putDebugLnE
    -- * Convenience constraints
  , ReflexSDL2
    -- * Re-exports
  , module Reflex
  , module SDL
  , MonadReader
  , asks
  , MonadIO
  , liftIO
  ) where

import           Control.Monad.Fix      (MonadFix)
import           Control.Monad.Identity (Identity (..))
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Control.Monad.Reader   (MonadReader, ReaderT (..), asks,
                                         runReaderT)
import           Control.Monad.Ref
import           Data.Dependent.Sum     (DSum ((:=>)))
import           Data.Function          (fix)
import           Data.Word              (Word32)
import           Reflex                 hiding (Additive)
import           Reflex.Host.Class
import           SDL                    hiding (Event)

------------------------------------------------------------------------------
-- | Holds a slot of 'Event' for each kind of SDL2 event plus a couple extras:
--
-- An event for *any* SDL2 event payload.
--
-- An event for reflex's post network build event.
--
-- An event for each frame tick.
data SystemEvents t = SystemEvents
  { sysPostBuildEvent                 :: Event t ()
  -- ^ Fired just after the FRP network is built.
  , sysTicksEvent                     :: Event t Word32
  -- ^ Fired once per frame tick, contains the number of
  -- milliseconds since SDL library initialization.
  , sysAnySDLEvent                    :: Event t EventPayload
  -- ^ Fired when SDL receives any event.
  , sysWindowShownEvent               :: Event t WindowShownEventData
  , sysWindowHiddenEvent              :: Event t WindowHiddenEventData
  , sysWindowExposedEvent             :: Event t WindowExposedEventData
  , sysWindowMovedEvent               :: Event t WindowMovedEventData
  , sysWindowResizedEvent             :: Event t WindowResizedEventData
  , sysWindowSizeChangedEvent         :: Event t WindowSizeChangedEventData
  , sysWindowMinimizedEvent           :: Event t WindowMinimizedEventData
  , sysWindowMaximizedEvent           :: Event t WindowMaximizedEventData
  , sysWindowRestoredEvent            :: Event t WindowRestoredEventData
  , sysWindowGainedMouseFocusEvent    :: Event t WindowGainedMouseFocusEventData
  , sysWindowLostMouseFocusEvent      :: Event t WindowLostMouseFocusEventData
  , sysWindowGainedKeyboardFocusEvent :: Event t WindowGainedKeyboardFocusEventData
  , sysWindowLostKeyboardFocusEvent   :: Event t WindowLostKeyboardFocusEventData
  , sysWindowClosedEvent              :: Event t WindowClosedEventData
  , sysKeyboardEvent                  :: Event t KeyboardEventData
  , sysTextEditingEvent               :: Event t TextEditingEventData
  , sysTextInputEvent                 :: Event t TextInputEventData
  , sysKeymapChangedEvent             :: Event t ()
  , sysMouseMotionEvent               :: Event t MouseMotionEventData
  , sysMouseButtonEvent               :: Event t MouseButtonEventData
  , sysMouseWheelEvent                :: Event t MouseWheelEventData
  , sysJoyAxisEvent                   :: Event t JoyAxisEventData
  , sysJoyBallEvent                   :: Event t JoyBallEventData
  , sysJoyHatEvent                    :: Event t JoyHatEventData
  , sysJoyButtonEvent                 :: Event t JoyButtonEventData
  , sysJoyDeviceEvent                 :: Event t JoyDeviceEventData
  , sysControllerAxisEvent            :: Event t ControllerAxisEventData
  , sysControllerButtonEvent          :: Event t ControllerButtonEventData
  , sysControllerDeviceEvent          :: Event t ControllerDeviceEventData
  , sysAudioDeviceEvent               :: Event t AudioDeviceEventData
  , sysQuitEvent                      :: Event t ()
  , sysUserEvent                      :: Event t UserEventData
  , sysSysWMEvent                     :: Event t SysWMEventData
  , sysTouchFingerEvent               :: Event t TouchFingerEventData
  , sysMultiGestureEvent              :: Event t MultiGestureEventData
  , sysDollarGestureEvent             :: Event t DollarGestureEventData
  , sysDropEvent                      :: Event t DropEventData
  , sysClipboardUpdateEvent           :: Event t ()
  , sysUnknownEvent                   :: Event t UnknownEventData
  }


------------------------------------------------------------------------------
-- | Host a reflex-sdl2 app.
host
  :: ReaderT (SystemEvents Spider) (PerformEventT Spider (SpiderHost Global)) a
  -- ^ A concrete reflex-sdl2 network to run.
  -> IO ()
host app = runSpiderHost $ do
  -- Get events and trigger refs for all things that can happen.
  (evPostBuild,                                      trPostBuildRef) <- newEventWithTriggerRef
  (evAnySDL,                                            trAnySDLRef) <- newEventWithTriggerRef
  (evTicks,                                              trTicksRef) <- newEventWithTriggerRef
  (evWindowShownEvent,                             trWindowShownRef) <- newEventWithTriggerRef
  (evWindowHiddenEvent,                           trWindowHiddenRef) <- newEventWithTriggerRef
  (evWindowExposedEvent,                         trWindowExposedRef) <- newEventWithTriggerRef
  (evWindowMovedEvent,                             trWindowMovedRef) <- newEventWithTriggerRef
  (evWindowResizedEvent,                         trWindowResizedRef) <- newEventWithTriggerRef
  (evWindowSizeChangedEvent,                 trWindowSizeChangedRef) <- newEventWithTriggerRef
  (evWindowMinimizedEvent,                     trWindowMinimizedRef) <- newEventWithTriggerRef
  (evWindowMaximizedEvent,                     trWindowMaximizedRef) <- newEventWithTriggerRef
  (evWindowRestoredEvent,                       trWindowRestoredRef) <- newEventWithTriggerRef
  (evWindowGainedMouseFocusEvent,       trWindowGainedMouseFocusRef) <- newEventWithTriggerRef
  (evWindowLostMouseFocusEvent,           trWindowLostMouseFocusRef) <- newEventWithTriggerRef
  (evWindowGainedKeyboardFocusEvent, trWindowGainedKeyboardFocusRef) <- newEventWithTriggerRef
  (evWindowLostKeyboardFocusEvent,     trWindowLostKeyboardFocusRef) <- newEventWithTriggerRef
  (evWindowClosedEvent,                           trWindowClosedRef) <- newEventWithTriggerRef
  (evKeyboardEvent,                                   trKeyboardRef) <- newEventWithTriggerRef
  (evTextEditingEvent,                             trTextEditingRef) <- newEventWithTriggerRef
  (evTextInputEvent,                                 trTextInputRef) <- newEventWithTriggerRef
  (evKeymapChangedEvent,                         trKeymapChangedRef) <- newEventWithTriggerRef
  (evMouseMotionEvent,                             trMouseMotionRef) <- newEventWithTriggerRef
  (evMouseButtonEvent,                             trMouseButtonRef) <- newEventWithTriggerRef
  (evMouseWheelEvent,                               trMouseWheelRef) <- newEventWithTriggerRef
  (evJoyAxisEvent,                                     trJoyAxisRef) <- newEventWithTriggerRef
  (evJoyBallEvent,                                     trJoyBallRef) <- newEventWithTriggerRef
  (evJoyHatEvent,                                       trJoyHatRef) <- newEventWithTriggerRef
  (evJoyButtonEvent,                                 trJoyButtonRef) <- newEventWithTriggerRef
  (evJoyDeviceEvent,                                 trJoyDeviceRef) <- newEventWithTriggerRef
  (evControllerAxisEvent,                       trControllerAxisRef) <- newEventWithTriggerRef
  (evControllerButtonEvent,                   trControllerButtonRef) <- newEventWithTriggerRef
  (evControllerDeviceEvent,                   trControllerDeviceRef) <- newEventWithTriggerRef
  (evAudioDeviceEvent,                             trAudioDeviceRef) <- newEventWithTriggerRef
  (evQuitEvent,                                           trQuitRef) <- newEventWithTriggerRef
  (evUserEvent,                                           trUserRef) <- newEventWithTriggerRef
  (evSysWMEvent,                                         trSysWMRef) <- newEventWithTriggerRef
  (evTouchFingerEvent,                             trTouchFingerRef) <- newEventWithTriggerRef
  (evMultiGestureEvent,                           trMultiGestureRef) <- newEventWithTriggerRef
  (evDollarGestureEvent,                         trDollarGestureRef) <- newEventWithTriggerRef
  (evDropEvent,                                           trDropRef) <- newEventWithTriggerRef
  (evClipboardUpdateEvent,                     trClipboardUpdateRef) <- newEventWithTriggerRef
  (evUnknownEvent,                                     trUnknownRef) <- newEventWithTriggerRef

  -- Build the network and get our firing command to trigger the post build event.
  (_, FireCommand fire) <-
    hostPerformEventT $ runReaderT app
      SystemEvents{ sysPostBuildEvent                 = evPostBuild
                  , sysAnySDLEvent                    = evAnySDL
                  , sysTicksEvent                     = evTicks
                  , sysWindowShownEvent               = evWindowShownEvent
                  , sysWindowHiddenEvent              = evWindowHiddenEvent
                  , sysWindowExposedEvent             = evWindowExposedEvent
                  , sysWindowMovedEvent               = evWindowMovedEvent
                  , sysWindowResizedEvent             = evWindowResizedEvent
                  , sysWindowSizeChangedEvent         = evWindowSizeChangedEvent
                  , sysWindowMinimizedEvent           = evWindowMinimizedEvent
                  , sysWindowMaximizedEvent           = evWindowMaximizedEvent
                  , sysWindowRestoredEvent            = evWindowRestoredEvent
                  , sysWindowGainedMouseFocusEvent    = evWindowGainedMouseFocusEvent
                  , sysWindowLostMouseFocusEvent      = evWindowLostMouseFocusEvent
                  , sysWindowGainedKeyboardFocusEvent = evWindowGainedKeyboardFocusEvent
                  , sysWindowLostKeyboardFocusEvent   = evWindowLostKeyboardFocusEvent
                  , sysWindowClosedEvent              = evWindowClosedEvent
                  , sysKeyboardEvent                  = evKeyboardEvent
                  , sysTextEditingEvent               = evTextEditingEvent
                  , sysTextInputEvent                 = evTextInputEvent
                  , sysKeymapChangedEvent             = evKeymapChangedEvent
                  , sysMouseMotionEvent               = evMouseMotionEvent
                  , sysMouseButtonEvent               = evMouseButtonEvent
                  , sysMouseWheelEvent                = evMouseWheelEvent
                  , sysJoyAxisEvent                   = evJoyAxisEvent
                  , sysJoyBallEvent                   = evJoyBallEvent
                  , sysJoyHatEvent                    = evJoyHatEvent
                  , sysJoyButtonEvent                 = evJoyButtonEvent
                  , sysJoyDeviceEvent                 = evJoyDeviceEvent
                  , sysControllerAxisEvent            = evControllerAxisEvent
                  , sysControllerButtonEvent          = evControllerButtonEvent
                  , sysControllerDeviceEvent          = evControllerDeviceEvent
                  , sysAudioDeviceEvent               = evAudioDeviceEvent
                  , sysQuitEvent                      = evQuitEvent
                  , sysUserEvent                      = evUserEvent
                  , sysSysWMEvent                     = evSysWMEvent
                  , sysTouchFingerEvent               = evTouchFingerEvent
                  , sysMultiGestureEvent              = evMultiGestureEvent
                  , sysDollarGestureEvent             = evDollarGestureEvent
                  , sysDropEvent                      = evDropEvent
                  , sysClipboardUpdateEvent           = evClipboardUpdateEvent
                  , sysUnknownEvent                   = evUnknownEvent
                  }

  -- Trigger the post build event.
  (readRef trPostBuildRef >>=) . mapM_ $ \tr ->
    fire [tr :=> Identity ()] $ return ()

  ---- Loop forever getting sdl2 events and triggering them.
  fix $ \loop -> do
    payload <- eventPayload <$> waitEvent
    case payload of
      WindowShownEvent dat -> (readRef trWindowShownRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowHiddenEvent dat -> (readRef trWindowHiddenRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowExposedEvent dat -> (readRef trWindowExposedRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowMovedEvent dat -> (readRef trWindowMovedRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowResizedEvent dat -> (readRef trWindowResizedRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowSizeChangedEvent dat -> (readRef trWindowSizeChangedRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowMinimizedEvent dat -> (readRef trWindowMinimizedRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowMaximizedEvent dat -> (readRef trWindowMaximizedRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowRestoredEvent dat -> (readRef trWindowRestoredRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowGainedMouseFocusEvent dat -> (readRef trWindowGainedMouseFocusRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowLostMouseFocusEvent dat -> (readRef trWindowLostMouseFocusRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowGainedKeyboardFocusEvent dat -> (readRef trWindowGainedKeyboardFocusRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowLostKeyboardFocusEvent dat -> (readRef trWindowLostKeyboardFocusRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      WindowClosedEvent dat -> (readRef trWindowClosedRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      KeyboardEvent dat -> (readRef trKeyboardRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      TextEditingEvent dat -> (readRef trTextEditingRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      TextInputEvent dat -> (readRef trTextInputRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      KeymapChangedEvent -> (readRef trKeymapChangedRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity ()] $ return ()
      MouseMotionEvent dat -> (readRef trMouseMotionRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      MouseButtonEvent dat -> (readRef trMouseButtonRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      MouseWheelEvent dat -> (readRef trMouseWheelRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      JoyAxisEvent dat -> (readRef trJoyAxisRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      JoyBallEvent dat -> (readRef trJoyBallRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      JoyHatEvent dat -> (readRef trJoyHatRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      JoyButtonEvent dat -> (readRef trJoyButtonRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      JoyDeviceEvent dat -> (readRef trJoyDeviceRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      ControllerAxisEvent dat -> (readRef trControllerAxisRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      ControllerButtonEvent dat -> (readRef trControllerButtonRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      ControllerDeviceEvent dat -> (readRef trControllerDeviceRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      AudioDeviceEvent dat -> (readRef trAudioDeviceRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      QuitEvent -> (readRef trQuitRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity ()] $ return ()
      UserEvent dat -> (readRef trUserRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      SysWMEvent dat -> (readRef trSysWMRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      TouchFingerEvent dat -> (readRef trTouchFingerRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      MultiGestureEvent dat -> (readRef trMultiGestureRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      DollarGestureEvent dat -> (readRef trDollarGestureRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      DropEvent dat -> (readRef trDropRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()
      ClipboardUpdateEvent -> (readRef trClipboardUpdateRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity ()] $ return ()
      UnknownEvent dat -> (readRef trUnknownRef >>=) . mapM_ $ \tr ->
        fire [tr :=> Identity dat] $ return ()

    -- Fire an event for the wrapped payload as well.
    (readRef trAnySDLRef >>=) . mapM_ $ \tr ->
      fire [tr :=> Identity payload] $ return ()
    -- Fire any tick events, if anyone is listening.
    (readRef trTicksRef >>=) . mapM_ $ \tr -> ticks >>= \t ->
      fire [tr :=> Identity t] $ return ()

    loop


------------------------------------------------------------------------------
-- | Like 'putStrLn', but for 'Event's.
putDebugLnE
  :: (PerformEvent t m, Reflex t, MonadIO (Performable m))
  => Event t a
  -- ^ The 'Event' to trigger the print.
  -> (a -> String)
  -- ^ A function to show the 'Event's value.
  -> m ()
putDebugLnE ev showf = performEvent_ $ liftIO . putStrLn . showf <$> ev


------------------------------------------------------------------------------
-- | A collection of constraints that represent a reflex-sdl2 network.
type ReflexSDL2 t m =
  ( Reflex t
  , MonadHold t m
  , PerformEvent t m
  , MonadFix m
  , MonadIO m
  , MonadIO (Performable m)
  , MonadReader (SystemEvents t) m
  )