freckle-memcached-0.0.0.2: tests/AppExample.hs

module AppExample
  ( AppExample (..)
  , appExample
  , withApp
  ) where

import Prelude

import Blammo.Logging (MonadLogger, MonadLoggerIO)
import Blammo.Logging.Setup (WithLogger (..))
import Control.Lens (view)
import Control.Monad.Catch
import Control.Monad.Reader (MonadReader, ReaderT (..))
import Data.Functor (void)
import Freckle.App.Dotenv qualified as Dotenv
import OpenTelemetry.Trace (HasTracer (..))
import OpenTelemetry.Trace.Monad (MonadTracer (..))
import Test.Hspec (Spec, SpecWith, aroundAll, beforeAll)
import Test.Hspec.Core.Spec (Example (..))
import UnliftIO

withApp :: ((app -> IO ()) -> IO ()) -> SpecWith app -> Spec
withApp run = beforeAll Dotenv.loadTest . aroundAll run

-- | An Hspec example over some @app@ value
newtype AppExample app a = AppExample
  { unAppExample :: ReaderT app IO a
  }
  deriving newtype
    ( Applicative
    , Functor
    , Monad
    , MonadCatch
    , MonadIO
    , MonadUnliftIO
    , MonadReader app
    , MonadThrow
    , MonadFail
    )
  deriving
    (MonadLogger, MonadLoggerIO)
    via WithLogger app IO

instance MonadMask (AppExample app) where
  mask = UnliftIO.mask
  uninterruptibleMask = UnliftIO.uninterruptibleMask
  generalBracket acquire release use = UnliftIO.mask $ \unmasked -> do
    resource <- acquire
    b <-
      unmasked (use resource) `UnliftIO.catch` \e -> do
        _ <- release resource (ExitCaseException e)
        throwM e

    c <- release resource (ExitCaseSuccess b)
    pure (b, c)

instance Example (AppExample app a) where
  type Arg (AppExample app a) = app

  evaluateExample (AppExample ex) params action =
    evaluateExample
      (action $ \app -> void $ runReaderT ex app)
      params
      ($ ())

instance HasTracer app => MonadTracer (AppExample app) where
  getTracer = view tracerL

appExample :: AppExample app a -> AppExample app a
appExample = id