module Rasa.Internal.Listeners
( Listener
, Listeners
, onEveryTrigger
, onEveryTrigger_
, onNextEvent
, onInit
, beforeEveryEvent
, beforeEveryEvent_
, beforeNextEvent
, beforeEveryRender
, beforeEveryRender_
, beforeNextRender
, onEveryRender
, onEveryRender_
, onNextRender
, afterEveryRender
, afterEveryRender_
, afterNextRender
, dispatchEvent
, onExit
, removeListener
, matchingListeners
, onBufAdded
, onBufTextChanged
) where
import Rasa.Internal.Action
import Rasa.Internal.Events
import Rasa.Internal.Editor
import Rasa.Internal.Range
import Control.Lens
import Control.Monad
import Data.Dynamic
import Data.Foldable
import Data.Map hiding (filter)
import Unsafe.Coerce
import qualified Yi.Rope as Y
dispatchEvent :: Typeable a => a -> Action ()
dispatchEvent evt = do
listeners' <- use listeners
traverse_ ($ evt) (matchingListeners listeners')
getListener :: forall a. Listener -> (a -> Action ())
getListener = coerce
where
coerce :: Listener -> (a -> Action ())
coerce (Listener _ x) = unsafeCoerce x
makeListener :: forall a b. Typeable a => (a -> Action b) -> Action (ListenerId, Listener)
makeListener listenerFunc = do
n <- nextListenerId <<+= 1
let listenerId = ListenerId n (typeRep (Proxy :: Proxy a))
listenerFunc' = void . listenerFunc
return (listenerId, Listener listenerId listenerFunc')
extendListener :: Listener -> Action () -> Listener
extendListener (Listener listenerId listenerFunc) act = Listener listenerId (\a -> listenerFunc a >> act)
matchingListeners :: forall a. Typeable a => Listeners -> [a -> Action ()]
matchingListeners listeners' = getListener <$> (listeners'^.at (typeRep (Proxy :: Proxy a))._Just)
onEveryTrigger :: forall a b. Typeable a => (a -> Action b) -> Action ListenerId
onEveryTrigger listenerFunc = do
(listenerId, listener) <- makeListener listenerFunc
listeners %= insertWith mappend (typeRep (Proxy :: Proxy a)) [listener]
return listenerId
onEveryTrigger_ :: forall a b. Typeable a => (a -> Action b) -> Action ()
onEveryTrigger_ = void . onEveryTrigger
onNextEvent :: forall a b. Typeable a => (a -> Action b) -> Action ()
onNextEvent listenerFunc = do
(listenerId, listener) <- makeListener listenerFunc
let selfCancellingListener = extendListener listener (removeListener listenerId)
listeners %= insertWith mappend (typeRep (Proxy :: Proxy a)) [selfCancellingListener]
removeListener :: ListenerId -> Action ()
removeListener hkIdA@(ListenerId _ typ) =
listeners.at typ._Just %= filter listenerMatches
where
listenerMatches (Listener hkIdB _) = hkIdA /= hkIdB
onInit :: forall a. Action a -> Action ()
onInit action = onNextEvent (const action :: Init -> Action a)
beforeEveryEvent :: forall a. Action a -> Action ListenerId
beforeEveryEvent action = onEveryTrigger (const action :: BeforeEvent -> Action a)
beforeEveryEvent_ :: forall a. Action a -> Action ()
beforeEveryEvent_ = void . beforeEveryEvent
beforeNextEvent :: forall a. Action a -> Action ()
beforeNextEvent action = onNextEvent (const action :: BeforeEvent -> Action a)
beforeEveryRender :: forall a. Action a -> Action ListenerId
beforeEveryRender action = onEveryTrigger (const action :: BeforeRender -> Action a)
beforeEveryRender_ :: forall a. Action a -> Action ()
beforeEveryRender_ = void . beforeEveryRender
beforeNextRender :: forall a. Action a -> Action ()
beforeNextRender action = onNextEvent (const action :: BeforeRender -> Action a)
onEveryRender :: forall a. Action a -> Action ListenerId
onEveryRender action = onEveryTrigger (const action :: OnRender -> Action a)
onEveryRender_ :: forall a. Action a -> Action ()
onEveryRender_ = void . onEveryRender
onNextRender :: forall a. Action a -> Action ()
onNextRender action = onNextEvent (const action :: OnRender -> Action a)
afterEveryRender :: forall a. Action a -> Action ListenerId
afterEveryRender action = onEveryTrigger (const action :: AfterRender -> Action a)
afterEveryRender_ :: forall a. Action a -> Action ()
afterEveryRender_ = void . afterEveryRender
afterNextRender :: forall a. Action a -> Action ()
afterNextRender action = onNextEvent (const action :: AfterRender -> Action a)
onExit :: forall a. Action a -> Action ()
onExit action = onNextEvent (const action :: Exit -> Action a)
onBufAdded :: forall a. (BufRef -> Action a) -> Action ListenerId
onBufAdded f = onEveryTrigger listener
where
listener (BufAdded bRef) = f bRef
onBufTextChanged :: forall a. (CrdRange -> Y.YiString -> Action a) -> Action ListenerId
onBufTextChanged f = onEveryTrigger listener
where
listener (BufTextChanged r newText) = f r newText