{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Observe.Event.Explicit
( Event,
hoistEvent,
addField,
reference,
addParent,
addProximate,
addReference,
Reference (..),
ReferenceType (..),
allocateEvent,
withEvent,
withSubEvent,
EventBackend,
subEventBackend,
causedEventBackend,
hoistEventBackend,
narrowEventBackend,
InjectSelector,
injectSelector,
idInjectSelector,
setDefaultReferenceEventBackend,
setAncestorEventBackend,
setInitialCauseEventBackend,
setReferenceEventBackend,
setParentEventBackend,
setProximateEventBackend,
unitEventBackend,
pairEventBackend,
noopEventBackend,
finalize,
newEvent,
newSubEvent,
)
where
import Control.Monad.Primitive
import Control.Monad.With
import Data.Exceptable
import Data.GeneralAllocate
import Observe.Event.Backend
addParent ::
Event m r f ->
r ->
m ()
addParent :: forall (m :: * -> *) r f. Event m r f -> r -> m ()
addParent Event m r f
ev = forall (m :: * -> *) r f. Event m r f -> Reference r -> m ()
addReference Event m r f
ev forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. ReferenceType -> r -> Reference r
Reference ReferenceType
Parent
addProximate ::
Event m r f ->
r ->
m ()
addProximate :: forall (m :: * -> *) r f. Event m r f -> r -> m ()
addProximate Event m r f
ev = forall (m :: * -> *) r f. Event m r f -> Reference r -> m ()
addReference Event m r f
ev forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. ReferenceType -> r -> Reference r
Reference ReferenceType
Proximate
allocateEvent ::
(Monad m, Exceptable e) =>
EventBackend m r s ->
forall f.
s f ->
GeneralAllocate m e () releaseArg (Event m r f)
allocateEvent :: forall (m :: * -> *) e r (s :: * -> *) releaseArg.
(Monad m, Exceptable e) =>
EventBackend m r s
-> forall f. s f -> GeneralAllocate m e () releaseArg (Event m r f)
allocateEvent EventBackend m r s
backend s f
sel = forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate forall a b. (a -> b) -> a -> b
$ \forall x. m x -> m x
restore -> do
Event m r f
ev <- forall x. m x -> m x
restore forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r (s :: * -> *).
EventBackend m r s -> forall f. s f -> m (Event m r f)
newEvent EventBackend m r s
backend s f
sel
let release :: GeneralReleaseType e a -> m ()
release (ReleaseFailure e
e) = forall (m :: * -> *) r f.
Event m r f -> Maybe SomeException -> m ()
finalize Event m r f
ev forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall e. Exceptable e => e -> SomeException
toSomeException e
e
release (ReleaseSuccess a
_) = forall (m :: * -> *) r f.
Event m r f -> Maybe SomeException -> m ()
finalize Event m r f
ev forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated Event m r f
ev forall {e} {a}. Exceptable e => GeneralReleaseType e a -> m ()
release
newSubEvent ::
(Monad m) =>
EventBackend m r s ->
Event m r f ->
forall f'.
s f' ->
m (Event m r f')
newSubEvent :: forall (m :: * -> *) r (s :: * -> *) f.
Monad m =>
EventBackend m r s
-> Event m r f -> forall f'. s f' -> m (Event m r f')
newSubEvent EventBackend m r s
backend Event m r f
ev s f'
sel = do
Event m r f'
child <- forall (m :: * -> *) r (s :: * -> *).
EventBackend m r s -> forall f. s f -> m (Event m r f)
newEvent EventBackend m r s
backend s f'
sel
forall (m :: * -> *) r f. Event m r f -> r -> m ()
addParent Event m r f'
child forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r f. Event m r f -> r
reference Event m r f
ev
forall (f :: * -> *) a. Applicative f => a -> f a
pure Event m r f'
child
withEvent ::
(MonadWithExceptable m) =>
EventBackend m r s ->
forall f.
s f ->
(Event m r f -> m a) ->
m a
withEvent :: forall (m :: * -> *) r (s :: * -> *) a.
MonadWithExceptable m =>
EventBackend m r s -> forall f. s f -> (Event m r f -> m a) -> m a
withEvent EventBackend m r s
backend = forall (m :: * -> *) b a.
MonadWith m =>
With m b a -> (a -> m b) -> m b
generalWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e r (s :: * -> *) releaseArg.
(Monad m, Exceptable e) =>
EventBackend m r s
-> forall f. s f -> GeneralAllocate m e () releaseArg (Event m r f)
allocateEvent EventBackend m r s
backend
withSubEvent ::
(MonadWithExceptable m) =>
EventBackend m r s ->
Event m r f ->
forall f'.
s f' ->
(Event m r f' -> m a) ->
m a
withSubEvent :: forall (m :: * -> *) r (s :: * -> *) f a.
MonadWithExceptable m =>
EventBackend m r s
-> Event m r f -> forall f'. s f' -> (Event m r f' -> m a) -> m a
withSubEvent EventBackend m r s
backend Event m r f
ev s f'
sel Event m r f' -> m a
go = forall (m :: * -> *) r (s :: * -> *) a.
MonadWithExceptable m =>
EventBackend m r s -> forall f. s f -> (Event m r f -> m a) -> m a
withEvent EventBackend m r s
backend s f'
sel forall a b. (a -> b) -> a -> b
$ \Event m r f'
child -> do
forall (m :: * -> *) r f. Event m r f -> r -> m ()
addParent Event m r f'
child forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r f. Event m r f -> r
reference Event m r f
ev
Event m r f' -> m a
go Event m r f'
child
subEventBackend ::
(PrimMonad m) =>
InjectSelector s t ->
Event m r f ->
EventBackend m r t ->
EventBackend m r s
subEventBackend :: forall (m :: * -> *) (s :: * -> *) (t :: * -> *) r f.
PrimMonad m =>
InjectSelector s t
-> Event m r f -> EventBackend m r t -> EventBackend m r s
subEventBackend InjectSelector s t
inj Event m r f
ev =
forall (m :: * -> *) (s :: * -> *) (t :: * -> *) r.
Functor m =>
InjectSelector s t -> EventBackend m r t -> EventBackend m r s
narrowEventBackend InjectSelector s t
inj
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r (s :: * -> *).
PrimMonad m =>
r -> EventBackend m r s -> EventBackend m r s
setAncestorEventBackend (forall (m :: * -> *) r f. Event m r f -> r
reference Event m r f
ev)
causedEventBackend ::
(PrimMonad m) =>
InjectSelector s t ->
Event m r f ->
EventBackend m r t ->
EventBackend m r s
causedEventBackend :: forall (m :: * -> *) (s :: * -> *) (t :: * -> *) r f.
PrimMonad m =>
InjectSelector s t
-> Event m r f -> EventBackend m r t -> EventBackend m r s
causedEventBackend InjectSelector s t
inj Event m r f
ev =
forall (m :: * -> *) (s :: * -> *) (t :: * -> *) r.
Functor m =>
InjectSelector s t -> EventBackend m r t -> EventBackend m r s
narrowEventBackend InjectSelector s t
inj
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r (s :: * -> *).
PrimMonad m =>
r -> EventBackend m r s -> EventBackend m r s
setInitialCauseEventBackend (forall (m :: * -> *) r f. Event m r f -> r
reference Event m r f
ev)