```{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

-- | The core of ClassLaws are the type families 'LawArgs', 'LawBody' and
-- 'Param', tied together by the type class 'LawTest'.
module Test.ClassLaws.Core where
import Test.QuickCheck
import Test.ClassLaws.Partial

-- | An equality proof is represented as a list of (at least two) equal values.
type Equal    =  []
-- | A Theorem is a claim that a LHS equals a RHS - an 'Equal' of length two.
type Theorem  =  Equal

infixr 0 =.=
-- | Contructing an equality theorem: @lhs =.= rhs  =  [lhs, rhs]@.
(=.=)        :: a -> a -> Theorem a
lhs =.= rhs  =  [lhs, rhs]

-- | Take a two-element "theorem" and an equality proof chain to splice in the middle.
addSteps                    :: Theorem a -> Equal a -> Equal a
addSteps  [lhs,rhs]  steps  =  lhs : steps ++ [rhs]
addSteps  _          _      =  error "addSteps should only be used on two-element lists"

-- | The forall quantified part on the top level of the law
type family LawArgs t
-- | The type in the body of the forall
type family LawBody t
-- | Parameters needed for 'Equal' checking of the body
type family Param b

-- | The 'Law's we handle are of this form.
type Law t  =  LawArgs t -> Equal (LawBody t)

{- |
Class LawTest defines a test method, which returns a testable property, which we
can use to test a law for a type t. This class is independent of the actual laws
to test - it can be used for Monoid, Monad, ...
-}
class LawTest t where
lawtest :: t -> LawArgs t -> Param (LawBody t) -> Property

-- | Helper function to test laws where arguments lack a Show instance.
blindlawtest :: (LawTest t) => t -> Blind (LawArgs t) -> Param (LawBody t) -> Property
blindlawtest a (Blind f)  =  lawtest a f

-- | Helper function to test laws where we should care about partial values.
partiallawtest :: (LawTest t) => t -> Partial ((LawArgs t) -> Param (LawBody t) -> Property)
partiallawtest a = Partial \$ lawtest a

-- | Top level use of ClassLaws is often @'quickLawCheck' someLaw@
quickLawCheck ::
(Show       (LawArgs t),
Arbitrary  (LawArgs t),
Show       (Param (LawBody t)),
Arbitrary  (Param (LawBody t)),
LawTest t) =>
t -> IO ()
quickLawCheck  =  quickCheck . lawtest
-- quickLawCheck  law  =  quickCheck (lawtest law) -- alternative version does not need expl. type sig.
-- | Variant not needing a Show instance for the 'LawArg's
quickFLawCheck law  =  quickCheck (blindlawtest  law)

-- | Checking laws in the precense of partial values
quickLawCheckPartial
:: ( Show (Partial (Param (LawBody t)))
, Show (Partial (LawArgs t))
, ArbitraryPartial (Param (LawBody t))
, ArbitraryPartial (LawArgs t)
, LawTest t) =>
t -> IO ()
quickLawCheckPartial =  quickCheck . Partial . lawtest

```