module Test.Framework.Providers.Feat (testFeat) where
import Test.Framework.Providers.API
import Test.Feat (values, Enumerable)
import Control.Arrow (second)
import Data.Typeable
import Debug.Trace
testFeat :: (Enumerable a, Show a) => TestName -> (a -> Bool) -> Test
testFeat name = Test name . Property
type PropertyTestCount = Int
instance TestResultlike PropertyTestCount PropertyStatus where
testSucceeded = propertySucceeded
data PropertyStatus = PropertyOK
| PropertyFalsifiable String
deriving(Eq)
instance Show PropertyStatus where
show PropertyOK = "Property OK"
show (PropertyFalsifiable x) = "Property failed with " ++ x
propertySucceeded :: PropertyStatus -> Bool
propertySucceeded s = case s of
PropertyOK -> True
_ -> False
data Property = forall a. (Enumerable a, Show a) => Property { unProperty :: a -> Bool }
deriving Typeable
instance Testlike PropertyTestCount PropertyStatus Property where
runTest topts (Property testable) = runProperty topts testable
testTypeName _ = "Properties"
traceIt x = trace (show x) x
runProperty :: (Enumerable a, Show a)
=> CompleteTestOptions
-> (a -> Bool)
-> IO (PropertyTestCount :~> PropertyStatus, IO ())
runProperty topts test = do
let K count = topt_maximum_generated_tests topts
toValues :: (Enumerable a, Show a) => (a -> Bool) -> [(Integer, [a])] -> [(Integer, [a])]
toValues _ xs = xs
values' = toValues test values
samples = take count . concatMap (\(i, xs) -> zip (repeat i) xs) . take count $ values'
results = map (second test) samples
case map fst . filter ((==False) . snd . snd) . zip samples $ results of
[] -> return (Finished PropertyOK, return ())
x:_ -> return . (, return ()) . Finished . PropertyFalsifiable . show $ x