-- |
-- 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 = forall a. StateT PlanState IO a -> Check a
Check forall a b. (a -> b) -> a -> b
$ do
    (Word64 -> GenRng
genrng, GenParams
params) <- forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState forall a b. (a -> b) -> a -> b
$ \State (StateT PlanState IO)
st -> ( (PlanState -> Word64 -> GenRng
planRng State (StateT PlanState IO)
st, PlanState -> GenParams
planParams State (StateT PlanState IO)
st)
                                           , State (StateT PlanState IO)
st { planValidations :: CountOf TestResult
planValidations = PlanState -> CountOf TestResult
planValidations State (StateT PlanState IO)
st forall a. Additive a => a -> a -> a
+ CountOf TestResult
1 }
                                           )
    (PropertyResult
r,CountOf TestResult
nb) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 (forall p. IsProperty p => p -> Property
property prop
prop)
    case PropertyResult
r of
        PropertyResult
PropertySuccess        -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        PropertyFailed String
failMsg -> do
            forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState forall a b. (a -> b) -> a -> b
$ \State (StateT PlanState IO)
st -> ((), State (StateT PlanState IO)
st { planFailures :: [TestResult]
planFailures = String -> CountOf TestResult -> PropertyResult -> TestResult
PropertyResult String
propertyName CountOf TestResult
nb (String -> PropertyResult
PropertyFailed String
failMsg) forall a. a -> [a] -> [a]
: PlanState -> [TestResult]
planFailures State (StateT PlanState IO)
st })
            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 = forall a. StateT PlanState IO a -> Check a
Check forall a b. (a -> b) -> a -> b
$ do
    -- TODO catch most exception to report failures
    a
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io
    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 forall a. Eq a => a -> a -> Bool
== CountOf TestResult
limit = forall (m :: * -> *) a. Monad m => a -> m a
return (PropertyResult
PropertySuccess, CountOf TestResult
iter)
      | Bool
otherwise  = do
          (PropertyResult, Bool)
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (PropertyResult, Bool)
toResult
          case (PropertyResult, Bool)
r of
              (PropertyFailed String
e, Bool
_)               -> 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
iterforall a. Additive a => a -> a -> a
+CountOf TestResult
1)
                                      | Bool
otherwise -> 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 forall source destination.
Cast source destination =>
source -> destination
cast (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO a
evaluate (forall a. Gen a -> GenRng -> GenParams -> a
runGen (Property -> Gen PropertyTestArg
unProp Property
prop) (Word64 -> GenRng
genRngIter Word64
iterW64) GenParams
genParams))
            forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(SomeException
e :: SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PropertyResult
PropertyFailed (forall a. Show a => a -> String
show SomeException
e), Bool
False))