{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE UndecidableInstances #-}

module Skeletest.Internal.Hooks (
  Hooks (..),
  defaultHooks,

  -- * Runtime
  UserHooks,
  setUserHooks,
  userHooks,

  -- * Hook implementation
  Hook (..),
  HookDef (..),
  HookPriority (..),
  runHook,

  -- * Hook DSL
  runEarly,
  runLate,
  mkHook,
  mkHook_,
  mkPreHook,
  mkPreHook_,
  mkPostHook,
  mkPostHook_,

  -- * Specific hooks

  -- ** modifySpecRegistry
  ModifySpecRegistryHook,
  ModifySpecRegistryHookContext (..),

  -- ** runTest
  RunTestHook,
  RunTestHookContext (..),

  -- ** onTestFailure
  OnTestFailureHook,
  OnTestFailureHookContext (..),

  -- ** runSpecs
  RunSpecsHook,
  RunSpecsHookContext (..),

  -- ** modifyTestSummary
  ModifyTestSummaryHook,
  ModifyTestSummaryHookContext (..),
) where

import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Text (Text)
import GHC.Records (HasField (..))
import Skeletest.Internal.Exit (TestExitCode)
import Skeletest.Internal.Hooks.HookDef
import Skeletest.Internal.Spec.Tree (SpecRegistry)
import Skeletest.Internal.TestInfo (TestInfo)
import Skeletest.Internal.TestRunner (TestResult)
import Skeletest.Internal.TestTargets (TestTargets)
import System.IO.Unsafe (unsafePerformIO)
import UnliftIO.Exception (SomeException)

-- | Hooks for extending Skeletest.
--
-- Use 'defaultHooks' instead of using v'Hooks' directly, to minimize
-- breaking changes.
data Hooks = Hooks
  { Hooks -> ModifySpecRegistryHook
modifySpecRegistry :: ModifySpecRegistryHook
  , Hooks -> RunTestHook
runTest :: RunTestHook
  , Hooks -> OnTestFailureHook
onTestFailure :: OnTestFailureHook
  , Hooks -> RunSpecsHook
runSpecs :: RunSpecsHook
  , Hooks -> ModifyTestSummaryHook
modifyTestSummary :: ModifyTestSummaryHook
  }

instance Semigroup Hooks where
  Hooks
hooks1 <> :: Hooks -> Hooks -> Hooks
<> Hooks
hooks2 =
    Hooks
      { modifySpecRegistry :: ModifySpecRegistryHook
modifySpecRegistry = Hooks
hooks1.modifySpecRegistry ModifySpecRegistryHook
-> ModifySpecRegistryHook -> ModifySpecRegistryHook
forall a. Semigroup a => a -> a -> a
<> Hooks
hooks2.modifySpecRegistry
      , runTest :: RunTestHook
runTest = Hooks
hooks1.runTest RunTestHook -> RunTestHook -> RunTestHook
forall a. Semigroup a => a -> a -> a
<> Hooks
hooks2.runTest
      , onTestFailure :: OnTestFailureHook
onTestFailure = Hooks
hooks1.onTestFailure OnTestFailureHook -> OnTestFailureHook -> OnTestFailureHook
forall a. Semigroup a => a -> a -> a
<> Hooks
hooks2.onTestFailure
      , runSpecs :: RunSpecsHook
runSpecs = Hooks
hooks1.runSpecs RunSpecsHook -> RunSpecsHook -> RunSpecsHook
forall a. Semigroup a => a -> a -> a
<> Hooks
hooks2.runSpecs
      , modifyTestSummary :: ModifyTestSummaryHook
modifyTestSummary = Hooks
hooks1.modifyTestSummary ModifyTestSummaryHook
-> ModifyTestSummaryHook -> ModifyTestSummaryHook
forall a. Semigroup a => a -> a -> a
<> Hooks
hooks2.modifyTestSummary
      }
instance Monoid Hooks where
  mempty :: Hooks
mempty = Hooks
defaultHooks

defaultHooks :: Hooks
defaultHooks :: Hooks
defaultHooks =
  Hooks
    { modifySpecRegistry :: ModifySpecRegistryHook
modifySpecRegistry = ModifySpecRegistryHook
forall a. Monoid a => a
mempty
    , runTest :: RunTestHook
runTest = RunTestHook
forall a. Monoid a => a
mempty
    , onTestFailure :: OnTestFailureHook
onTestFailure = OnTestFailureHook
forall a. Monoid a => a
mempty
    , runSpecs :: RunSpecsHook
runSpecs = RunSpecsHook
forall a. Monoid a => a
mempty
    , modifyTestSummary :: ModifyTestSummaryHook
modifyTestSummary = ModifyTestSummaryHook
forall a. Monoid a => a
mempty
    }

{----- Runtime -----}

userHooksRef :: IORef Hooks
userHooksRef :: IORef Hooks
userHooksRef = IO (IORef Hooks) -> IORef Hooks
forall a. IO a -> a
unsafePerformIO (IO (IORef Hooks) -> IORef Hooks)
-> IO (IORef Hooks) -> IORef Hooks
forall a b. (a -> b) -> a -> b
$ Hooks -> IO (IORef Hooks)
forall a. a -> IO (IORef a)
newIORef Hooks
defaultHooks

setUserHooks :: Hooks -> IO ()
setUserHooks :: Hooks -> IO ()
setUserHooks = IORef Hooks -> Hooks -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Hooks
userHooksRef

userHooks :: UserHooks
userHooks :: UserHooks
userHooks = IO UserHooks -> UserHooks
forall a. IO a -> a
unsafePerformIO (IO UserHooks -> UserHooks) -> IO UserHooks -> UserHooks
forall a b. (a -> b) -> a -> b
$ Hooks -> UserHooks
UserHooks (Hooks -> UserHooks) -> IO Hooks -> IO UserHooks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Hooks -> IO Hooks
forall a. IORef a -> IO a
readIORef IORef Hooks
userHooksRef

newtype UserHooks = UserHooks Hooks

instance
  (HasField field Hooks (Hook ctx inp out)) =>
  HasField field UserHooks (ctx -> inp -> (inp -> IO out) -> IO out)
  where
  getField :: UserHooks -> ctx -> inp -> (inp -> IO out) -> IO out
getField (UserHooks Hooks
hooks) = Hook ctx inp out -> ctx -> inp -> (inp -> IO out) -> IO out
forall ctx inp out.
Hook ctx inp out -> ctx -> inp -> (inp -> IO out) -> IO out
runHook (forall (x :: k) r a. HasField x r a => r -> a
forall {k} (x :: k) r a. HasField x r a => r -> a
getField @field Hooks
hooks)

{----- modifySpecRegistry -----}

-- | Modify the specs in the test suite.
type ModifySpecRegistryHook =
  Hook
    ModifySpecRegistryHookContext
    SpecRegistry
    SpecRegistry

data ModifySpecRegistryHookContext = ModifySpecRegistryHookContext
  { ModifySpecRegistryHookContext -> TestTargets
testTargets :: TestTargets
  }

{----- runTest -----}

-- | Modify how a test is executed
type RunTestHook =
  Hook
    RunTestHookContext
    ()
    TestResult

data RunTestHookContext = RunTestHookContext
  { RunTestHookContext -> TestInfo
testInfo :: TestInfo
  }

{----- onTestFailure -----}

-- | Modify what happens if a test fails.
type OnTestFailureHook =
  Hook
    OnTestFailureHookContext
    SomeException
    TestResult

data OnTestFailureHookContext = OnTestFailureHookContext
  { OnTestFailureHookContext -> TestInfo
testInfo :: TestInfo
  }

{----- runSpecs -----}

-- | Modify the action to run specs.
type RunSpecsHook =
  Hook
    RunSpecsHookContext
    SpecRegistry
    TestExitCode

data RunSpecsHookContext = RunSpecsHookContext
  {
  }

{----- modifyTestSummary -----}

-- | Modify the test summary at the end of the report.
type ModifyTestSummaryHook =
  Hook
    ModifyTestSummaryHookContext
    Text
    Text

data ModifyTestSummaryHookContext = ModifyTestSummaryHookContext
  {
  }