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
dispatchEvent :: Typeable a => a -> Action ()
dispatchEvent evt = do
hooks' <- use hooks
traverse_ ($ evt) (matchingHooks hooks')
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)
matchingHooks :: forall a. Typeable a => Hooks -> [a -> Action ()]
matchingHooks hooks' = getHook <$> (hooks'^.at (typeRep (Proxy :: Proxy a))._Just)
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
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]
removeListener :: HookId -> Action ()
removeListener hkIdA@(HookId _ typ) =
hooks.at typ._Just %= filter hookMatches
where
hookMatches (Hook hkIdB _) = hkIdA /= hkIdB
onInit :: Action () -> Action ()
onInit action = void $ onEveryTrigger (const action :: Init -> Action ())
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 ())
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 ())
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 ())
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 ())
onExit :: Action () -> Action ()
onExit action = void $ onEveryTrigger (const action :: Exit -> Action ())
onBufAdded :: (BufRef -> Action ()) -> Action HookId
onBufAdded f = onEveryTrigger listener
where
listener (BufAdded bRef) = f bRef