{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Description : Instrumentation with explicit 'EventBackend' passing
-- Copyright   : Copyright 2022 Shea Levy.
-- License     : Apache-2.0
-- Maintainer  : shea@shealevy.com
--
-- t'Observe.Event.MonadEvent' and 'Observe.Event.EventT'-based instrumentation
-- implicitly track the underlying 'EventBackend' for you. This module is for those
-- who would rather pass around 'EventBackend's explicitly.
module Observe.Event.Explicit
  ( Event,
    hoistEvent,

    -- * Event manipulation #eventmanip#
    addField,
    reference,
    addParent,
    addProximate,
    addReference,
    Reference (..),
    ReferenceType (..),

    -- * Resource-safe event allocation #resourcesafe#
    allocateEvent,
    withEvent,
    withSubEvent,

    -- * 'EventBackend's
    EventBackend,

    -- ** Backend transformation
    subEventBackend,
    causedEventBackend,
    hoistEventBackend,
    narrowEventBackend,
    InjectSelector,
    injectSelector,
    idInjectSelector,
    setDefaultReferenceEventBackend,
    setAncestorEventBackend,
    setInitialCauseEventBackend,
    setReferenceEventBackend,
    setParentEventBackend,
    setProximateEventBackend,

    -- ** Backend composition
    unitEventBackend,
    pairEventBackend,
    noopEventBackend,

    -- * Primitive 'Event' resource management.

    -- | Prefer the [resource-safe event allocation functions](#g:resourcesafe)
    -- to these when possible.
    finalize,
    newEvent,
    newSubEvent,
  )
where

import Control.Monad.Primitive
import Control.Monad.With
import Data.Exceptable
import Data.GeneralAllocate
import Observe.Event.Backend

-- | Mark another 'Event' as a parent of this 'Event'.
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

-- | Mark another 'Event' as a proximate cause of this 'Event'.
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

-- | Allocate a new 'Event', selected by the given selector.
--
-- The selector specifies the category of new event we're creating, as well
-- as the type of fields that can be added to it (with 'addField').
--
-- Selectors are intended to be of a domain specific type per unit of
-- functionality within an instrumented codebase, implemented as a GADT
-- (but see [DynamicEventSelector](https://hackage.haskell.org/package/eventuo11y-json/docs/Observe-Event-Dynamic.html#t:DynamicEventSelector) for a generic option).
--
-- The 'Event' is automatically 'finalize'd on release.
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

-- | Create a new 'Event' as a child of the given 'Event', selected by the given selector.
--
-- The selector specifies the category of new event we're creating, as well
-- as the type of fields that can be added to it (with 'addField').
--
-- Selectors are intended to be of a domain specific type per unit of
-- functionality within an instrumented codebase, implemented as a GADT
-- (but see [DynamicEventSelector](https://hackage.haskell.org/package/eventuo11y-json/docs/Observe-Event-Dynamic.html#t:DynamicEventSelector) for a generic option).
--
-- Consider the [resource-safe event allocation functions](#g:resourcesafe) instead
-- of calling this directly.
newSubEvent ::
  (Monad m) =>
  EventBackend m r s ->
  -- | The parent event.
  Event m r f ->
  forall f'.
  -- | The child event selector.
  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

-- | Run an action with a new 'Event', selected by the given selector.
--
-- The selector specifies the category of new event we're creating, as well
-- as the type of fields that can be added to it (with 'addField').
--
-- Selectors are intended to be of a domain specific type per unit of
-- functionality within an instrumented codebase, implemented as a GADT
-- (but see [DynamicEventSelector](https://hackage.haskell.org/package/eventuo11y-json/docs/Observe-Event-Dynamic.html#t:DynamicEventSelector) for a generic option).
--
-- The 'Event' is automatically 'finalize'd at the end of the function it's passed to.
withEvent ::
  (MonadWithExceptable m) =>
  EventBackend m r s ->
  forall f.
  -- | The event selector.
  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

-- | Run an action with a new 'Event' as a child of the given 'Event', selected by the given selector.
--
-- The selector specifies the category of new event we're creating, as well
-- as the type of fields that can be added to it (with 'addField').
--
-- Selectors are intended to be of a domain specific type per unit of
-- functionality within an instrumented codebase, implemented as a GADT
-- (but see [DynamicEventSelector](https://hackage.haskell.org/package/eventuo11y-json/docs/Observe-Event-Dynamic.html#t:DynamicEventSelector) for a generic option).
--
-- The 'Event' is automatically 'finalize'd at the end of the function it's passed to.
withSubEvent ::
  (MonadWithExceptable m) =>
  EventBackend m r s ->
  -- | The parent 'Event'.
  Event m r f ->
  forall f'.
  -- | The child event selector.
  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

-- | An 'EventBackend' where every otherwise parentless event will be marked
-- as a child of the given 'Event'.
subEventBackend ::
  (PrimMonad m) =>
  -- | Bring selectors from the new backend into the parent event's backend.
  InjectSelector s t ->
  -- | The parent event.
  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)

-- | An 'EventBackend' where every otherwise causeless event will be marked
-- as caused by the given 'Event'.
causedEventBackend ::
  (PrimMonad m) =>
  -- | Bring selectors from the new backend into the causing event's backend.
  InjectSelector s t ->
  -- | The causing event.
  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)