    {-# 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 Data.Proxy (Proxy(..))
    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 (PropertyBoolean b)        = b
    checkHasSucceed (PropertyNamed b _)        = b
    checkHasSucceed (PropertyBinaryOp b _ _ _) = b
    checkHasSucceed (PropertyAnd b _ _)        = b
    checkHasSucceed (PropertyFail b _)         = b

    checkHasFailed :: PropertyCheck -> PropertyTestResult
    checkHasFailed = not . checkHasSucceed

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

    data Property = Prop { unProp :: Gen PropertyTestArg }

    class IsProperty p where
        property :: p -> Property

    instance IsProperty Bool where
        property b = Prop $ pure (PropertyEOA $ PropertyBoolean b)
    instance IsProperty (String, Bool) where
        property (name, b) = Prop $ pure (PropertyEOA $ PropertyNamed b name)
    instance IsProperty PropertyCheck where
        property check = Prop $ pure (PropertyEOA check)
    instance IsProperty Property where
        property p = p
    instance (Show a, Arbitrary a, IsProperty prop) => IsProperty (a -> prop) where
        property p = forAll arbitrary p

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

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

    pretty :: (Show a, Typeable a) => a -> Proxy a -> String
    pretty a pa = show a <> " :: " <> show (typeRep 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 name op = propertyCompareWith name op (flip pretty 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 name op display a b =
        let sa = display a
            sb = display b
         in PropertyBinaryOp (a `op` b) name sa sb

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

    propertyFail :: String -> PropertyCheck
    propertyFail = PropertyFail False