content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE NumericUnderscores #-}
  {-# LANGUAGE QualifiedDo #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# OPTIONS_GHC -Wall #-}
  
  module Handler where
  
  import Control.Concurrent.STM (atomically)
  import Control.Concurrent.STM.TChan
  import Control.Monad.State
  import Data.IFunctor (At (..), returnAt)
  import qualified Data.IFunctor as I
  import GHC.Event
  import Lens.Micro.Mtl
  import SDL
  import Type
  import TypedFsm.Core
  import TypedFsm
  
  timeoutSize :: Int
  timeoutSize = 400_000
  
  myRegisterTimeout :: StateT MotionState IO (TimerManager, TimeoutKey)
  myRegisterTimeout = do
    chan <- use channel
    liftIO $ do
      tm <- getSystemTimerManager
      tk <- registerTimeout tm timeoutSize (atomically $ writeTChan chan ())
      pure (tm, tk)
  
  idelHandler :: Op Motion MotionState IO () Exit Idle
  idelHandler = I.do
    msg <- getInput
    case msg of
      ExitMotion -> returnAt ()
      MoveIn pos tms -> I.do
        At tp <- liftm $ do
          mousePos .= pos
          (tm, tk) <- myRegisterTimeout
          pure (tm, tk, tms)
        overHandler tp
  
  overHandler :: (TimerManager, TimeoutKey, Timestamp) -> Op Motion MotionState IO () Exit Over
  overHandler (tm, tk, oldtms) = I.do
    msg <- getInput
    case msg of
      ExitMotion -> returnAt ()
      MoveOut -> I.do
        liftm $ liftIO $ unregisterTimeout tm tk
        idelHandler
      InMove pos tms -> I.do
        liftm $ do
          mousePos .= pos
        if tms - oldtms > 40
          then I.do
            liftm $ liftIO $ updateTimeout tm tk timeoutSize
            overHandler (tm, tk, tms)
          else overHandler (tm, tk, oldtms)
      TimeoutH -> I.do
        liftm $ do
          liftIO $ unregisterTimeout tm tk
          pos <- use mousePos
          onHover .= Just (pos, [show oldtms, show pos])
        hoverHandler
  
  hoverHandler :: Op Motion MotionState IO () Exit Hover
  hoverHandler = I.do
    msg <- getInput
    case msg of
      ExitMotion -> returnAt ()
      HInMove pos tms -> I.do
        At tp <- liftm $ do
          mousePos .= pos
          onHover .= Nothing
          (tm, tk) <- myRegisterTimeout
          pure (tm, tk, tms)
        overHandler tp
      HMoveOut -> I.do
        liftm $ onHover .= Nothing
        idelHandler
  