{-# LANGUAGE ExistentialQuantification #-}

-- | Test vector support for tasty.

module Test.Tasty.TestVector (
    testVectors
  ) where

import Data.Bifunctor
import Data.List (intercalate, partition)
import Test.Tasty.Providers
import Data.Typeable
import Text.Printf

data TV =
    forall a b . Show a => TV (a -> b -> Bool) [(a, b)]
  deriving Typeable

-- | Turn a function and a list of parameters for it into a single tasty test.
--
--   Any specific failing test vectors are reported individually by showing the
--   first part of the test vector tuple.
testVectors :: Show a => TestName -> (a -> b -> Bool) -> [(a, b)] -> TestTree
testVectors name f vs = singleTest name $ TV f vs

instance IsTest TV where
    testOptions = pure mempty
    run _opts (TV f vs) _yieldProgress = do
      let failed = map fst . filter (not.uncurry f) $ vs
      pure $ if null failed
             then testPassed $ printf "+++ OK, passed %d test vectors." (length vs)
             else testFailed $
                  printf "*** FAILED! Failed %d/%d tests, failed on:\n%s"
                  (length failed) (length vs) $
                  intercalate "\n" $
                  map show failed