{-# LANGUAGE ScopedTypeVariables #-}

module Hedgehog.Classes.Enum (enumLaws, boundedEnumLaws) where

import Hedgehog
import Hedgehog.Classes.Common

import qualified Hedgehog.Gen as Gen

-- | Tests the following 'Enum' laws:
--
-- [__Succ-Pred Identity__]: @'succ' '.' 'pred'@ ≡ @'id'@
-- [__Pred-Succ Identity__]: @'pred' '.' 'succ'@ ≡ @'id'@
enumLaws :: (Enum a, Eq a, Show a) => Gen a -> Laws
enumLaws :: forall a. (Enum a, Eq a, Show a) => Gen a -> Laws
enumLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"Enum"
  [ (String
"Succ Pred Identity", forall a. (Enum a, Eq a, Show a) => Gen a -> Property
succPredIdentity Gen a
gen)
  , (String
"Pred Succ Identity", forall a. (Enum a, Eq a, Show a) => Gen a -> Property
predSuccIdentity Gen a
gen)
  ]

-- | Tests the same laws as 'enumLaws', but uses the 'Bounded'
--   constraint to ensure that 'succ' and 'pred' behave as though
--   they are total. This should always be preferred if your type
--   has a 'Bounded' instance.
boundedEnumLaws :: (Bounded a, Enum a, Eq a, Show a) => Gen a -> Laws
boundedEnumLaws :: forall a. (Bounded a, Enum a, Eq a, Show a) => Gen a -> Laws
boundedEnumLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"Bounded Enum"
  [ (String
"Succ Pred Identity", forall a. (Bounded a, Enum a, Eq a, Show a) => Gen a -> Property
succPredBoundedIdentity Gen a
gen)
  , (String
"Pred Succ Identity", forall a. (Bounded a, Enum a, Eq a, Show a) => Gen a -> Property
predSuccBoundedIdentity Gen a
gen)
  ]

succPredIdentity :: forall a. (Enum a, Eq a, Show a) => Gen a -> Property
succPredIdentity :: forall a. (Enum a, Eq a, Show a) => Gen a -> Property
succPredIdentity Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  a
x <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  let lhs :: a
lhs = forall a. Enum a => a -> a
succ (forall a. Enum a => a -> a
pred a
x); rhs :: a
rhs = a
x;
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"Succ-Pred Identity"
        , lawContextLawBody :: String
lawContextLawBody = String
"succ . pred" String -> String -> String
`congruency` String
"id"
        , lawContextTcName :: String
lawContextTcName = String
"Enum"
        , lawContextTcProp :: String
lawContextTcProp =
            let showX :: String
showX = forall a. Show a => a -> String
show a
x
            in [String] -> String
lawWhere
              [ String
"succ . pred $ x" String -> String -> String
`congruency` String
"id x, where"
              , String
"x = " forall a. [a] -> [a] -> [a]
++ String
showX
              ]
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced a
lhs a
rhs
        }
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
lhs a
rhs Context
ctx

predSuccIdentity :: forall a. (Enum a, Eq a, Show a) => Gen a -> Property
predSuccIdentity :: forall a. (Enum a, Eq a, Show a) => Gen a -> Property
predSuccIdentity Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  a
x <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  let lhs :: a
lhs = forall a. Enum a => a -> a
pred (forall a. Enum a => a -> a
succ a
x); rhs :: a
rhs = a
x;
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"Pred-Succ Identity"
        , lawContextLawBody :: String
lawContextLawBody = String
"pred . succ" String -> String -> String
`congruency` String
"id"
        , lawContextTcName :: String
lawContextTcName = String
"Enum"
        , lawContextTcProp :: String
lawContextTcProp =
            let showX :: String
showX = forall a. Show a => a -> String
show a
x
            in [String] -> String
lawWhere
              [ String
"pred . succ $ x" String -> String -> String
`congruency` String
"id x, where"
              , String
"x = " forall a. [a] -> [a] -> [a]
++ String
showX
              ]
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced a
lhs a
rhs
        }
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
lhs a
rhs Context
ctx

succPredBoundedIdentity :: forall a. (Bounded a, Enum a, Eq a, Show a) => Gen a -> Property
succPredBoundedIdentity :: forall a. (Bounded a, Enum a, Eq a, Show a) => Gen a -> Property
succPredBoundedIdentity Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  a
x <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter (forall a. Eq a => a -> a -> Bool
/= forall a. Bounded a => a
minBound) Gen a
gen
  let lhs :: a
lhs = forall a. Enum a => a -> a
succ (forall a. Enum a => a -> a
pred a
x); rhs :: a
rhs = a
x;
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"Succ-Pred Identity"
        , lawContextLawBody :: String
lawContextLawBody = String
"succ . pred" String -> String -> String
`congruency` String
"id"
        , lawContextTcName :: String
lawContextTcName = String
"Enum"
        , lawContextTcProp :: String
lawContextTcProp =
            let showX :: String
showX = forall a. Show a => a -> String
show a
x
            in [String] -> String
lawWhere
              [ String
"succ . pred $ x" String -> String -> String
`congruency` String
"id x, where"
              , String
"x = " forall a. [a] -> [a] -> [a]
++ String
showX
              ]
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced a
lhs a
rhs
        }
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
lhs a
rhs Context
ctx

predSuccBoundedIdentity :: forall a. (Bounded a, Enum a, Eq a, Show a) => Gen a -> Property
predSuccBoundedIdentity :: forall a. (Bounded a, Enum a, Eq a, Show a) => Gen a -> Property
predSuccBoundedIdentity Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  a
x <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter (forall a. Eq a => a -> a -> Bool
/= forall a. Bounded a => a
maxBound) Gen a
gen
  let lhs :: a
lhs = forall a. Enum a => a -> a
pred (forall a. Enum a => a -> a
succ a
x); rhs :: a
rhs = a
x;
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"Pred-Succ Identity"
        , lawContextLawBody :: String
lawContextLawBody = String
"pred . succ" String -> String -> String
`congruency` String
"id"
        , lawContextTcName :: String
lawContextTcName = String
"Enum"
        , lawContextTcProp :: String
lawContextTcProp =
            let showX :: String
showX = forall a. Show a => a -> String
show a
x
            in [String] -> String
lawWhere
              [ String
"pred . succ $ x" String -> String -> String
`congruency` String
"id x, where"
              , String
"x = " forall a. [a] -> [a] -> [a]
++ String
showX
              ]
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced a
lhs a
rhs
        }
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
lhs a
rhs Context
ctx