    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE FlexibleInstances #-}
    module Foundation.Check.Property
        ( Property(..)
        , PropertyTestArg(..)
        , IsProperty
        , PropertyCheck(..)
        , property
        , checkHasSucceed
        , checkHasFailed
        -- * Properties
        , forAll
        , (===)
        , propertyCompare
        , propertyCompareWith
        , propertyAnd
        , propertyFail
        ) where

    import Basement.Imports hiding (Typeable)
    import Basement.Compat.Typeable
    import Foundation.Check.Gen
    import Foundation.Check.Arbitrary

    import Data.Typeable

    type PropertyTestResult = Bool

    -- | The type of check this test did for a property
    data PropertyCheck =
          PropertyBoolean  PropertyTestResult
        | PropertyNamed    PropertyTestResult String
        | PropertyBinaryOp PropertyTestResult String String String
        | PropertyAnd      PropertyTestResult PropertyCheck PropertyCheck
        | PropertyFail     PropertyTestResult String

    checkHasSucceed :: PropertyCheck -> PropertyTestResult
    checkHasSucceed :: PropertyCheck -> PropertyTestResult
    checkHasSucceed (PropertyBoolean PropertyTestResult
    b)        = PropertyTestResult
    b
    checkHasSucceed (PropertyNamed PropertyTestResult
    b String
    _)        = PropertyTestResult
    b
    checkHasSucceed (PropertyBinaryOp PropertyTestResult
    b String
    _ String
    _ String
    _) = PropertyTestResult
    b
    checkHasSucceed (PropertyAnd PropertyTestResult
    b PropertyCheck
    _ PropertyCheck
    _)        = PropertyTestResult
    b
    checkHasSucceed (PropertyFail PropertyTestResult
    b String
    _)         = PropertyTestResult
    b

    checkHasFailed :: PropertyCheck -> PropertyTestResult
    checkHasFailed :: PropertyCheck -> PropertyTestResult
    checkHasFailed = PropertyTestResult -> PropertyTestResult
    not (PropertyTestResult -> PropertyTestResult)
    -> (PropertyCheck -> PropertyTestResult)
    -> PropertyCheck
    -> PropertyTestResult
    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
    . PropertyCheck -> PropertyTestResult
    checkHasSucceed

    -- | A linked-list of arguments to this test
    data PropertyTestArg = PropertyEOA PropertyCheck
                         | PropertyArg String PropertyTestArg

    data Property = Prop { Property -> Gen PropertyTestArg
    unProp :: Gen PropertyTestArg }

    class IsProperty p where
        property :: p -> Property

    instance IsProperty Bool where
        property :: PropertyTestResult -> Property
    property PropertyTestResult
    b = Gen PropertyTestArg -> Property
    Prop (Gen PropertyTestArg -> Property)
    -> Gen PropertyTestArg -> Property
    forall a b. (a -> b) -> a -> b
    $ PropertyTestArg -> Gen PropertyTestArg
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PropertyCheck -> PropertyTestArg
    PropertyEOA (PropertyCheck -> PropertyTestArg)
    -> PropertyCheck -> PropertyTestArg
    forall a b. (a -> b) -> a -> b
    $ PropertyTestResult -> PropertyCheck
    PropertyBoolean PropertyTestResult
    b)
    instance IsProperty (String, Bool) where
        property :: (String, PropertyTestResult) -> Property
    property (String
    name, PropertyTestResult
    b) = Gen PropertyTestArg -> Property
    Prop (Gen PropertyTestArg -> Property)
    -> Gen PropertyTestArg -> Property
    forall a b. (a -> b) -> a -> b
    $ PropertyTestArg -> Gen PropertyTestArg
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PropertyCheck -> PropertyTestArg
    PropertyEOA (PropertyCheck -> PropertyTestArg)
    -> PropertyCheck -> PropertyTestArg
    forall a b. (a -> b) -> a -> b
    $ PropertyTestResult -> String -> PropertyCheck
    PropertyNamed PropertyTestResult
    b String
    name)
    instance IsProperty PropertyCheck where
        property :: PropertyCheck -> Property
    property PropertyCheck
    check = Gen PropertyTestArg -> Property
    Prop (Gen PropertyTestArg -> Property)
    -> Gen PropertyTestArg -> Property
    forall a b. (a -> b) -> a -> b
    $ PropertyTestArg -> Gen PropertyTestArg
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PropertyCheck -> PropertyTestArg
    PropertyEOA PropertyCheck
    check)
    instance IsProperty Property where
        property :: Property -> Property
    property Property
    p = Property
    p
    instance (Show a, Arbitrary a, IsProperty prop) => IsProperty (a -> prop) where
        property :: (a -> prop) -> Property
    property a -> prop
    p = Gen a -> (a -> prop) -> Property
    forall a prop.
    (Show a, IsProperty prop) =>
    Gen a -> (a -> prop) -> Property
    forAll Gen a
    forall a. Arbitrary a => Gen a
    arbitrary a -> prop
    p

    -- | Running a generator for a specific type under a property
    forAll :: (Show a, IsProperty prop) => Gen a -> (a -> prop) -> Property
    forAll :: forall a prop.
    (Show a, IsProperty prop) =>
    Gen a -> (a -> prop) -> Property
    forAll Gen a
    generator a -> prop
    tst = Gen PropertyTestArg -> Property
    Prop (Gen PropertyTestArg -> Property)
    -> Gen PropertyTestArg -> Property
    forall a b. (a -> b) -> a -> b
    $ do
        a <- Gen a
    generator
        augment a <$> unProp (property (tst a))
      where
        augment :: a -> PropertyTestArg -> PropertyTestArg
    augment a
    a PropertyTestArg
    arg = String -> PropertyTestArg -> PropertyTestArg
    PropertyArg (a -> String
    forall a. Show a => a -> String
    show a
    a) PropertyTestArg
    arg

    -- | A property that check for equality of its 2 members.
    (===) :: (Show a, Eq a, Typeable a) => a -> a -> PropertyCheck
    === :: forall a. (Show a, Eq a, Typeable a) => a -> a -> PropertyCheck
    (===) a
    a a
    b =
        let sa :: String
    sa = a -> Proxy a -> String
    forall a. (Show a, Typeable a) => a -> Proxy a -> String
    pretty a
    a Proxy a
    forall {k} (t :: k). Proxy t
    Proxy
            sb :: String
    sb = a -> Proxy a -> String
    forall a. (Show a, Typeable a) => a -> Proxy a -> String
    pretty a
    b Proxy a
    forall {k} (t :: k). Proxy t
    Proxy
         in PropertyTestResult -> String -> String -> String -> PropertyCheck
    PropertyBinaryOp (a
    a a -> a -> PropertyTestResult
    forall a. Eq a => a -> a -> PropertyTestResult
    == a
    b) String
    "==" String
    sa String
    sb
    infix 4 ===

    pretty :: (Show a, Typeable a) => a -> Proxy a -> String
    pretty :: forall a. (Show a, Typeable a) => a -> Proxy a -> String
    pretty a
    a Proxy a
    pa = a -> String
    forall a. Show a => a -> String
    show a
    a String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " :: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> TypeRep -> String
    forall a. Show a => a -> String
    show (Proxy a -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep Proxy a
    pa)

    -- | A property that check for a specific comparaison of its 2 members.
    --
    -- This is equivalent to `===` but with `compare`
    propertyCompare :: (Show a, Typeable a)
                    => String           -- ^ name of the function used for comparaison, e.g. (<)
                    -> (a -> a -> Bool) -- ^ function used for value comparaison
                    -> a                -- ^ value left of the operator
                    -> a                -- ^ value right of the operator
                    -> PropertyCheck
    propertyCompare :: forall a.
    (Show a, Typeable a) =>
    String -> (a -> a -> PropertyTestResult) -> a -> a -> PropertyCheck
    propertyCompare String
    name a -> a -> PropertyTestResult
    op = String
    -> (a -> a -> PropertyTestResult)
    -> (a -> String)
    -> a
    -> a
    -> PropertyCheck
    forall a.
    String
    -> (a -> a -> PropertyTestResult)
    -> (a -> String)
    -> a
    -> a
    -> PropertyCheck
    propertyCompareWith String
    name a -> a -> PropertyTestResult
    op ((a -> Proxy a -> String) -> Proxy a -> a -> String
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip a -> Proxy a -> String
    forall a. (Show a, Typeable a) => a -> Proxy a -> String
    pretty Proxy a
    forall {k} (t :: k). Proxy t
    Proxy)

    -- | A property that check for a specific comparaison of its 2 members.
    --
    -- This is equivalent to `===` but with `compare` and a given method to
    -- pretty print the values.
    --
    propertyCompareWith :: String           -- ^ name of the function used for comparaison, e.g. (<)
                        -> (a -> a -> Bool) -- ^ function used for value comparaison
                        -> (a -> String)    -- ^ function used to pretty print the values
                        -> a                -- ^ value left of the operator
                        -> a                -- ^ value right of the operator
                        -> PropertyCheck
    propertyCompareWith :: forall a.
    String
    -> (a -> a -> PropertyTestResult)
    -> (a -> String)
    -> a
    -> a
    -> PropertyCheck
    propertyCompareWith String
    name a -> a -> PropertyTestResult
    op a -> String
    display a
    a a
    b =
        let sa :: String
    sa = a -> String
    display a
    a
            sb :: String
    sb = a -> String
    display a
    b
         in PropertyTestResult -> String -> String -> String -> PropertyCheck
    PropertyBinaryOp (a
    a a -> a -> PropertyTestResult
    `op` a
    b) String
    name String
    sa String
    sb

    -- | A conjuctive property composed of 2 properties that need to pass
    propertyAnd :: PropertyCheck -> PropertyCheck -> PropertyCheck
    propertyAnd :: PropertyCheck -> PropertyCheck -> PropertyCheck
    propertyAnd PropertyCheck
    c1 PropertyCheck
    c2 =
        PropertyTestResult
    -> PropertyCheck -> PropertyCheck -> PropertyCheck
    PropertyAnd (PropertyCheck -> PropertyTestResult
    checkHasSucceed PropertyCheck
    c1 PropertyTestResult -> PropertyTestResult -> PropertyTestResult
    && PropertyCheck -> PropertyTestResult
    checkHasSucceed PropertyCheck
    c2) PropertyCheck
    c1 PropertyCheck
    c2

    propertyFail :: String -> PropertyCheck
    propertyFail :: String -> PropertyCheck
    propertyFail = PropertyTestResult -> String -> PropertyCheck
    PropertyFail PropertyTestResult
    False