module Test.Torch.Report (
  Report (..)
, makeReportWithHook
, zeroHook
) where

import Control.Monad (foldM)
import Control.Monad.Trans (MonadIO, liftIO)

import Test.Torch.Types
import Test.Torch.Hook (zeroHook)

makeReportWithHook :: (MonadIO io) => Tests -> Hook -> io Report
makeReportWithHook tests hook = do
  invoke_preTest tests
  report <- make_report tests hook
  invoke_postTest report
  return report
    where invoke_preTest              = invoke_hook hook_Pre
          invoke_postTest             = invoke_hook hook_Post
          invoke_hook hook_getter arg = liftIO (hook_getter hook arg)

make_report :: (MonadIO io) => Tests -> Hook -> io Report
make_report tests hook = liftIO $ foldM go (Report 0 0 0 []) tests
    where go report (SomeTest test) = do
            result <- run test
            case result of
              Pass   -> hook_Pass hook >>
                        modify_report (inc_plan . inc_pass) report
              Fail f -> let failure = SomeFailure f in
                        hook_Fail hook failure >>
                        modify_report (inc_plan . inc_fail . app_failure failure) report
          modify_report f report = return $ f report
          inc_pass r = r { passed = passed r + 1 }
          inc_fail r = r { failed = failed r + 1 }
          inc_plan r = r { planed = planed r + 1 }
          app_failure f r = r { failures = failures r ++ [f] }