-- |
-- Module      : Foundation.Check.Types
-- License     : BSD-style
-- Maintainer  : Foundation maintainers
--
-- A implementation of a test framework
-- and property expression & testing
--
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Foundation.Check.Types
    ( Test(..)
    , testName
    , fqTestName
    , groupHasSubGroup
    , Check(..)
    , PlanState(..)
    , PropertyResult(..)
    , TestResult(..)
    , HasFailures
    ) where

import           Basement.Imports
import           Foundation.Collection
import           Foundation.Monad.State
import           Foundation.Check.Property
import           Foundation.Check.Gen

-- | Result of a property run
data PropertyResult =
      PropertySuccess
    | PropertyFailed  String
    deriving (Int -> PropertyResult -> ShowS
[PropertyResult] -> ShowS
PropertyResult -> String
(Int -> PropertyResult -> ShowS)
-> (PropertyResult -> String)
-> ([PropertyResult] -> ShowS)
-> Show PropertyResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PropertyResult -> ShowS
showsPrec :: Int -> PropertyResult -> ShowS
$cshow :: PropertyResult -> String
show :: PropertyResult -> String
$cshowList :: [PropertyResult] -> ShowS
showList :: [PropertyResult] -> ShowS
Show,PropertyResult -> PropertyResult -> Bool
(PropertyResult -> PropertyResult -> Bool)
-> (PropertyResult -> PropertyResult -> Bool) -> Eq PropertyResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PropertyResult -> PropertyResult -> Bool
== :: PropertyResult -> PropertyResult -> Bool
$c/= :: PropertyResult -> PropertyResult -> Bool
/= :: PropertyResult -> PropertyResult -> Bool
Eq)

-- | Name of a test Followed
data TestResult =
      PropertyResult String HasTests       PropertyResult
    | GroupResult    String HasFailures HasTests [TestResult]
    deriving (Int -> TestResult -> ShowS
[TestResult] -> ShowS
TestResult -> String
(Int -> TestResult -> ShowS)
-> (TestResult -> String)
-> ([TestResult] -> ShowS)
-> Show TestResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestResult -> ShowS
showsPrec :: Int -> TestResult -> ShowS
$cshow :: TestResult -> String
show :: TestResult -> String
$cshowList :: [TestResult] -> ShowS
showList :: [TestResult] -> ShowS
Show)

-- | number of tests and failures
type HasTests    = CountOf TestResult
type HasFailures = CountOf TestResult

data PlanState = PlanState
    { PlanState -> Word64 -> GenRng
planRng         :: Word64 -> GenRng
    , PlanState -> HasTests
planValidations :: CountOf TestResult
    , PlanState -> GenParams
planParams      :: GenParams
    , PlanState -> [TestResult]
planFailures    :: [TestResult]
    }

newtype Check a = Check { forall a. Check a -> StateT PlanState IO a
runCheck :: StateT PlanState IO a }
    deriving ((forall a b. (a -> b) -> Check a -> Check b)
-> (forall a b. a -> Check b -> Check a) -> Functor Check
forall a b. a -> Check b -> Check a
forall a b. (a -> b) -> Check a -> Check b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Check a -> Check b
fmap :: forall a b. (a -> b) -> Check a -> Check b
$c<$ :: forall a b. a -> Check b -> Check a
<$ :: forall a b. a -> Check b -> Check a
Functor, Functor Check
Functor Check
-> (forall a. a -> Check a)
-> (forall a b. Check (a -> b) -> Check a -> Check b)
-> (forall a b c. (a -> b -> c) -> Check a -> Check b -> Check c)
-> (forall a b. Check a -> Check b -> Check b)
-> (forall a b. Check a -> Check b -> Check a)
-> Applicative Check
forall a. a -> Check a
forall a b. Check a -> Check b -> Check a
forall a b. Check a -> Check b -> Check b
forall a b. Check (a -> b) -> Check a -> Check b
forall a b c. (a -> b -> c) -> Check a -> Check b -> Check c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Check a
pure :: forall a. a -> Check a
$c<*> :: forall a b. Check (a -> b) -> Check a -> Check b
<*> :: forall a b. Check (a -> b) -> Check a -> Check b
$cliftA2 :: forall a b c. (a -> b -> c) -> Check a -> Check b -> Check c
liftA2 :: forall a b c. (a -> b -> c) -> Check a -> Check b -> Check c
$c*> :: forall a b. Check a -> Check b -> Check b
*> :: forall a b. Check a -> Check b -> Check b
$c<* :: forall a b. Check a -> Check b -> Check a
<* :: forall a b. Check a -> Check b -> Check a
Applicative, Applicative Check
Applicative Check
-> (forall a b. Check a -> (a -> Check b) -> Check b)
-> (forall a b. Check a -> Check b -> Check b)
-> (forall a. a -> Check a)
-> Monad Check
forall a. a -> Check a
forall a b. Check a -> Check b -> Check b
forall a b. Check a -> (a -> Check b) -> Check b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Check a -> (a -> Check b) -> Check b
>>= :: forall a b. Check a -> (a -> Check b) -> Check b
$c>> :: forall a b. Check a -> Check b -> Check b
>> :: forall a b. Check a -> Check b -> Check b
$creturn :: forall a. a -> Check a
return :: forall a. a -> Check a
Monad)
instance MonadState Check where
    type State Check = PlanState
    withState :: forall a. (State Check -> (a, State Check)) -> Check a
withState State Check -> (a, State Check)
f = StateT PlanState IO a -> Check a
forall a. StateT PlanState IO a -> Check a
Check ((State (StateT PlanState IO) -> (a, State (StateT PlanState IO)))
-> StateT PlanState IO a
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) -> (a, State (StateT PlanState IO))
State Check -> (a, State Check)
f)

-- | different type of tests supported
data Test where
    -- Unit test
    Unit      :: String -> IO () -> Test
    -- Property test
    Property  :: IsProperty prop => String -> prop -> Test
    -- Multiples tests grouped together
    Group     :: String -> [Test] -> Test
    -- Check plan
    CheckPlan :: String -> Check () -> Test

-- | Name of a test
testName :: Test -> String
testName :: Test -> String
testName (Unit String
s IO ()
_)     = String
s
testName (Property String
s prop
_) = String
s
testName (Group String
s [Test]
_)    = String
s
testName (CheckPlan String
s Check ()
_) = String
s

fqTestName :: [String] -> String
fqTestName :: [String] -> String
fqTestName = Element [String] -> [String] -> Element [String]
forall c.
(Sequential c, Monoid (Item c)) =>
Element c -> c -> Element c
intercalate String
Element [String]
"/" ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [String] -> [String]
forall c. Sequential c => c -> c
reverse

groupHasSubGroup :: [Test] -> Bool
groupHasSubGroup :: [Test] -> Bool
groupHasSubGroup [] = Bool
False
groupHasSubGroup (Group{}:[Test]
_) = Bool
True
groupHasSubGroup (Test
_:[Test]
xs) = [Test] -> Bool
groupHasSubGroup [Test]
xs