packages feed

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}