module Test.Torch.Build (
  addTest

, getTests

, ok, notOk
, is, isn't

, isBottom, isn'tBottom

, Builder, runBuilder
) where

import Control.Monad.Writer
import Control.Monad.Trans (MonadIO)
import Control.Parallel.Strategies (NFData)

import Test.Torch.Types
import Test.Torch.Types.Instances


{- Test Builder -}

-- Test builder is implemented by writer
newtype Builder a = Builder { runBuilder :: WriterT Tests IO a }
  deriving (Monad, MonadIO, MonadWriter Tests)

getTests :: Builder a -> IO Tests
getTests = execWriterT . runBuilder


{- Utilities for Test Building -}

addTest :: (Test t) => t -> Builder ()
addTest = tell . (:[]) . SomeTest


ok    :: Bool -> String -> Builder ()
notOk :: Bool -> String -> Builder ()

{-^

  'ok' and 'notOk' are test for assertion, take a Bool value, and then
  check whether the value is equal to True or False.

  > ok    True  "'ok' succeeds if given value is True"
  > notOk False "'notOk' succeeds if given value is False"

  Second String argument is the test's name, this is used for telling
  you what test failed if test was failed usually (and every
  predefined tests in this module, requires test's name).

 -}

ok b n  = addTest $ mk_named n $ mk_ok b
notOk b = ok (not b)


is    :: (Eq a, Show a) => a -> a -> String -> Builder ()
isn't :: (Eq a, Show a) => a -> a -> String -> Builder ()

{-^

  'is' and 'isn't' are test for equality. First argument is treated
  as gotten value, and second is expected value.

  > is    1 1 "test that checks 1 == 1"
  > isn't 1 2 "test that checks 1 /= 2"
  > is (fact 10) 3628800 "check if factorial function works..."

 -}

is    a b n = addTest $ mk_named n $ mk_is True  a b
isn't a b n = addTest $ mk_named n $ mk_is False a b

isBottom    :: (NFData a) => a -> String -> Builder ()
isn'tBottom :: (NFData a) => a -> String -> Builder ()


{-^

  'isBottom' and 'isn'tBottom' evaluates given value, and check if it
  is Bottom (undefined, error, or some exeptions).

  > isBottom undefined "for example, this test succeeds"

 -}

isBottom    a n = addTest $ mk_named n $ mk_isBottom True  a
isn'tBottom a n = addTest $ mk_named n $ mk_isBottom False a

{- Local Utilities -}

mk_named :: (Test t) => String -> t -> Named
mk_named = Named

mk_ok :: Bool -> Ok
mk_ok = Ok

mk_is :: (Eq a, Show a) => Bool -> a -> a -> Is
mk_is = Is

mk_isBottom :: (NFData a) => Bool -> a -> IsBottom
mk_isBottom = IsBottom