eventuo11y 0.6.0.0 → 0.7.0.0

raw patch · 6 files changed

+238/−231 lines, 6 filesdep ~mtlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: mtl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• eventuo11y.cabal +5/−2
• src/Observe/Event.hs +70/−38
• src/Observe/Event/Backend.hs +120/−113
• src/Observe/Event/Class.hs +1/−0
• src/Observe/Event/Explicit.hs +31/−78

@@ -1,5 +1,16 @@ # Revision history for eventuo11y +## 0.7.0.0 -- 2023-01-13++- Use `NewEventArgs` as the basic way to initialize a new `Event`.++  This replaces `addReference`, requiring the parent and any+  proximate causes to be specified up-front. If a use case for+  multiple parents, or specifying parents/causes only after an+  `Event` is live, is found, we can add it back.+- Add `emitImmediateEvent` and `emitImmediateEvent'` as primitives for+  events with no duration.+ ## 0.6.0.0 -- 2022-12-23  - Add `MonadEvent` for implicit backend management

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               eventuo11y-version:            0.6.0.0+version:            0.7.0.0 synopsis:           An event-oriented observability library description:   Instrument your Haskell codebase with wide, semantically meaningful events.@@ -29,6 +29,9 @@   See [eventuo11y-dsl](https://hackage.haskell.org/package/eventuo11y-dsl) for simpler syntax for   creating application-level instrumentation types. +  See [eventuo11y-otel](https://hackage.haskell.org/package/eventuo11y-otel) for an OpenTelemetry-based+  backend.+   See [eventuo11y-json](https://hackage.haskell.org/package/eventuo11y-json) for JSON-based rendering   and backends. @@ -68,7 +71,7 @@     , transformers      ^>= { 0.5, 0.6 }     , transformers-base ^>= { 0.4 }     , monad-control     ^>= { 1.0 }-    , mtl               ^>= { 2.2 }+    , mtl               ^>= { 2.2, 2.3 }     , unliftio-core     ^>= { 0.2 }    hs-source-dirs:   src

@@ -60,24 +60,24 @@     -- * Event manipulation #eventmanip#     addField,     reference,-    Explicit.addParent,-    Explicit.addProximate,-    addReference,-    Reference (..),-    ReferenceType (..),      -- * MonadEvent     MonadEvent,     EnvEvent,      -- ** Resource-safe event allocation #resourcesafe#+    NewEventArgs (..),+    emitImmediateEvent',     withEvent,+    withEventArgs,     withNarrowingEvent,+    withNarrowingEventArgs,     InjectSelector,     injectSelector,     idInjectSelector,     MonadWithEvent,     allocateEvent,+    allocateEventArgs,      -- ** EventT     EventT,@@ -101,7 +101,7 @@     -- to these when possible.     finalize,     newEvent',-    newSubEvent,+    newEventArgs,      -- * Backend Events @@ -118,7 +118,6 @@   ) where -import Control.Monad.Primitive import Control.Monad.With import Data.Exceptable import Data.GeneralAllocate@@ -131,6 +130,14 @@ 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' args = do+  b <- backend+  liftBackendMonad $ emitImmediateEvent b 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@@ -152,6 +159,20 @@   em r s a withEvent = withNarrowingEvent 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 r s) =>+  forall f.+  NewEventArgs r s f ->+  (EnvEvent em r s f -> em r s a) ->+  em r s a+withEventArgs = withNarrowingEventArgs 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@@ -173,12 +194,28 @@   t f ->   (EnvEvent em r s f -> em r s x) ->   em r t x-withNarrowingEvent inj sel go = withBackendEvent sel $ \ev -> do+withNarrowingEvent inj = withNarrowingEventArgs inj . 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 r t) =>+  InjectSelector s t ->+  forall f.+  NewEventArgs r t f ->+  (EnvEvent em r s f -> em r s x) ->+  em r t x+withNarrowingEventArgs inj args go = withBackendEvent args $ \ev -> do   let ev' = hoistBackendEvent ev   withModifiedBackend (narrowEventBackend inj . setAncestorEventBackend (reference ev)) $ go ev'  -- | A 'MonadEvent' suitable for running the 'withEvent' family of functions-type MonadWithEvent em r s = (MonadEvent em, PrimMonad (BackendMonad em), MonadWithExceptable (em r s))+type MonadWithEvent em r s = (MonadEvent em, MonadWithExceptable (em r s))  -- | Allocate a new 'Event', selected by the given selector. --@@ -195,8 +232,18 @@   forall f.   s f ->   GeneralAllocate (em r s) e () releaseArg (EnvEvent em r s f)-allocateEvent = fmap hoistBackendEvent . allocateBackendEvent+allocateEvent = allocateEventArgs . 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 = fmap hoistBackendEvent . allocateBackendEvent+ -- | Create a new 'Event', selected by the given selector. -- -- The selector specifies the category of new event we're creating, as well@@ -209,29 +256,14 @@ -- 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' = fmap hoistBackendEvent . newBackendEvent+newEvent' = newEventArgs . simpleNewEventArgs --- | 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).+-- | Create a new 'Event', specified by the given 'NewEventArgs'. -- -- Consider the [resource-safe event allocation functions](#g:resourcesafe) instead -- of calling this directly.-newSubEvent ::-  (MonadEvent em) =>-  EnvEvent em r s f ->-  forall f'.-  s f' ->-  em r s (EnvEvent em r s f')-newSubEvent ev sel = do-  child <- newEvent' sel-  Explicit.addParent child $ reference ev-  pure child+newEventArgs :: (MonadEvent em) => forall f. NewEventArgs r s f -> em r s (EnvEvent em r s f)+newEventArgs = fmap hoistBackendEvent . newBackendEvent  -- | An 'Event' in the 'BackendMonad' of a 'MonadEvent' type BackendEvent :: EventMonadKind -> ReferenceKind -> Type -> Type@@ -241,14 +273,14 @@ hoistBackendEvent :: (MonadEvent em) => BackendEvent em r f -> EnvEvent em r s f hoistBackendEvent = hoistEvent liftBackendMonad --- | A 'BackendMonad' variant of 'allocateEvent'.+-- | A 'BackendMonad' variant of 'allocateEventArgs'. allocateBackendEvent ::   (MonadEvent em, Exceptable e) =>   forall f.-  s f ->+  NewEventArgs r s f ->   GeneralAllocate (em r s) e () releaseArg (BackendEvent em r f)-allocateBackendEvent sel = GeneralAllocate $ \_ -> do-  ev <- newBackendEvent sel+allocateBackendEvent args = GeneralAllocate $ \_ -> do+  ev <- newBackendEvent args   let release (ReleaseFailure e) = liftBackendMonad . finalize ev . Just $ toSomeException e       release (ReleaseSuccess _) = liftBackendMonad $ finalize ev Nothing   pure $ GeneralAllocated ev release@@ -259,13 +291,13 @@ withBackendEvent ::   (MonadEvent em, MonadWithExceptable (em r s)) =>   forall f.-  s f ->+  NewEventArgs r s f ->   (BackendEvent em r f -> em r s a) ->   em r s a withBackendEvent = generalWith . allocateBackendEvent --- | A 'BackendMonad' variant of 'newEvent''-newBackendEvent :: (MonadEvent em) => forall f. s f -> em r s (BackendEvent em r f)-newBackendEvent sel = do+-- | A 'BackendMonad' variant of 'newEventArgs'+newBackendEvent :: (MonadEvent em) => forall f. NewEventArgs r s f -> em r s (BackendEvent em r f)+newBackendEvent args = do   b <- backend-  liftBackendMonad $ Explicit.newEvent b sel+  liftBackendMonad $ Explicit.newEvent b args

@@ -15,8 +15,8 @@   ( -- * Core interface     EventBackend (..),     Event (..),-    Reference (..),-    ReferenceType (..),+    NewEventArgs (..),+    simpleNewEventArgs,      -- * Backend composition     unitEventBackend,@@ -30,20 +30,15 @@     injectSelector,     idInjectSelector,     narrowEventBackend,-    setDefaultReferenceEventBackend,     setAncestorEventBackend,     setInitialCauseEventBackend,-    setReferenceEventBackend,-    setParentEventBackend,-    setProximateEventBackend,   ) where +import Control.Applicative import Control.Exception-import Control.Monad-import Control.Monad.Primitive+import Control.Monad.Zip import Data.Functor-import Data.Primitive.MVar  -- | An instrumentation event. --@@ -58,7 +53,8 @@ data Event m r f = Event   { -- | Obtain a reference to an 'Event'.     ---    -- References are used to link 'Event's together, via 'addReference'.+    -- References are used to link 'Event's together, via the 'newEventParent'+    -- and 'newEventCauses' fields of 'NewEventArgs'.     --     -- References can live past when an event has been 'finalize'd.     --@@ -79,8 +75,6 @@     -- 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).     addField :: !(f -> m ()),-    -- | Relate another 'Event' to this 'Event' in the specified way-    addReference :: !(Reference r -> m ()),     -- | Mark an 'Event' as finished, perhaps due to an 'Exception'.     --     -- In normal usage, this should be automatically called via the use of@@ -88,8 +82,8 @@     --     -- This is a no-op if the 'Event' has already been 'finalize'd.     -- As a result, it is likely pointless to call-    -- 'addField' or 'addReference' (or v'Observe.Event.addParent' / v'Observe.Event.addProximate')-    -- after this call, though it still may be reasonable to call 'reference'.+    -- 'addField' after this call, though it still may be reasonable to call+    -- 'reference'.     finalize :: !(Maybe SomeException -> m ())   } @@ -98,21 +92,9 @@ hoistEvent nt ev =   ev     { addField = nt . addField ev,-      addReference = nt . addReference ev,       finalize = nt . finalize ev     } --- | Ways in which 'Event's can 'Reference' each other.-data ReferenceType-  = -- | The 'Reference'd 'Event' is a parent of this 'Event'.-    Parent-  | -- | The 'Reference'd 'Event' is a proximate cause of this 'Event'.-    Proximate-  deriving stock (Eq)---- | A reference to another 'Event'-data Reference r = Reference !ReferenceType !r- -- | A backend for creating t'Event's. -- -- Different 'EventBackend's will be used to emit instrumentation to@@ -120,12 +102,7 @@ -- 'Observe.Event.pairEventBackend'. -- -- A simple 'EventBackend' for logging to a t'System.IO.Handle' can be--- created with 'Observe.Event.Render.IO.JSON.jsonHandleBackend'.------ Typically the entrypoint for some eventuo11y-instrumented code will--- take an 'EventBackend', polymorphic in @r@ and possibly @m@. Calling--- code can use 'Observe.Event.subEventBackend' to place the resulting--- events in its hierarchy.+-- created with [jsonHandleBackend](https://hackage.haskell.org/package/eventuo11y-json/docs/Observe-Event-Render-JSON-Handle.html#v:jsonHandleBackend). -- -- From an 'EventBackend', new events can be created via selectors -- (of type @s f@ for some field type @f@), typically with the@@ -140,31 +117,65 @@ -- 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). ----- Implementations must ensure that 'EventBackend's and their underlying t'Observe.Event.Event's+-- Implementations must ensure that 'EventBackend's and their underlying t'Event's -- are safe to use across threads. -- -- [@m@]: The monad we're instrumenting in.--- [@r@]: The type of event references used in this 'EventBackend'. See 'Observe.Event.reference'.--- [@s@]: The type of event selectors. See 'newEvent'.-newtype EventBackend m r s = EventBackend-  { -- | Create a new 'Event', selected by the given selector.+-- [@r@]: The type of event references used in this 'EventBackend'. See 'reference'.+-- [@s@]: The type of event selectors. See 'newEventSelector'.+data EventBackend m r s = EventBackend+  { -- | Create a new 'Event', specified by the given arguments.     ---    -- 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').+    -- Consider the [resource-safe event allocation functions](Observe-Event.html#g:resourcesafe) instead+    -- of calling this directly.+    newEvent :: forall f. NewEventArgs r s f -> m (Event m r f),+    -- | Create an event which has no duration and is immediately finalized+    -- successfully.     --+    -- Returns a reference to the event.+    emitImmediateEvent :: forall f. NewEventArgs r s f -> m r+  }++-- | Arguments specifying how an 'Event' should be created.+--+-- See 'simpleNewEventArgs' for a simple case.+data NewEventArgs r s f = NewEventArgs+  { -- | The selector specifying 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).+    newEventSelector :: !(s f),+    -- | The parent of the new 'Event', if any.     ---    -- Consider the [resource-safe event allocation functions](Observe-Event.html#g:resourcesafe) instead-    -- of calling this directly.-    newEvent ::-      forall f.-      -- The event selector.-      s f ->-      m (Event m r f)+    -- Typically handled automatically via v'Observe.Event.withEvent'.+    newEventParent :: !(Maybe r),+    -- | The proximate causes of the new 'Event', if any.+    newEventCauses :: ![r],+    -- | Fields set at the creation of the 'Event'.+    --+    -- See 'addField'.+    newEventInitialFields :: ![f]   } +-- | 'NewEventArgs' from a given selector, with no initial fields or explicit references.+--+-- 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).+simpleNewEventArgs :: s f -> NewEventArgs r s f+simpleNewEventArgs sel =+  NewEventArgs+    { newEventSelector = sel,+      newEventParent = Nothing,+      newEventCauses = [],+      newEventInitialFields = []+    }+ -- | A no-op 'EventBackend'. -- -- This can be used if calling instrumented code from an un-instrumented@@ -181,18 +192,36 @@ pairEventBackend :: Applicative m => EventBackend m a s -> EventBackend m b s -> EventBackend m (a, b) s pairEventBackend x y =   EventBackend-    { newEvent = \sel -> do-        xEv <- newEvent x sel-        yEv <- newEvent y sel+    { newEvent = \args -> do+        let (xArgs, yArgs) = unzipArgs args+        xEv <- newEvent x xArgs+        yEv <- newEvent y yArgs         pure $           Event             { reference = (reference xEv, reference yEv),               addField = \f -> addField xEv f *> addField yEv f,-              addReference = \(Reference ty (rx, ry)) ->-                addReference xEv (Reference ty rx) *> addReference yEv (Reference ty ry),               finalize = \me -> finalize xEv me *> finalize yEv me-            }+            },+      emitImmediateEvent = \args -> do+        let (xArgs, yArgs) = unzipArgs args+        xRef <- emitImmediateEvent x xArgs+        yRef <- emitImmediateEvent y yArgs+        pure $ (xRef, yRef)     }+  where+    unzipArgs args =+      ( args+          { newEventParent = xParent,+            newEventCauses = xCauses+          },+        args+          { newEventParent = yParent,+            newEventCauses = yCauses+          }+      )+      where+        (xParent, yParent) = munzip $ newEventParent args+        (xCauses, yCauses) = munzip $ newEventCauses args  -- | A no-op 'EventBackend' that can be integrated with other backends. --@@ -209,9 +238,9 @@           Event             { reference = r,               addField = const $ pure (),-              addReference = const $ pure (),               finalize = const $ pure ()-            }+            },+      emitImmediateEvent = \_ -> pure r     }  -- | Hoist an 'EventBackend' along a given natural transformation into a new monad.@@ -222,7 +251,8 @@   EventBackend n r s hoistEventBackend nt backend =   EventBackend-    { newEvent = nt . fmap (hoistEvent nt) . newEvent backend+    { newEvent = nt . fmap (hoistEvent nt) . newEvent backend,+      emitImmediateEvent = nt . emitImmediateEvent backend     }  -- | Inject a narrower selector and its fields into a wider selector.@@ -250,70 +280,47 @@   EventBackend m r s narrowEventBackend inj backend =   EventBackend-    { newEvent = \sel -> inj sel \sel' injField ->-        newEvent backend sel' <&> \ev ->+    { newEvent = \args -> inj (newEventSelector args) \sel' injField ->+        newEvent backend (transformArgs args sel' injField) <&> \ev ->           ev             { addField = addField ev . injField-            }+            },+      emitImmediateEvent = \args -> inj (newEventSelector args) \sel' injField ->+        emitImmediateEvent backend $ transformArgs args sel' injField     }+  where+    transformArgs args sel' injField =+      args+        { newEventSelector = sel',+          newEventInitialFields = injField <$> newEventInitialFields args+        } --- | Transform an 'EventBackend' so all of its 'Event's have a given 'Reference'.------ You likely want 'setDefaultReferenceEventBackend', if your monad supports it.-setReferenceEventBackend :: (Monad m) => Reference r -> EventBackend m r s -> EventBackend m r s-setReferenceEventBackend r backend =+-- | Transform an 'EventBackend' so all of its 'Event's have a given parent, if they+-- are not given another parent.+setAncestorEventBackend :: r -> EventBackend m r s -> EventBackend m r s+setAncestorEventBackend parent backend =   EventBackend-    { newEvent = \sel -> do-        ev <- newEvent backend sel-        addReference ev r-        pure ev+    { newEvent = newEvent backend . transformArgs,+      emitImmediateEvent = emitImmediateEvent backend . transformArgs     }---- | Transform an 'EventBackend' so all of its 'Event's have a given parent.------ You likely want 'setAncestorEventBackend', if your monad supports it.-setParentEventBackend :: (Monad m) => r -> EventBackend m r s -> EventBackend m r s-setParentEventBackend = setReferenceEventBackend . Reference Parent---- | Transform an 'EventBackend' so all of its 'Event's have a given proximate cause.------ You likely want 'setInitialCauseEventBackend', if your monad supports it.-setProximateEventBackend :: (Monad m) => r -> EventBackend m r s -> EventBackend m r s-setProximateEventBackend = setReferenceEventBackend . Reference Proximate+  where+    transformArgs args =+      args+        { newEventParent = newEventParent args <|> pure parent+        } --- | Transform an 'EventBackend' so all of its 'Event's have a given 'Reference', if they--- haven't been given a 'Reference' of the same 'ReferenceType' by the time they are 'finalize'd.------ See 'setReferenceEventBackend' if the 'Reference' should be applied unconditionally.-setDefaultReferenceEventBackend :: (PrimMonad m) => Reference r -> EventBackend m r s -> EventBackend m r s-setDefaultReferenceEventBackend ref@(Reference ty _) backend =+-- | Transform an 'EventBackend' so all of its 'Event's have the given causes,+-- if they are not given another set of causes.+setInitialCauseEventBackend :: [r] -> EventBackend m r s -> EventBackend m r s+setInitialCauseEventBackend causes backend =   EventBackend-    { newEvent = \sel -> do-        flag <- newEmptyMVar-        ev <- newEvent backend sel-        pure $-          ev-            { addReference = \ref'@(Reference ty' _) -> do-                when (ty' == ty) . void $ tryPutMVar flag ()-                addReference ev ref',-              finalize = \me -> do-                tryPutMVar flag () >>= \case-                  False -> pure ()-                  True -> addReference ev ref-                finalize ev me-            }+    { newEvent = newEvent backend . transformArgs,+      emitImmediateEvent = emitImmediateEvent backend . transformArgs     }---- | Transform an 'EventBackend' so all of its 'Event's have a given parent, if they--- are not given another parent by the time they are 'finalize'd.------ See 'setParentEventBackend' if the parent should be set unconditionally.-setAncestorEventBackend :: (PrimMonad m) => r -> EventBackend m r s -> EventBackend m r s-setAncestorEventBackend = setDefaultReferenceEventBackend . Reference Parent---- | Transform an 'EventBackend' so all of its 'Event's have a given proximate cause,--- if they are not given another proximate cause by the time they are 'finalize'd.------ See 'setProximateEventBackend' if the proximate cause should be set unconditionally.-setInitialCauseEventBackend :: (PrimMonad m) => r -> EventBackend m r s -> EventBackend m r s-setInitialCauseEventBackend = setDefaultReferenceEventBackend . Reference Proximate+  where+    transformArgs args =+      args+        { newEventCauses = case newEventCauses args of+            [] -> causes+            l -> l+        }

@@ -49,6 +49,7 @@ import Control.Monad.Catch import Control.Monad.Cont.Class import Control.Monad.Error.Class+import Control.Monad.Fix import Control.Monad.IO.Unlift import Control.Monad.Primitive import Control.Monad.Reader

@@ -17,16 +17,14 @@     -- * Event manipulation #eventmanip#     addField,     reference,-    addParent,-    addProximate,-    addReference,-    Reference (..),-    ReferenceType (..),      -- * Resource-safe event allocation #resourcesafe#+    NewEventArgs (..),+    emitImmediateEvent,     allocateEvent,+    allocateEventArgs,     withEvent,-    withSubEvent,+    withEventArgs,      -- * 'EventBackend's     EventBackend,@@ -39,12 +37,8 @@     InjectSelector,     injectSelector,     idInjectSelector,-    setDefaultReferenceEventBackend,     setAncestorEventBackend,     setInitialCauseEventBackend,-    setReferenceEventBackend,-    setParentEventBackend,-    setProximateEventBackend,      -- ** Backend composition     unitEventBackend,@@ -57,30 +51,14 @@     -- 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 ev = addReference ev . Reference Parent---- | Mark another 'Event' as a proximate cause of this 'Event'.-addProximate ::-  Event m r f ->-  r ->-  m ()-addProximate ev = addReference ev . Reference Proximate- -- | Allocate a new 'Event', selected by the given selector. -- -- The selector specifies the category of new event we're creating, as well@@ -97,36 +75,22 @@   forall f.   s f ->   GeneralAllocate m e () releaseArg (Event m r f)-allocateEvent backend sel = GeneralAllocate $ \restore -> do-  ev <- restore $ newEvent backend sel-  let release (ReleaseFailure e) = finalize ev . Just $ toSomeException e-      release (ReleaseSuccess _) = finalize ev Nothing-  pure $ GeneralAllocated ev release+allocateEvent backend = allocateEventArgs backend . simpleNewEventArgs --- | 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).+-- | Allocate a new 'Event', based on given 'NewEventArgs'. ----- Consider the [resource-safe event allocation functions](#g:resourcesafe) instead--- of calling this directly.-newSubEvent ::-  (Monad m) =>+-- The 'Event' is automatically 'finalize'd on release.+allocateEventArgs ::+  (Monad m, Exceptable e) =>   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 backend ev sel = do-  child <- newEvent backend sel-  addParent child $ reference ev-  pure child+  forall f.+  NewEventArgs r s f ->+  GeneralAllocate m e () releaseArg (Event m r f)+allocateEventArgs backend args = GeneralAllocate $ \restore -> do+  ev <- restore $ newEvent backend args+  let release (ReleaseFailure e) = finalize ev . Just $ toSomeException e+      release (ReleaseSuccess _) = finalize ev Nothing+  pure $ GeneralAllocated ev release  -- | Run an action with a new 'Event', selected by the given selector. --@@ -148,34 +112,23 @@   m a withEvent backend = generalWith . allocateEvent 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).+-- | Run an action with a new 'Event', based on the given 'NewEventArgs'. -- -- The 'Event' is automatically 'finalize'd at the end of the function it's passed to.-withSubEvent ::+withEventArgs ::   (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) ->+  forall f.+  -- | The event selector.+  NewEventArgs r s f ->+  (Event m r f -> m a) ->   m a-withSubEvent backend ev sel go = withEvent backend sel $ \child -> do-  addParent child $ reference ev-  go child+withEventArgs backend = generalWith . allocateEventArgs backend  -- | An 'EventBackend' where every otherwise parentless event will be marked -- as a child of the given 'Event'. subEventBackend ::-  (PrimMonad m) =>+  (Functor m) =>   -- | Bring selectors from the new backend into the parent event's backend.   InjectSelector s t ->   -- | The parent event.@@ -187,15 +140,15 @@     . setAncestorEventBackend (reference ev)  -- | An 'EventBackend' where every otherwise causeless event will be marked--- as caused by the given 'Event'.+-- as caused by the given 'Event's. causedEventBackend ::-  (PrimMonad m) =>+  (Functor m) =>   -- | Bring selectors from the new backend into the causing event's backend.   InjectSelector s t ->-  -- | The causing event.-  Event m r f ->+  -- | The causing events.+  [Event m r f] ->   EventBackend m r t ->   EventBackend m r s-causedEventBackend inj ev =+causedEventBackend inj evs =   narrowEventBackend inj-    . setInitialCauseEventBackend (reference ev)+    . setInitialCauseEventBackend (map reference evs)