{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Description : Core interface for instrumentation with eventuo11y
-- Copyright   : Copyright 2022 Shea Levy.
-- License     : Apache-2.0
-- Maintainer  : shea@shealevy.com
--
-- This is the primary module needed to instrument code with eventuo11y.
--
-- Instrumentors should first define selector types and field types
-- appropriate to the unit of code they're instrumenting:
--
-- Selectors are values which designate the general category of event
-- being created, parameterized by the type of fields that can be added to it.
-- For example, a web service's selector type may have a @ServicingRequest@
-- constructor, whose field type includes a @ResponseCode@ constructor which
-- records the HTTP status code. Selectors are intended to be of a domain-specific
-- type per unit of functionality within an instrumented codebase, implemented as a GADT
-- (but see t'Observe.Event.Dynamic.DynamicEventSelector' for a generic option).
--
-- Fields make up the basic data captured in an event. They should be added
-- to an 'Event' as the code progresses through various phases of work, and can
-- be both milestone markers ("we got this far in the process") or more detailed
-- instrumentation ("we've processed N records"). They are intended to be of a
-- domain-specific type per unit of functionality within an instrumented codebase
-- (but see [DynamicField](https://hackage.haskell.org/package/eventuo11y-json/docs/Observe-Event-Dynamic.html#t:DynamicField) for a generic option).
--
-- Instrumentation then centers around 'Event's, populated using the
-- <#g:eventmanip event manipulation functions>. 'Event's are initialized
-- with 'MonadEvent' functions, typically via the
-- <#g:resourcesafe resource-safe event allocation functions>. For an
-- explicit alternative to 'MonadEvent', see "Observe.Event.Explicit".
--
-- Depending on which 'EventBackend's may end up consuming the 'Event's,
-- instrumentors will also need to define renderers for their selectors
-- and fields. For example, they may need to implement values of types
-- [RenderSelectorJSON](https://hackage.haskell.org/package/eventuo11y-json/docs/Observe-Event-Render-JSON.html#t:RenderSelectorJSON)
-- to use JSON rendering 'EventBackend's.
module Observe.Event
  ( Event,
    hoistEvent,

    -- * Event manipulation #eventmanip#
    addField,
    reference,

    -- * MonadEvent
    MonadEvent,
    EnvEvent,

    -- ** Resource-safe event allocation #resourcesafe#
    NewEventArgs (..),
    emitImmediateEvent',
    withEvent,
    withEventArgs,
    withNarrowingEvent,
    withNarrowingEventArgs,
    InjectSelector,
    injectSelector,
    idInjectSelector,
    MonadWithEvent,
    allocateEvent,
    allocateEventArgs,

    -- ** EventT
    EventT,
    runEventT,
    eventLift,

    -- ** TransEventMonad
    TransEventMonad (..),

    -- ** Primitives
    BackendMonad,
    EnvBackend,
    EventBackend,
    liftBackendMonad,
    backend,
    withModifiedBackend,

    -- * Primitive 'Event' resource management.

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

    -- * Backend Events

    -- | 'Event's within the 'BackendMonad' of a 'MonadEvent'
    --
    -- These are low-level primitives that can be used if the
    -- existing higher-level event allocation/backend modification
    -- combinators are insufficient
    BackendEvent,
    hoistBackendEvent,
    allocateBackendEvent,
    withBackendEvent,
    newBackendEvent,
  )
where

import Control.Monad.With
import Data.Exceptable
import Data.GeneralAllocate
import Data.Kind
import Observe.Event.Backend
import Observe.Event.Class
import qualified Observe.Event.Explicit as Explicit

-- | An 'Event' in a 'MonadEvent'
type EnvEvent :: EventMonadKind -> ReferenceKind -> SelectorKind -> Type -> Type
type EnvEvent em r s = Event (em r s) r

-- | Create an event which has no duration and is immediately finalized successfully.
--
-- Returns a reference to the event.
emitImmediateEvent' :: (MonadEvent em) => NewEventArgs r s f -> em r s r
emitImmediateEvent' :: forall (em :: EventMonadKind) r (s :: * -> *) f.
MonadEvent em =>
NewEventArgs r s f -> em r s r
emitImmediateEvent' NewEventArgs r s f
args = do
  EventBackend (BackendMonad em) r s
b <- forall (em :: EventMonadKind) r (s :: * -> *).
MonadEvent em =>
em r s (EnvBackend em r s)
backend
  forall (em :: EventMonadKind) a r (s :: * -> *).
MonadEvent em =>
BackendMonad em a -> em r s a
liftBackendMonad forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r (s :: * -> *).
EventBackend m r s -> forall f. NewEventArgs r s f -> m r
emitImmediateEvent EventBackend (BackendMonad em) r s
b NewEventArgs r s f
args

-- | 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).
--
-- Within the nested action, all new parentless 'Event's will be
-- made children of the new 'Event'.
--
-- The 'Event' will be 'finalize'd at the end of the nested action.
withEvent ::
  (MonadWithEvent em) =>
  forall f.
  s f ->
  (EnvEvent em r s f -> em r s a) ->
  em r s a
withEvent :: forall (em :: EventMonadKind) (s :: * -> *) r a f.
MonadWithEvent em =>
s f -> (EnvEvent em r s f -> em r s a) -> em r s a
withEvent = forall (em :: EventMonadKind) (s :: * -> *) (t :: * -> *) r x.
MonadWithEvent em =>
InjectSelector s t
-> forall f. t f -> (EnvEvent em r s f -> em r s x) -> em r t x
withNarrowingEvent forall (s :: * -> *). InjectSelector s s
idInjectSelector

-- | Run an action with a new 'Event', specified by the given 'NewEventArgs'
--
-- Within the nested action, all new parentless 'Event's will be
-- made children of the new 'Event'.
--
-- The 'Event' will be 'finalize'd at the end of the nested action.
withEventArgs ::
  (MonadWithEvent em) =>
  forall f.
  NewEventArgs r s f ->
  (EnvEvent em r s f -> em r s a) ->
  em r s a
withEventArgs :: forall (em :: EventMonadKind) r (s :: * -> *) a f.
MonadWithEvent em =>
NewEventArgs r s f -> (EnvEvent em r s f -> em r s a) -> em r s a
withEventArgs = forall (em :: EventMonadKind) (s :: * -> *) (t :: * -> *) r x.
MonadWithEvent em =>
InjectSelector s t
-> forall f.
   NewEventArgs r t f -> (EnvEvent em r s f -> em r s x) -> em r t x
withNarrowingEventArgs forall (s :: * -> *). InjectSelector s s
idInjectSelector

-- | Run an action with a new 'Event' , selected by a given selector, with a narrower sub-selector type.
--
-- 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).
--
-- Within the nested action, all new parentless 'Event's will be
-- made children of the new 'Event', and all new 'Event's will
-- be selected by the narrower selector type.
--
-- The 'Event' will be 'finalize'd at the end of the nested action.
withNarrowingEvent ::
  (MonadWithEvent em) =>
  InjectSelector s t ->
  forall f.
  t f ->
  (EnvEvent em r s f -> em r s x) ->
  em r t x
withNarrowingEvent :: forall (em :: EventMonadKind) (s :: * -> *) (t :: * -> *) r x.
MonadWithEvent em =>
InjectSelector s t
-> forall f. t f -> (EnvEvent em r s f -> em r s x) -> em r t x
withNarrowingEvent InjectSelector s t
inj = forall (em :: EventMonadKind) (s :: * -> *) (t :: * -> *) r x.
MonadWithEvent em =>
InjectSelector s t
-> forall f.
   NewEventArgs r t f -> (EnvEvent em r s f -> em r s x) -> em r t x
withNarrowingEventArgs InjectSelector s t
inj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) f r. s f -> NewEventArgs r s f
simpleNewEventArgs

-- | Run an action with a new 'Event' , specified by the given 'NewEventArgs', with a narrower sub-selector type.
--
-- Within the nested action, all new parentless 'Event's will be
-- made children of the new 'Event', and all new 'Event's will
-- be selected by the narrower selector type.
--
-- The 'Event' will be 'finalize'd at the end of the nested action.
withNarrowingEventArgs ::
  (MonadWithEvent em) =>
  InjectSelector s t ->
  forall f.
  NewEventArgs r t f ->
  (EnvEvent em r s f -> em r s x) ->
  em r t x
withNarrowingEventArgs :: forall (em :: EventMonadKind) (s :: * -> *) (t :: * -> *) r x.
MonadWithEvent em =>
InjectSelector s t
-> forall f.
   NewEventArgs r t f -> (EnvEvent em r s f -> em r s x) -> em r t x
withNarrowingEventArgs InjectSelector s t
inj NewEventArgs r t f
args EnvEvent em r s f -> em r s x
go = forall (em :: EventMonadKind) r (s :: * -> *) a f.
(MonadEvent em, MonadWithExceptable (em r s)) =>
NewEventArgs r s f -> (BackendEvent em r f -> em r s a) -> em r s a
withBackendEvent NewEventArgs r t f
args forall a b. (a -> b) -> a -> b
$ \BackendEvent em r f
ev -> do
  let ev' :: EnvEvent em r s f
ev' = forall (em :: EventMonadKind) r f (s :: * -> *).
MonadEvent em =>
BackendEvent em r f -> EnvEvent em r s f
hoistBackendEvent BackendEvent em r f
ev
  forall (em :: EventMonadKind) r (s :: * -> *) r' (s' :: * -> *) a.
MonadEvent em =>
(EnvBackend em r s -> EnvBackend em r' s')
-> em r' s' a -> em r s a
withModifiedBackend (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 r (m :: * -> *) (s :: * -> *).
r -> EventBackend m r s -> EventBackend m r s
setAncestorEventBackend (forall (m :: * -> *) r f. Event m r f -> r
reference BackendEvent em r f
ev)) forall a b. (a -> b) -> a -> b
$ EnvEvent em r s f -> em r s x
go EnvEvent em r s f
ev'

-- | A 'MonadEvent' suitable for running the 'withEvent' family of functions
class (MonadEvent em, forall r s. MonadWithExceptable (em r s)) => MonadWithEvent em

instance (MonadEvent em, forall r s. MonadWithExceptable (em r s)) => MonadWithEvent em

-- | 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' will be automatically 'finalize'd on release.
allocateEvent ::
  (MonadEvent em, Exceptable e) =>
  forall f.
  s f ->
  GeneralAllocate (em r s) e () releaseArg (EnvEvent em r s f)
allocateEvent :: forall (em :: EventMonadKind) e (s :: * -> *) r releaseArg f.
(MonadEvent em, Exceptable e) =>
s f -> GeneralAllocate (em r s) e () releaseArg (EnvEvent em r s f)
allocateEvent = forall (em :: EventMonadKind) e r (s :: * -> *) releaseArg f.
(MonadEvent em, Exceptable e) =>
NewEventArgs r s f
-> GeneralAllocate (em r s) e () releaseArg (EnvEvent em r s f)
allocateEventArgs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) f r. s f -> NewEventArgs r s f
simpleNewEventArgs

-- | Allocate a new 'Event', specified by the given 'NewEventArgs'.
--
-- The 'Event' will be automatically 'finalize'd on release.
allocateEventArgs ::
  (MonadEvent em, Exceptable e) =>
  forall f.
  NewEventArgs r s f ->
  GeneralAllocate (em r s) e () releaseArg (EnvEvent em r s f)
allocateEventArgs :: forall (em :: EventMonadKind) e r (s :: * -> *) releaseArg f.
(MonadEvent em, Exceptable e) =>
NewEventArgs r s f
-> GeneralAllocate (em r s) e () releaseArg (EnvEvent em r s f)
allocateEventArgs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (em :: EventMonadKind) r f (s :: * -> *).
MonadEvent em =>
BackendEvent em r f -> EnvEvent em r s f
hoistBackendEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (em :: EventMonadKind) e r (s :: * -> *) releaseArg f.
(MonadEvent em, Exceptable e) =>
NewEventArgs r s f
-> GeneralAllocate (em r s) e () releaseArg (BackendEvent em r f)
allocateBackendEvent

-- | Create 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).
--
-- Consider the [resource-safe event allocation functions](#g:resourcesafe) instead
-- of calling this directly.
newEvent' :: (MonadEvent em) => forall f. s f -> em r s (EnvEvent em r s f)
newEvent' :: forall (em :: EventMonadKind) (s :: * -> *) r f.
MonadEvent em =>
s f -> em r s (EnvEvent em r s f)
newEvent' = forall (em :: EventMonadKind) r (s :: * -> *) f.
MonadEvent em =>
NewEventArgs r s f -> em r s (EnvEvent em r s f)
newEventArgs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) f r. s f -> NewEventArgs r s f
simpleNewEventArgs

-- | Create a new 'Event', specified by the given 'NewEventArgs'.
--
-- Consider the [resource-safe event allocation functions](#g:resourcesafe) instead
-- of calling this directly.
newEventArgs :: (MonadEvent em) => forall f. NewEventArgs r s f -> em r s (EnvEvent em r s f)
newEventArgs :: forall (em :: EventMonadKind) r (s :: * -> *) f.
MonadEvent em =>
NewEventArgs r s f -> em r s (EnvEvent em r s f)
newEventArgs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (em :: EventMonadKind) r f (s :: * -> *).
MonadEvent em =>
BackendEvent em r f -> EnvEvent em r s f
hoistBackendEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (em :: EventMonadKind) r (s :: * -> *) f.
MonadEvent em =>
NewEventArgs r s f -> em r s (BackendEvent em r f)
newBackendEvent

-- | An 'Event' in the 'BackendMonad' of a 'MonadEvent'
type BackendEvent :: EventMonadKind -> ReferenceKind -> Type -> Type
type BackendEvent em = Event (BackendMonad em)

-- | Bring a 'BackendEvent' into the 'MonadEvent'
hoistBackendEvent :: (MonadEvent em) => BackendEvent em r f -> EnvEvent em r s f
hoistBackendEvent :: forall (em :: EventMonadKind) r f (s :: * -> *).
MonadEvent em =>
BackendEvent em r f -> EnvEvent em r s f
hoistBackendEvent = forall (m :: * -> *) (n :: * -> *) r f.
(forall x. m x -> n x) -> Event m r f -> Event n r f
hoistEvent forall (em :: EventMonadKind) a r (s :: * -> *).
MonadEvent em =>
BackendMonad em a -> em r s a
liftBackendMonad

-- | A 'BackendMonad' variant of 'allocateEventArgs'.
allocateBackendEvent ::
  (MonadEvent em, Exceptable e) =>
  forall f.
  NewEventArgs r s f ->
  GeneralAllocate (em r s) e () releaseArg (BackendEvent em r f)
allocateBackendEvent :: forall (em :: EventMonadKind) e r (s :: * -> *) releaseArg f.
(MonadEvent em, Exceptable e) =>
NewEventArgs r s f
-> GeneralAllocate (em r s) e () releaseArg (BackendEvent em r f)
allocateBackendEvent NewEventArgs r s f
args = 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. em r s x -> em r s x
_ -> do
  BackendEvent em r f
ev <- forall (em :: EventMonadKind) r (s :: * -> *) f.
MonadEvent em =>
NewEventArgs r s f -> em r s (BackendEvent em r f)
newBackendEvent NewEventArgs r s f
args
  let release :: GeneralReleaseType e releaseArg -> em r s ()
release (ReleaseFailure e
e) = forall (em :: EventMonadKind) a r (s :: * -> *).
MonadEvent em =>
BackendMonad em a -> em r s a
liftBackendMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r f.
Event m r f -> Maybe SomeException -> m ()
finalize BackendEvent em 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 releaseArg
_) = forall (em :: EventMonadKind) a r (s :: * -> *).
MonadEvent em =>
BackendMonad em a -> em r s a
liftBackendMonad forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r f.
Event m r f -> Maybe SomeException -> m ()
finalize BackendEvent em 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 BackendEvent em r f
ev GeneralReleaseType e releaseArg -> em r s ()
release

-- | Run an action with a new 'BackendEvent'.
--
-- The 'Event' will be 'finalize'd upon completion.
withBackendEvent ::
  (MonadEvent em, MonadWithExceptable (em r s)) =>
  forall f.
  NewEventArgs r s f ->
  (BackendEvent em r f -> em r s a) ->
  em r s a
withBackendEvent :: forall (em :: EventMonadKind) r (s :: * -> *) a f.
(MonadEvent em, MonadWithExceptable (em r s)) =>
NewEventArgs r s f -> (BackendEvent em r f -> em r s a) -> em r s a
withBackendEvent = 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 (em :: EventMonadKind) e r (s :: * -> *) releaseArg f.
(MonadEvent em, Exceptable e) =>
NewEventArgs r s f
-> GeneralAllocate (em r s) e () releaseArg (BackendEvent em r f)
allocateBackendEvent

-- | A 'BackendMonad' variant of 'newEventArgs'
newBackendEvent :: (MonadEvent em) => forall f. NewEventArgs r s f -> em r s (BackendEvent em r f)
newBackendEvent :: forall (em :: EventMonadKind) r (s :: * -> *) f.
MonadEvent em =>
NewEventArgs r s f -> em r s (BackendEvent em r f)
newBackendEvent NewEventArgs r s f
args = do
  EventBackend (BackendMonad em) r s
b <- forall (em :: EventMonadKind) r (s :: * -> *).
MonadEvent em =>
em r s (EnvBackend em r s)
backend
  forall (em :: EventMonadKind) a r (s :: * -> *).
MonadEvent em =>
BackendMonad em a -> em r s a
liftBackendMonad forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r (s :: * -> *).
EventBackend m r s
-> forall f. NewEventArgs r s f -> m (Event m r f)
Explicit.newEvent EventBackend (BackendMonad em) r s
b NewEventArgs r s f
args