-- |
-- Module      : Foundation.Check
-- License     : BSD-style
-- Maintainer  : Foundation maintainers
--
-- An implementation of a test framework
-- and property expression & testing
--
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE GADTs #-}
module Foundation.Check
    ( Gen
    , Arbitrary(..)
    , oneof
    , elements
    , frequency
    , between
    -- test
    , Test(..)
    , testName
    -- * Property
    , PropertyCheck
    , Property(..)
    , IsProperty(..)
    , (===)
    , propertyCompare
    , propertyCompareWith
    , propertyAnd
    , propertyFail
    , forAll
    -- * Check Plan
    , Check
    , validate
    , pick
    , iterateProperty
    ) where

import           Basement.Imports
import           Basement.Cast (cast)
import           Basement.IntegralConv
import           Basement.Types.OffsetSize
import           Foundation.Check.Gen
import           Foundation.Check.Arbitrary
import           Foundation.Check.Property
import           Foundation.Check.Types
import           Foundation.Check.Print
import           Foundation.Monad
import           Foundation.Monad.State
import           Foundation.Numerical
import           Control.Exception (evaluate, SomeException)

validate :: IsProperty prop => String -> prop -> Check ()
validate :: forall prop. IsProperty prop => String -> prop -> Check ()
validate String
propertyName prop
prop = StateT PlanState IO () -> Check ()
forall a. StateT PlanState IO a -> Check a
Check (StateT PlanState IO () -> Check ())
-> StateT PlanState IO () -> Check ()
forall a b. (a -> b) -> a -> b
$ do
    (Word64 -> GenRng
genrng, GenParams
params) <- (State (StateT PlanState IO)
 -> ((Word64 -> GenRng, GenParams), State (StateT PlanState IO)))
-> StateT PlanState IO (Word64 -> GenRng, GenParams)
forall a.
(State (StateT PlanState IO) -> (a, State (StateT PlanState IO)))
-> StateT PlanState IO a
forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState ((State (StateT PlanState IO)
  -> ((Word64 -> GenRng, GenParams), State (StateT PlanState IO)))
 -> StateT PlanState IO (Word64 -> GenRng, GenParams))
-> (State (StateT PlanState IO)
    -> ((Word64 -> GenRng, GenParams), State (StateT PlanState IO)))
-> StateT PlanState IO (Word64 -> GenRng, GenParams)
forall a b. (a -> b) -> a -> b
$ \State (StateT PlanState IO)
st -> ( (PlanState -> Word64 -> GenRng
planRng State (StateT PlanState IO)
PlanState
st, PlanState -> GenParams
planParams State (StateT PlanState IO)
PlanState
st)
                                           , State (StateT PlanState IO)
st { planValidations = planValidations st + 1 }
                                           )
    (PropertyResult
r,CountOf TestResult
nb) <- IO (PropertyResult, CountOf TestResult)
-> StateT PlanState IO (PropertyResult, CountOf TestResult)
forall a. IO a -> StateT PlanState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PropertyResult, CountOf TestResult)
 -> StateT PlanState IO (PropertyResult, CountOf TestResult))
-> IO (PropertyResult, CountOf TestResult)
-> StateT PlanState IO (PropertyResult, CountOf TestResult)
forall a b. (a -> b) -> a -> b
$ CountOf TestResult
-> GenParams
-> (Word64 -> GenRng)
-> Property
-> IO (PropertyResult, CountOf TestResult)
iterateProperty CountOf TestResult
100 GenParams
params Word64 -> GenRng
genrng (prop -> Property
forall p. IsProperty p => p -> Property
property prop
prop)
    case PropertyResult
r of
        PropertyResult
PropertySuccess        -> () -> StateT PlanState IO ()
forall a. a -> StateT PlanState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        PropertyFailed String
failMsg -> do
            (State (StateT PlanState IO) -> ((), State (StateT PlanState IO)))
-> StateT PlanState IO ()
forall a.
(State (StateT PlanState IO) -> (a, State (StateT PlanState IO)))
-> StateT PlanState IO a
forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState ((State (StateT PlanState IO) -> ((), State (StateT PlanState IO)))
 -> StateT PlanState IO ())
-> (State (StateT PlanState IO)
    -> ((), State (StateT PlanState IO)))
-> StateT PlanState IO ()
forall a b. (a -> b) -> a -> b
$ \State (StateT PlanState IO)
st -> ((), State (StateT PlanState IO)
st { planFailures = PropertyResult propertyName nb (PropertyFailed failMsg) : planFailures st })
            () -> StateT PlanState IO ()
forall a. a -> StateT PlanState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

pick :: String -> IO a -> Check a
pick :: forall a. String -> IO a -> Check a
pick String
_ IO a
io = StateT PlanState IO a -> Check a
forall a. StateT PlanState IO a -> Check a
Check (StateT PlanState IO a -> Check a)
-> StateT PlanState IO a -> Check a
forall a b. (a -> b) -> a -> b
$ do
    -- TODO catch most exception to report failures
    a
r <- IO a -> StateT PlanState IO a
forall a. IO a -> StateT PlanState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io
    a -> StateT PlanState IO a
forall a. a -> StateT PlanState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r

iterateProperty :: CountOf TestResult ->  GenParams -> (Word64 -> GenRng) -> Property -> IO (PropertyResult, CountOf TestResult)
iterateProperty :: CountOf TestResult
-> GenParams
-> (Word64 -> GenRng)
-> Property
-> IO (PropertyResult, CountOf TestResult)
iterateProperty CountOf TestResult
limit GenParams
genParams Word64 -> GenRng
genRngIter Property
prop = CountOf TestResult -> IO (PropertyResult, CountOf TestResult)
iterProp CountOf TestResult
1
  where
    iterProp :: CountOf TestResult -> IO (PropertyResult, CountOf TestResult)
iterProp !CountOf TestResult
iter
      | CountOf TestResult
iter CountOf TestResult -> CountOf TestResult -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf TestResult
limit = (PropertyResult, CountOf TestResult)
-> IO (PropertyResult, CountOf TestResult)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PropertyResult
PropertySuccess, CountOf TestResult
iter)
      | Bool
otherwise  = do
          (PropertyResult, Bool)
r <- IO (PropertyResult, Bool) -> IO (PropertyResult, Bool)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (PropertyResult, Bool)
toResult
          case (PropertyResult, Bool)
r of
              (PropertyFailed String
e, Bool
_)               -> (PropertyResult, CountOf TestResult)
-> IO (PropertyResult, CountOf TestResult)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PropertyResult
PropertyFailed String
e, CountOf TestResult
iter)
              (PropertyResult
PropertySuccess, Bool
cont) | Bool
cont      -> CountOf TestResult -> IO (PropertyResult, CountOf TestResult)
iterProp (CountOf TestResult
iterCountOf TestResult -> CountOf TestResult -> CountOf TestResult
forall a. Additive a => a -> a -> a
+CountOf TestResult
1)
                                      | Bool
otherwise -> (PropertyResult, CountOf TestResult)
-> IO (PropertyResult, CountOf TestResult)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PropertyResult
PropertySuccess, CountOf TestResult
iter)
        where
          iterW64 :: Word64
          iterW64 :: Word64
iterW64 = let (CountOf Int
iter') = CountOf TestResult
iter in Int64 -> Word64
forall source destination.
Cast source destination =>
source -> destination
cast (Int -> Int64
forall a b. IntegralUpsize a b => a -> b
integralUpsize Int
iter' :: Int64)

          -- TODO revisit to let through timeout and other exception like ctrl-c or thread killing.
          toResult :: IO (PropertyResult, Bool)
          toResult :: IO (PropertyResult, Bool)
toResult = (PropertyTestArg -> (PropertyResult, Bool)
propertyToResult (PropertyTestArg -> (PropertyResult, Bool))
-> IO PropertyTestArg -> IO (PropertyResult, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PropertyTestArg -> IO PropertyTestArg
forall a. a -> IO a
evaluate (Gen PropertyTestArg -> GenRng -> GenParams -> PropertyTestArg
forall a. Gen a -> GenRng -> GenParams -> a
runGen (Property -> Gen PropertyTestArg
unProp Property
prop) (Word64 -> GenRng
genRngIter Word64
iterW64) GenParams
genParams))
            IO (PropertyResult, Bool)
-> (SomeException -> IO (PropertyResult, Bool))
-> IO (PropertyResult, Bool)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(SomeException
e :: SomeException) -> (PropertyResult, Bool) -> IO (PropertyResult, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PropertyResult
PropertyFailed (SomeException -> String
forall a. Show a => a -> String
show SomeException
e), Bool
False))