Scheduler.hs

{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-}

module Rasa.Internal.Scheduler
  ( Hook
  , Hooks
  , onEveryTrigger
  , onEveryTrigger_
  , onNextEvent
  , onInit
  , beforeEveryEvent
  , beforeEveryEvent_
  , beforeNextEvent
  , beforeEveryRender
  , beforeEveryRender_
  , beforeNextRender
  , onEveryRender
  , onEveryRender_
  , onNextRender
  , afterEveryRender
  , afterEveryRender_
  , afterNextRender
  , dispatchEvent
  , onExit
  , removeListener
  , matchingHooks
  , onBufAdded
  ) where


import Rasa.Internal.Action
import Rasa.Internal.Events
import Rasa.Internal.Editor

import Control.Lens
import Control.Monad
import Data.Dynamic
import Data.Foldable
import Data.Map hiding (filter)
import Unsafe.Coerce

-- | Use this to dispatch an event of any type, any hooks which are listening for this event will be triggered
-- with the provided event. Use this within an Action.
dispatchEvent :: Typeable a => a -> Action ()
dispatchEvent evt = do
  hooks' <- use hooks
  traverse_ ($ evt) (matchingHooks hooks')

-- | This is a helper which extracts and coerces a hook from its wrapper back into the proper event handler type.
getHook :: forall a. Hook -> (a -> Action ())
getHook = coerce
  where
    coerce :: Hook -> (a -> Action ())
    coerce (Hook _ x) = unsafeCoerce x

makeHook :: forall a. Typeable a => (a -> Action ()) -> Action (HookId, Hook)
makeHook hookFunc = do
  n <- nextHook <<+= 1
  let hookId = HookId n (typeRep (Proxy :: Proxy a))
  return (hookId, Hook hookId hookFunc)

extendHook :: Hook -> Action () -> Hook
extendHook (Hook hookId hookFunc) act = Hook hookId (\a -> hookFunc a >> act)

-- | This extracts all event listener hooks from a map of hooks which match the type of the provided event.
matchingHooks :: forall a. Typeable a => Hooks -> [a -> Action ()]
matchingHooks hooks' = getHook <$> (hooks'^.at (typeRep (Proxy :: Proxy a))._Just)

-- | This registers an event listener hook, as long as the listener is well-typed similar to this:
--
-- @MyEventType -> Action ()@ then it will be triggered on all dispatched events of that type.
-- It returns an ID which may be used with 'removeListener' to cancel the listener
onEveryTrigger :: forall a. Typeable a => (a -> Action ()) -> Action HookId
onEveryTrigger hookFunc = do
  (hookId, hook) <- makeHook hookFunc
  hooks %= insertWith mappend (typeRep (Proxy :: Proxy a)) [hook]
  return hookId

onEveryTrigger_ :: forall a. Typeable a => (a -> Action ()) -> Action ()
onEveryTrigger_ = void . onEveryTrigger


-- | This acts as 'onEveryTrigger' but listens only for the first event of a given type.
onNextEvent :: forall a. Typeable a => (a -> Action ()) -> Action ()
onNextEvent hookFunc = do
  (hookId, hook) <- makeHook hookFunc
  let selfCancellingHook = extendHook hook (removeListener hookId)
  hooks %= insertWith mappend (typeRep (Proxy :: Proxy a)) [selfCancellingHook]

-- | This removes a listener and prevents it from responding to any more events.
removeListener :: HookId -> Action ()
removeListener hkIdA@(HookId _ typ) =
  hooks.at typ._Just %= filter hookMatches
    where
      hookMatches (Hook hkIdB _) = hkIdA /= hkIdB

-- | Registers an action to be performed during the Initialization phase.
--
-- This phase occurs exactly ONCE when the editor starts up.
-- Though arbitrary actions may be performed in the configuration block;
-- it's recommended to embed such actions in the onInit event listener
-- so that all event listeners are registered before anything Actions occur.
onInit :: Action () -> Action ()
onInit action = void $ onEveryTrigger (const action :: Init -> Action ())

-- | Registers an action to be performed BEFORE each event phase.
beforeEveryEvent :: Action () -> Action HookId
beforeEveryEvent action = onEveryTrigger (const action :: BeforeEvent -> Action ())

beforeEveryEvent_ :: Action () -> Action ()
beforeEveryEvent_ = void . beforeEveryEvent

beforeNextEvent :: Action () -> Action ()
beforeNextEvent action = onNextEvent (const action :: BeforeEvent -> Action ())

-- | Registers an action to be performed BEFORE each render phase.
--
-- This is a good spot to add information useful to the renderer
-- since all actions have been performed. Only cosmetic changes should
-- occur during this phase.
beforeEveryRender :: Action () -> Action HookId
beforeEveryRender action = onEveryTrigger (const action :: BeforeRender -> Action ())

beforeEveryRender_ :: Action () -> Action ()
beforeEveryRender_ = void . beforeEveryRender

beforeNextRender :: Action () -> Action ()
beforeNextRender action = onNextEvent (const action :: BeforeRender -> Action ())

-- | Registers an action to be performed during each render phase.
--
-- This phase should only be used by extensions which actually render something.
onEveryRender :: Action () -> Action HookId
onEveryRender action = onEveryTrigger (const action :: OnRender -> Action ())

onEveryRender_ :: Action () -> Action ()
onEveryRender_ = void . onEveryRender

onNextRender :: Action () -> Action ()
onNextRender action = onNextEvent (const action :: OnRender -> Action ())

-- | Registers an action to be performed AFTER each render phase.
--
-- This is useful for cleaning up extension state that was registered for the
-- renderer, but needs to be cleared before the next iteration.
afterEveryRender :: Action () -> Action HookId
afterEveryRender action = onEveryTrigger (const action :: AfterRender -> Action ())

afterEveryRender_ :: Action () -> Action ()
afterEveryRender_ = void . afterEveryRender

afterNextRender :: Action () -> Action ()
afterNextRender action = onNextEvent (const action :: AfterRender -> Action ())

-- | Registers an action to be performed during the exit phase.
--
-- This is only triggered exactly once when the editor is shutting down. It
-- allows an opportunity to do clean-up, kill any processes you've started, or
-- save any data before the editor terminates.

onExit :: Action () -> Action ()
onExit action = void $ onEveryTrigger (const action :: Exit -> Action ())

-- | Registers an action to be performed after a new buffer is added.
--
-- The supplied function will be called with a 'BufRef' to the new buffer, and the resulting 'Action' will be run.
onBufAdded :: (BufRef -> Action ()) -> Action HookId
onBufAdded f = onEveryTrigger listener
  where
    listener (BufAdded bRef) = f bRef