{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Hspec.QuickCheck.Classes
  ( testLaws
  ) where

import Data.Kind
  ( Type
  )
import Data.Proxy
  ( Proxy (Proxy)
  )
import Data.Typeable
  ( Typeable
  , typeRep
  )
import GHC.Stack
  ( HasCallStack
  )
import Test.Hspec
  ( Spec
  )
import Test.QuickCheck
  ( Property
  )
import Test.QuickCheck.Classes
  ( Laws (lawsProperties, lawsTypeclass)
  )

import qualified Test.Hspec as Hspec

_importsRequiredForHaddock :: ()
_importsRequiredForHaddock :: ()
_importsRequiredForHaddock = ()
forall a. HasCallStack => a
undefined
  where
    _type :: Type
    _type :: *
_type = *
forall a. HasCallStack => a
undefined

-- | Tests that a type satisfies the laws of one or more typeclasses.
--
-- For example, to test that 'Bool' satisfies the laws of 'Eq', 'Ord', and
-- 'Show':
--
-- @
-- 'testLaws' \@'Bool'
--   [ 'Test.QuickCheck.Classes.eqLaws'
--   , 'Test.QuickCheck.Classes.ordLaws'
--   , 'Test.QuickCheck.Classes.showLaws'
--   ]
-- @
--
-- === Kind polymorphism
--
-- The 'testLaws' function can also test instances of type classes whose type
-- parameters are not of kind 'Type'.
--
-- For example, with 'Maybe', which has kind @'Type' -> 'Type'@:
--
-- @
-- 'testLaws' \@'Maybe'
--   [ 'Test.QuickCheck.Classes.applicativeLaws'
--   , 'Test.QuickCheck.Classes.functorLaws'
--   , 'Test.QuickCheck.Classes.monadLaws'
--   , 'Test.QuickCheck.Classes.foldableLaws'
--   , 'Test.QuickCheck.Classes.traversableLaws'
--   ]
-- @
--
-- And with 'Either', which has kind @'Type' -> 'Type' -> 'Type'@:
--
-- @
-- 'testLaws' \@'Either'
--   [ 'Test.QuickCheck.Classes.bifoldableLaws'
--   , 'Test.QuickCheck.Classes.bifunctorLaws'
--   , 'Test.QuickCheck.Classes.bitraversableLaws'
--   ]
-- @
testLaws
  :: forall a
   . Typeable a
  => HasCallStack
  => [Proxy a -> Laws]
  -> Spec
testLaws :: forall {k} (a :: k).
(Typeable a, HasCallStack) =>
[Proxy a -> Laws] -> Spec
testLaws = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
specDescription (Spec -> Spec)
-> ([Proxy a -> Laws] -> Spec) -> [Proxy a -> Laws] -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Proxy a -> Laws) -> Spec) -> [Proxy a -> Laws] -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Proxy a -> Laws) -> Spec
testLawsFor
  where
    specDescription :: String
    specDescription :: String
specDescription = [String] -> String
unwords [String
"Testing laws for", String
typeName]
      where
        typeName :: String
        typeName :: String
typeName = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @a

    testLawsFor :: (Proxy a -> Laws) -> Spec
    testLawsFor :: (Proxy a -> Laws) -> Spec
testLawsFor Proxy a -> Laws
toLaws =
      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
Hspec.describe String
typeclassName (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
        ((String, Property) -> Spec) -> [(String, Property)] -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, Property) -> Spec
testNamedProperty [(String, Property)]
namedProperties
      where
        laws :: Laws
        laws :: Laws
laws = Proxy a -> Laws
toLaws Proxy a
forall {k} (t :: k). Proxy t
Proxy

        namedProperties :: [(String, Property)]
        namedProperties :: [(String, Property)]
namedProperties = Laws -> [(String, Property)]
lawsProperties Laws
laws

        testNamedProperty :: (String, Property) -> Spec
        testNamedProperty :: (String, Property) -> Spec
testNamedProperty (String
name, Property
property) = String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
Hspec.it String
name Property
property

        typeclassName :: String
        typeclassName :: String
typeclassName = Laws -> String
lawsTypeclass Laws
laws