{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeApplications #-}

-- | Useful of helpers for writing properties with constrained generators
module Constrained.Properties where

import Constrained.API
import Constrained.Base ()
import Constrained.Conformance (
  monitorSpec,
 )
import Constrained.GenT (
  GE (..),
  errorGE,
  fromGEDiscard,
  strictGen,
 )
import Constrained.Generation
import Constrained.NumOrd ()
import Constrained.Spec.Set ()
import Constrained.Spec.SumProd ()
import qualified Data.List.NonEmpty as NE
import qualified Test.QuickCheck as QC

conformsToSpecProp :: forall a. HasSpec a => a -> Specification a -> QC.Property
conformsToSpecProp :: forall a. HasSpec a => a -> Specification a -> Property
conformsToSpecProp a
a Specification a
s = case a -> Specification a -> NonEmpty String -> Maybe (NonEmpty String)
forall a.
HasSpec a =>
a -> Specification a -> NonEmpty String -> Maybe (NonEmpty String)
conformsToSpecE a
a (Specification a -> Specification a
forall a. HasSpec a => Specification a -> Specification a
simplifySpec Specification a
s) (String -> NonEmpty String
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"call to conformsToSpecProp") of
  Maybe (NonEmpty String)
Nothing -> Bool -> Property
forall prop. Testable prop => prop -> Property
QC.property Bool
True
  Just NonEmpty String
msgs -> String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
QC.counterexample ([String] -> String
unlines (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
msgs)) Bool
False

forAllSpecShow ::
  (HasSpec a, QC.Testable p) => Specification a -> (a -> String) -> (a -> p) -> QC.Property
forAllSpecShow :: forall a p.
(HasSpec a, Testable p) =>
Specification a -> (a -> String) -> (a -> p) -> Property
forAllSpecShow Specification a
spec a -> String
pp a -> p
prop =
  let sspec :: Specification a
sspec = Specification a -> Specification a
forall a. HasSpec a => Specification a -> Specification a
simplifySpec Specification a
spec
   in Gen a -> (a -> [a]) -> (a -> String) -> (a -> Property) -> Property
forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
QC.forAllShrinkShow (Specification a -> Gen a
forall a. (HasCallStack, HasSpec a) => Specification a -> Gen a
genFromSpec Specification a
sspec) (Specification a -> a -> [a]
forall a. HasSpec a => Specification a -> a -> [a]
shrinkWithSpec Specification a
sspec) a -> String
pp ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a ->
        Specification a -> a -> p -> Property
forall p a. Testable p => Specification a -> a -> p -> Property
monitorSpec Specification a
spec a
a (p -> Property) -> p -> Property
forall a b. (a -> b) -> a -> b
$ a -> p
prop a
a

forAllSpec :: (HasSpec a, QC.Testable p) => Specification a -> (a -> p) -> QC.Property
forAllSpec :: forall a p.
(HasSpec a, Testable p) =>
Specification a -> (a -> p) -> Property
forAllSpec Specification a
spec a -> p
prop = Specification a -> (a -> String) -> (a -> p) -> Property
forall a p.
(HasSpec a, Testable p) =>
Specification a -> (a -> String) -> (a -> p) -> Property
forAllSpecShow Specification a
spec a -> String
forall a. Show a => a -> String
show a -> p
prop

forAllSpecDiscard :: (HasSpec a, QC.Testable p) => Specification a -> (a -> p) -> QC.Property
forAllSpecDiscard :: forall a p.
(HasSpec a, Testable p) =>
Specification a -> (a -> p) -> Property
forAllSpecDiscard Specification a
spec a -> p
prop =
  let sspec :: Specification a
sspec = Specification a -> Specification a
forall a. HasSpec a => Specification a -> Specification a
simplifySpec Specification a
spec
   in Gen (GE a) -> (GE a -> [GE a]) -> (GE a -> Property) -> Property
forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
QC.forAllShrinkBlind
        (GenT GE a -> Gen (GE a)
forall (m :: * -> *) a. GenT m a -> Gen (m a)
strictGen (GenT GE a -> Gen (GE a)) -> GenT GE a -> Gen (GE a)
forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(HasCallStack, HasSpec a, MonadGenError m) =>
Specification a -> GenT m a
genFromSpecT @_ @GE Specification a
sspec)
        ((a -> GE a) -> [a] -> [GE a]
forall a b. (a -> b) -> [a] -> [b]
map a -> GE a
forall a. a -> GE a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> [GE a]) -> (GE a -> [a]) -> GE a -> [GE a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specification a -> a -> [a]
forall a. HasSpec a => Specification a -> a -> [a]
shrinkWithSpec Specification a
sspec (a -> [a]) -> (GE a -> a) -> GE a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GE a -> a
forall a. GE a -> a
errorGE)
        ((GE a -> Property) -> Property) -> (GE a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \GE a
ge ->
          GE Property -> Property
forall p. Testable p => GE p -> Property
fromGEDiscard (GE Property -> Property) -> GE Property -> Property
forall a b. (a -> b) -> a -> b
$ do
            a
a <- GE a
ge
            Property -> GE Property
forall a. a -> GE a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> GE Property) -> Property -> GE Property
forall a b. (a -> b) -> a -> b
$ String -> p -> Property
forall prop. Testable prop => String -> prop -> Property
QC.counterexample (a -> String
forall a. Show a => a -> String
show a
a) (p -> Property) -> p -> Property
forall a b. (a -> b) -> a -> b
$ a -> p
prop a
a