eventuo11y 0.7.0.0 → 0.7.1.0

raw patch · 3 files changed

+214/−1 lines, 3 filesdep +timePVP ok

version bump matches the API change (PVP)

Dependencies added: time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• eventuo11y.cabal +3/−1
• src/Observe/Event/Render/InMemory.hs +207/−0

@@ -1,5 +1,9 @@ # Revision history for eventuo11y +## 0.7.1.0 -- 2023-01-14++- Add `Observe.Event.Render.InMemory`+ ## 0.7.0.0 -- 2023-01-13  - Use `NewEventArgs` as the basic way to initialize a new `Event`.

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               eventuo11y-version:            0.7.0.0+version:            0.7.1.0 synopsis:           An event-oriented observability library description:   Instrument your Haskell codebase with wide, semantically meaningful events.@@ -62,12 +62,14 @@     Observe.Event.Backend     Observe.Event.Class     Observe.Event.Explicit+    Observe.Event.Render.InMemory    build-depends:     , base              ^>= { 4.14, 4.16, 4.17 }     , exceptions        ^>= { 0.10 }     , general-allocate  ^>= { 0.2 }     , primitive         ^>= { 0.7 }+    , time              ^>= { 1.11, 1.12 }     , transformers      ^>= { 0.5, 0.6 }     , transformers-base ^>= { 0.4 }     , monad-control     ^>= { 1.0 }

@@ -0,0 +1,207 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneKindSignatures #-}++-- |+-- Description : EventBackend for rendering events as Haskell values+-- Copyright   : Copyright 2023 Shea Levy.+-- License     : Apache-2.0+-- Maintainer  : shea@shealevy.com+module Observe.Event.Render.InMemory+  ( listInMemoryBackend,+    timelessListInMemoryBackend,+    inMemoryBackend,++    -- * MemoryEvent+    MemoryEvent (..),+    TimedEventAction (..),+    EventAction (..),++    -- * Effects++    -- ** InMemoryEffects+    InMemoryEffects (..),+    hoistInMemoryEffects,+    listInMemoryEffects,+    timelessListInMemoryEffects,++    -- ** AppendVectorEffects+    AppendVectorEffects (..),+    hoistAppendVectorEffects,+    ListAppendVector (..),+    listAppendVectorEffects,++    -- ** TimestampEffects+    TimestampEffects (..),+    hoistTimestampEffects,+    dummyTimestampEffects,+    ioTimestampEffects,+  )+where++import Control.Exception+import Control.Monad.IO.Class+import Control.Monad.Primitive+import Data.Kind+import Data.Primitive.MutVar+import Data.Time.Clock+import Observe.Event.Backend++-- | An 'EventBackend' whose 'Event's are essentially plain Haskell values.+--+-- The 'reference' of an 'Event' from this 'EventBackend' will be a 'MemoryEvent',+-- which can be examined to extract information about the 'Event'.+listInMemoryBackend :: (PrimMonad m, MonadIO m) => EventBackend m (MemoryEvent m (ListAppendVector m) UTCTime s) s+listInMemoryBackend = inMemoryBackend listInMemoryEffects++-- | An 'EventBackend' whose 'Event's are essentially plain Haskell values.+--+-- The 'reference' of an 'Event' from this 'EventBackend' will be a 'MemoryEvent',+-- which can be examined to extract information about the 'Event'.+timelessListInMemoryBackend :: (PrimMonad m) => EventBackend m (MemoryEvent m (ListAppendVector m) () s) s+timelessListInMemoryBackend = inMemoryBackend timelessListInMemoryEffects++-- | An 'EventBackend' whose 'Event's are essentially plain Haskell values.+--+-- The 'reference' of an 'Event' from this 'EventBackend' will be a 'MemoryEvent',+-- which can be examined to extract information about the 'Event'.+--+-- [@appvec@]: An append-only vector type, see 'AppendVectorEffects'+-- [@ts@]: A timestamp, see 'TimestampEffects'+inMemoryBackend :: (Monad m) => InMemoryEffects m appvec ts -> EventBackend m (MemoryEvent m appvec ts s) s+inMemoryBackend InMemoryEffects {..} =+  EventBackend+    { newEvent = \initArgs -> do+        start <- getTimestamp+        dynamicValues <- newVector+        pure $+          Event+            { reference = MemoryEvent {dynamicValues = Just dynamicValues, ..},+              addField = \f -> do+                when <- getTimestamp+                appendVector dynamicValues $ TimedEventAction {act = AddField f, ..},+              finalize = \me -> do+                when <- getTimestamp+                appendVector dynamicValues $ TimedEventAction {act = Finalize me, ..}+            },+      emitImmediateEvent = \initArgs -> do+        start <- getTimestamp+        pure $ MemoryEvent {dynamicValues = Nothing, ..}+    }+  where+    AppendVectorEffects {..} = appendVectorEffects+    TimestampEffects {..} = timestampEffects++-- | An plain data type representing an 'Event'+--+-- [@appvec@]: An append-only vector type, see 'AppendVectorEffects'+-- [@ts@]: A timestamp, see 'TimestampEffects'+type MemoryEvent :: (Type -> Type) -> (Type -> Type) -> Type -> (Type -> Type) -> Type+data MemoryEvent m appvec ts s = forall f.+  MemoryEvent+  { -- | The arguments the 'Event' was initialized with+    initArgs :: !(NewEventArgs (MemoryEvent m appvec ts s) s f),+    -- | The start time of the 'Event'+    start :: !ts,+    -- | Event information added during the event's lifecycle+    --+    -- 'Nothing' if this was the result of 'emitImmediateEvent' and thus had no lifecycle+    dynamicValues :: !(Maybe (appvec (TimedEventAction ts f)))+  }++-- | An action that occurred during an 'Event' at some time.+--+-- [@ts@]: A timestamp, see 'TimestampEffects'+data TimedEventAction ts f = TimedEventAction+  { -- | When the event occurred+    when :: !ts,+    -- | The action that occurred+    act :: !(EventAction f)+  }++-- | An action on an 'Event'+data EventAction f+  = -- | A field was added with 'addField'+    AddField !f+  | -- | The 'Event' was finalized with 'finalize'+    Finalize !(Maybe SomeException)++-- | Monadic effects needed to construct an 'inMemoryBackend'+--+-- [@appvec@]: An append-only vector type, see 'AppendVectorEffects'+-- [@ts@]: A timestamp, see 'TimestampEffects'+data InMemoryEffects m appvec ts = InMemoryEffects+  { -- | Manipulate append-only vectors+    appendVectorEffects :: !(AppendVectorEffects m appvec),+    -- | Get timestamps+    timestampEffects :: !(TimestampEffects m ts)+  }++-- | Hoist 'InMemoryEffects' along a given natural transformation into a new monad+hoistInMemoryEffects :: (forall x. m x -> n x) -> InMemoryEffects m appvec ts -> InMemoryEffects n appvec ts+hoistInMemoryEffects nt (InMemoryEffects {..}) =+  InMemoryEffects+    { appendVectorEffects = hoistAppendVectorEffects nt appendVectorEffects,+      timestampEffects = hoistTimestampEffects nt timestampEffects+    }++-- | 'InMemoryEffects' based on 'listAppendVectorEffects' and 'ioTimestampEffects'.+listInMemoryEffects :: (PrimMonad m, MonadIO m) => InMemoryEffects m (ListAppendVector m) UTCTime+listInMemoryEffects =+  InMemoryEffects+    { appendVectorEffects = listAppendVectorEffects,+      timestampEffects = hoistTimestampEffects liftIO ioTimestampEffects+    }++-- | 'InMemoryEffects' based on 'listAppendVectorEffects' with meaningless timestamps.+timelessListInMemoryEffects :: (PrimMonad m) => InMemoryEffects m (ListAppendVector m) ()+timelessListInMemoryEffects =+  InMemoryEffects+    { appendVectorEffects = listAppendVectorEffects,+      timestampEffects = dummyTimestampEffects+    }++-- | Monadic effects to manipulate append-only vectors.+data AppendVectorEffects m appvec = AppendVectorEffects+  { -- | Create a new vector+    newVector :: !(forall a. m (appvec a)),+    -- | Append a value to a vector+    appendVector :: !(forall a. appvec a -> a -> m ())+  }++-- | Hoist 'AppendVectorEffects' along a given natural transformation into a new monad+hoistAppendVectorEffects :: (forall x. m x -> n x) -> AppendVectorEffects m appvec -> AppendVectorEffects n appvec+hoistAppendVectorEffects nt (AppendVectorEffects {..}) =+  AppendVectorEffects+    { newVector = nt $ newVector,+      appendVector = \v -> nt . appendVector v+    }++-- | An append-only vector in some 'PrimMonad' based on lists.+newtype ListAppendVector m a = ListAppendVector (MutVar (PrimState m) [a])++-- | 'AppendVectorEffects' in some 'PrimMonad' based on lists.+listAppendVectorEffects :: (PrimMonad m) => AppendVectorEffects m (ListAppendVector m)+listAppendVectorEffects =+  AppendVectorEffects+    { newVector = ListAppendVector <$> newMutVar [],+      appendVector = \(ListAppendVector v) x -> atomicModifyMutVar v (\l -> (x : l, ()))+    }++-- | Monadic effects to manage timestamps.+newtype TimestampEffects m ts = TimestampEffects+  { getTimestamp :: m ts+  }++-- | Hoist 'TimestampEffects' along a given natural transformation into a new monad+hoistTimestampEffects :: (forall x. m x -> n x) -> TimestampEffects m ts -> TimestampEffects n ts+hoistTimestampEffects nt (TimestampEffects {..}) = TimestampEffects $ nt getTimestamp++-- | 'TimestampEffects' with meaningless timestamps.+dummyTimestampEffects :: (Applicative m) => TimestampEffects m ()+dummyTimestampEffects = TimestampEffects $ pure ()++-- | 'TimestampEffects' using the system clock+ioTimestampEffects :: TimestampEffects IO UTCTime+ioTimestampEffects = TimestampEffects getCurrentTime