    -- |
    -- 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))