fb-util-0.1.0.1: Util/Logger.hs

{-
  Copyright (c) Meta Platforms, Inc. and affiliates.
  All rights reserved.

  This source code is licensed under the BSD-style license found in the
  LICENSE file in the root directory of this source tree.
-}

module Util.Logger
  ( ActionLog(..)
  , loggingAction ) where

import Control.Exception
import Data.Int

import Util.Control.Exception (swallow)
import Util.Timing (timeIt)
import GHC.Stack (HasCallStack, withFrozenCallStack)

-- | Logs which can log success, failure and time elapsed
class ActionLog l where
  successLog :: l
  failureLog :: SomeException -> l
  timeLog :: Double -> l
  allocLog :: Int64 -> l

-- | Run an action logging success, failure, time elapsed and data about
-- result.
loggingAction
  :: (ActionLog l, Monoid l, HasCallStack)
  => (l -> IO ())
     -- ^ How to write the log. Typically calls the `runLog` for your
     -- `Logger` instance, and it can augment `l` with additional
     -- information known about this action.
  -> (a -> l)
     -- ^ What to log based on the result of the action
  -> IO a
     -- ^ The action to run
  -> IO a
loggingAction log res io =
  mask $ \restore -> do
    (time,alloc,result) <- timeIt $ try $ restore io
    let
      logOutcome o =
        withFrozenCallStack $
          swallow $ log $ timeLog time `mappend` allocLog alloc `mappend` o
    case result of
      Right x -> do
        logOutcome $ successLog `mappend` res x
        return x
      Left ex -> do
        logOutcome $ failureLog ex
        throwIO ex