fractal-layer-0.1.0.0: src/Fractal/Layer/Interceptor.hs
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module : Fractal.Layer.Interceptor
-- Description : Observable hooks for layer construction events
-- Stability : experimental
--
-- Every 'Fractal.Layer.Layer' fires lifecycle callbacks as it acquires
-- resources, runs effects, creates services, and composes sub-layers.
-- A 'LayerInterceptor' is a record of those callbacks. Plug in your
-- own to add logging, metrics, tracing, or diagnostics without
-- modifying layer code.
--
-- The default 'nullInterceptor' is a no-op with zero overhead.
-- Combine multiple interceptors with 'combineInterceptors'.
--
-- == Example: simple logging
--
-- @
-- loggingInterceptor :: LayerInterceptor IO
-- loggingInterceptor = nullInterceptor
-- { onResourceAcquire = \\ctx ->
-- putStrLn $ \"Acquiring: \" <> show (operationName ctx)
-- , onResourceRelease = \\name ->
-- putStrLn $ \"Released: \" <> show name
-- }
-- @
module Fractal.Layer.Interceptor
( -- * Core Interface
LayerInterceptor (..),
CompositionType (..),
OperationContext (..),
-- * Built-in Interceptors
nullInterceptor,
combineInterceptors,
-- * Helper Functions
simpleContext,
withType,
withMetadata,
)
where
import Data.Text (Text)
import Data.Time.Clock (NominalDiffTime)
import Data.Typeable (TypeRep)
-------------------------------------------------------------------------------
-- Types
-------------------------------------------------------------------------------
-- | Type of layer composition
data CompositionType
= Sequential
-- ^ Sequential composition (>>>)
| Parallel
-- ^ Parallel composition (&&&)
deriving (Show, Eq)
-- | Context information about an operation
data OperationContext = OperationContext
{ operationName :: !Text
-- ^ Human-readable name of the operation
, operationType :: !(Maybe TypeRep)
-- ^ Type representation if available
, operationMetadata :: ![(Text, Text)]
-- ^ Additional metadata as key-value pairs
}
deriving (Show)
-- | Callbacks fired at each stage of layer construction.
--
-- Override individual fields from 'nullInterceptor' to observe only
-- the events you care about. Lifecycle for a 'Fractal.Layer.resource'
-- layer:
--
-- @
-- onResourceAcquire → (acquire action) → onResourceAcquireComplete
-- ⋮ ⋮
-- ⋮ ... layer is used ... ⋮
-- ⋮ ⋮
-- onResourceRelease ← (release action runs during cleanup)
-- @
data LayerInterceptor m = LayerInterceptor
{ onResourceAcquire :: OperationContext -> m ()
-- ^ Called before acquiring a resource
, onResourceAcquireComplete :: Text -> NominalDiffTime -> m ()
-- ^ Called after a resource is successfully acquired (with operation name and duration)
, onResourceRelease :: Text -> m ()
-- ^ Called when a resource finalizer actually runs during cleanup
, onEffectRun :: OperationContext -> m ()
-- ^ Called before running an effect
, onEffectComplete :: Text -> NominalDiffTime -> m ()
-- ^ Called after an effect completes
, onServiceCreate :: OperationContext -> m ()
-- ^ Called when creating a new service
, onServiceReuse :: Text -> TypeRep -> m ()
-- ^ Called when reusing a cached service
, onCompositionStart :: CompositionType -> m ()
-- ^ Called when starting a composition
, onCompositionEnd :: CompositionType -> NominalDiffTime -> m ()
-- ^ Called when completing a composition
}
-------------------------------------------------------------------------------
-- Built-in Interceptors
-------------------------------------------------------------------------------
-- | All-no-op interceptor. This is the default when no interceptor is
-- specified; all callbacks immediately return @pure ()@.
nullInterceptor :: Applicative m => LayerInterceptor m
nullInterceptor =
LayerInterceptor
{ onResourceAcquire = \_ -> pure ()
, onResourceAcquireComplete = \_ _ -> pure ()
, onResourceRelease = \_ -> pure ()
, onEffectRun = \_ -> pure ()
, onEffectComplete = \_ _ -> pure ()
, onServiceCreate = \_ -> pure ()
, onServiceReuse = \_ _ -> pure ()
, onCompositionStart = \_ -> pure ()
, onCompositionEnd = \_ _ -> pure ()
}
-- | Fan out each event to every interceptor in order.
-- If a callback throws, later interceptors for that event are skipped.
combineInterceptors :: Monad m => [LayerInterceptor m] -> LayerInterceptor m
combineInterceptors interceptors =
LayerInterceptor
{ onResourceAcquire = \ctx -> mapM_ (\i -> onResourceAcquire i ctx) interceptors
, onResourceAcquireComplete = \name dur -> mapM_ (\i -> onResourceAcquireComplete i name dur) interceptors
, onResourceRelease = \name -> mapM_ (\i -> onResourceRelease i name) interceptors
, onEffectRun = \ctx -> mapM_ (\i -> onEffectRun i ctx) interceptors
, onEffectComplete = \name dur -> mapM_ (\i -> onEffectComplete i name dur) interceptors
, onServiceCreate = \ctx -> mapM_ (\i -> onServiceCreate i ctx) interceptors
, onServiceReuse = \name tr -> mapM_ (\i -> onServiceReuse i name tr) interceptors
, onCompositionStart = \typ -> mapM_ (\i -> onCompositionStart i typ) interceptors
, onCompositionEnd = \typ dur -> mapM_ (\i -> onCompositionEnd i typ dur) interceptors
}
-------------------------------------------------------------------------------
-- Helper Functions
-------------------------------------------------------------------------------
-- | Create a simple operation context with just a name
simpleContext :: Text -> OperationContext
simpleContext name =
OperationContext
{ operationName = name
, operationType = Nothing
, operationMetadata = []
}
-- | Add type information to a context
withType :: TypeRep -> OperationContext -> OperationContext
withType tr ctx = ctx {operationType = Just tr}
-- | Add metadata to a context
withMetadata :: [(Text, Text)] -> OperationContext -> OperationContext
withMetadata meta ctx = ctx {operationMetadata = operationMetadata ctx ++ meta}