module Test.Torch.Hook (
  asHook
, onPass, onFail, beforeTest, afterTest
, zeroHook
) where

import Control.Monad.Writer
import Data.Monoid

import Test.Torch.Types

newtype HookWriter a = HookWriter { runHookWriter :: Writer Hook a }
    deriving (Monad, MonadWriter Hook)

onPass :: IO () -> HookWriter ()
onPass m = tell $ zeroHook { hook_Pass = m }

onFail :: (SomeFailure -> IO ()) -> HookWriter ()
onFail m = tell $ zeroHook { hook_Fail = m }

beforeTest :: (Tests -> IO ()) -> HookWriter ()
beforeTest m = tell $ zeroHook { hook_Pre = m }

afterTest :: (Report -> IO ()) -> HookWriter ()
afterTest m = tell $ zeroHook { hook_Post = m }

asHook :: HookWriter a -> Hook
asHook = execWriter . runHookWriter

zeroHook :: Hook
zeroHook = Hook m m' m' m'
    where m  = return ()
          m' = const m

instance Monoid Hook where
    mempty = zeroHook
    mappend h h' = Hook {
                       hook_Pass = hook_Pass h >> hook_Pass h'
                     , hook_Fail = \f -> hook_Fail h f >> hook_Fail h' f
                     , hook_Pre  = \ts -> hook_Pre h ts >> hook_Pre h' ts
                     , hook_Post = \rp -> hook_Post h rp >> hook_Post h rp
                     }