{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Constrained.Test where

import Control.Monad
import Data.Int
import Data.Map (Map)
import Data.Set (Set)
import Data.Typeable
import Data.Word
import GHC.Natural
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck hiding (Args, Fun, forAll)

import Constrained.Examples
import Constrained.Internals
import Constrained.Properties
import qualified Data.List.NonEmpty as NE

------------------------------------------------------------------------
-- Test suite
------------------------------------------------------------------------

testAll :: IO ()
testAll :: IO ()
testAll = Spec -> IO ()
hspec forall a b. (a -> b) -> a -> b
$ Bool -> Spec
tests Bool
False

tests :: Bool -> Spec
tests :: Bool -> Spec
tests Bool
nightly =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"constrained" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Int -> Int) -> SpecWith a -> SpecWith a
modifyMaxSuccess (\Int
ms -> if Bool
nightly then Int
ms forall a. Num a => a -> a -> a
* Int
10 else Int
ms) forall a b. (a -> b) -> a -> b
$ do
    -- TODO: double-shrinking
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"reifiesMultiple" Specification BaseFn (Int, Int, Int)
reifiesMultiple
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"assertReal" Specification BaseFn Int
assertReal
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"chooseBackwards" Specification BaseFn (Int, [Int])
chooseBackwards
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"chooseBackwards'" Specification BaseFn ([(Int, [Int])], (Int, [Int]))
chooseBackwards'
    -- TODO: turn this on again when QuickCheck version is bumped
    -- testSpec "whenTrueExists" whenTrueExists
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"assertRealMultiple" Specification BaseFn (Int, Int)
assertRealMultiple
    -- TODO: quickcheck version
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"setSpec" Specification BaseFn (Set Int)
setSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"leqPair" Specification BaseFn (Int, Int)
leqPair
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"setPair" Specification BaseFn (Set (Int, Int))
setPair
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"listEmpty" Specification BaseFn [Int]
listEmpty
    -- TODO: quickcheck version
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"compositionalSpec" Specification BaseFn (Set Int)
compositionalSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"simplePairSpec" Specification BaseFn (Int, Int)
simplePairSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"trickyCompositional" Specification BaseFn (Int, Int)
trickyCompositional
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"emptyListSpec" Specification BaseFn ([Int], NotASet (Either Int Int, Int))
emptyListSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"eitherSpec" Specification BaseFn (Either Int Int)
eitherSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"maybeSpec" Specification BaseFn (Set (Maybe Int))
maybeSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"eitherSetSpec" Specification
  BaseFn
  (Set (Either Int Int), Set (Either Int Int), Set (Either Int Int))
eitherSetSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"fooSpec" Specification BaseFn Foo
fooSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"mapElemSpec" Specification BaseFn (Map Int (Bool, Int))
mapElemSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"mapElemKeySpec" Specification BaseFn Int
mapElemKeySpec
    -- TODO: double shrinking
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"mapIsJust" Specification BaseFn (Int, Int)
mapIsJust
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"intSpec" Specification BaseFn (Int, Int)
intSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"mapPairSpec" Specification BaseFn (Map Int Int, Set Int)
mapPairSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"mapEmptyDomainSpec" Specification BaseFn (Map Int Int)
mapEmptyDomainSpec
    -- TODO: this _can_ be shrunk, but it's incredibly expensive to do
    -- so and it's not obvious if there is a faster way without implementing
    -- more detailed shrinking of `SuspendedSpec`s
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"setPairSpec" Specification BaseFn (Set Int, Set Int)
setPairSpec
    -- TODO: quickcheck version
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"fixedSetSpec" Specification BaseFn (Set Int)
fixedSetSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"setOfPairLetSpec" Specification BaseFn (Set (Int, Int))
setOfPairLetSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"emptyEitherSpec" Specification BaseFn (Set (Either Int Int))
emptyEitherSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"emptyEitherMemberSpec" Specification BaseFn (Set (Either Int Int))
emptyEitherMemberSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"setSingletonSpec" Specification BaseFn (Set (Int, Int))
setSingletonSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"pairSingletonSpec" Specification BaseFn (Int, Int)
pairSingletonSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"eitherSimpleSetSpec" Specification BaseFn (Set (Either Int Int))
eitherSimpleSetSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"emptySetSpec" Specification BaseFn (Set Int)
emptySetSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"forAllAnySpec" Specification BaseFn (Set Int)
forAllAnySpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"notSubsetSpec" Specification BaseFn (Set Int, Set Int)
notSubsetSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"maybeJustSetSpec" Specification BaseFn (Set (Maybe Int))
maybeJustSetSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"weirdSetPairSpec" Specification BaseFn ([Int], Set (Either Int Int))
weirdSetPairSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"knownDomainMap" Specification BaseFn (Map Int Int)
knownDomainMap
    -- TODO: figure out double-shrinking
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"testRewriteSpec" Specification BaseFn ((Int, Int), (Int, Int))
testRewriteSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"parallelLet" Specification BaseFn (Int, Int)
parallelLet
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"letExists" Specification BaseFn (Int, Int)
letExists
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"letExistsLet" Specification BaseFn (Int, Int)
letExistsLet
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"notSubset" Specification BaseFn (Set Int)
notSubset
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"unionSized" Specification BaseFn (Set Int)
unionSized
    -- TODO: figure out double-shrinking
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"dependencyWeirdness" Specification BaseFn (Int, Int, Int)
dependencyWeirdness
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"foldTrueCases" Specification BaseFn (Either Int Int)
foldTrueCases
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"foldSingleCase" Specification BaseFn Int
foldSingleCase
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"listSumPair" (forall a. Numbery a => Specification BaseFn [(a, Int)]
listSumPair @Int)
    -- TODO: figure out double-shrinking
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"parallelLetPair" Specification BaseFn (Int, Int)
parallelLetPair
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"mapSizeConstrained" Specification BaseFn (Map Three Int)
mapSizeConstrained
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"isAllZeroTree" Specification RoseFn (Tree Int)
isAllZeroTree
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"noChildrenSameTree" Specification BaseFn (BinTree Int)
noChildrenSameTree
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"isBST" Specification BaseFn (BinTree Int)
isBST
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"pairListError" Specification BaseFn [(Int, Int)]
pairListError
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"listMustSizeIssue" Specification BaseFn [Int]
listMustSizeIssue
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"successiveChildren" Specification RoseFn (Tree Int)
successiveChildren
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"successiveChildren8" Specification RoseFn (Tree Int)
successiveChildren8
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"roseTreeList" Specification RoseFn [Tree Int]
roseTreeList
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"orPair" Specification BaseFn (Int, Int)
orPair
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"roseTreePairs" Specification RoseFn (Tree ([Int], [Int]))
roseTreePairs
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"roseTreeMaybe" Specification RoseFn (Tree (Maybe (Int, Int)))
roseTreeMaybe
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"badTreeInteraction" Specification RoseFn (Tree (Either Int Int))
badTreeInteraction
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"sumRange" Specification BaseFn (Map Word64 Word64)
sumRange
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"sumListBad" Specification BaseFn [Word64]
sumListBad
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"listExistsUnfree" Specification BaseFn [Int]
listExistsUnfree
    -- TODO: turn this on when we bump quickcheck version
    -- testSpec "listSumShort" listSumShort
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"existsUnfree" Specification BaseFn Int
existsUnfree
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"appendSize" Specification BaseFn ([Int], [Int])
appendSize
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"appendSingleton" Specification BaseFn Int
appendSingleton
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"singletonSubset" Specification BaseFn Int
singletonSubset
    -- TODO: double shrinking
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"reifyYucky" Specification BaseFn (Int, Int, Int)
reifyYucky
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"fixedRange" Specification BaseFn (Map Int Int)
fixedRange
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"rangeHint" Specification BaseFn (Map Int Int)
rangeHint
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"basicSpec" Specification BaseFn Int
basicSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"canFollowLike" Specification BaseFn ((Int, Int), (Int, Int))
canFollowLike
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"ifElseBackwards" Specification BaseFn (Int, Int)
ifElseBackwards
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"three" Specification BaseFn Three
three
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"three'" Specification BaseFn Three
three'
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"threeSpecific" Specification BaseFn Three
threeSpecific
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"threeSpecific'" Specification BaseFn Three
threeSpecific'
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"trueSpecUniform" Specification BaseFn Three
trueSpecUniform
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"ifElseMany" Specification BaseFn (Bool, Int, Int)
ifElseMany
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"propBack" Specification BaseFn (Int, Int)
propBack
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"propBack'" Specification BaseFn (Int, Int)
propBack'
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"propBack''" Specification BaseFn (Int, Int)
propBack''
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"complexUnion" Specification BaseFn (Set Int, Set Int)
complexUnion
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"unionBounded" Specification BaseFn (Set Int)
unionBounded
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"elemSpec" Specification BaseFn (Int, Int, Map Int Int)
elemSpec
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"lookupSpecific" Specification BaseFn (Int, Int, Map Int Int)
lookupSpecific
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"mapRestrictedValues" Specification BaseFn (Map (Either Int ()) Int)
mapRestrictedValues
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"mapRestrictedValuesThree" Specification BaseFn (Map Three Int)
mapRestrictedValuesThree
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"mapRestrictedValuesBool" Specification BaseFn (Map Bool Int)
mapRestrictedValuesBool
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"mapSetSmall" Specification BaseFn (Map (Set Int) Int)
mapSetSmall
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"powersetPickOne" Specification BaseFn (Set Int)
powersetPickOne
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"appendSuffix" Specification BaseFn ([Int], [Int])
appendSuffix
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"appendForAll" Specification BaseFn ([Int], [Int])
appendForAll
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"wtfSpec" Specification BaseFn ([Int], Maybe ((), [Int]))
wtfSpec
    Spec
numberyTests
    Spec
sizeTests
    Spec
numNumSpecTree
    forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec (String
"intRangeSpec " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i) (Int -> Specification BaseFn Int
intRangeSpec Int
i)
      | Int
i <- [-Int
1000, -Int
100, -Int
10, Int
0, Int
10, Int
100, Int
1000]
      ]
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"prop_conformEmpty" forall a b. (a -> b) -> a -> b
$ do
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Int" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a. HasSpec fn a => a -> Property
prop_conformEmpty @BaseFn @Int
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Set Int" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a. HasSpec fn a => a -> Property
prop_conformEmpty @BaseFn @(Set Int)
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Map Int Int" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a. HasSpec fn a => a -> Property
prop_conformEmpty @BaseFn @(Map Int Int)
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"[Int]" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a. HasSpec fn a => a -> Property
prop_conformEmpty @BaseFn @[Int]
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"[(Int, Int)]" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a. HasSpec fn a => a -> Property
prop_conformEmpty @BaseFn @[(Int, Int)]
    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"prop_univSound @BaseFn" forall a b. (a -> b) -> a -> b
$
      forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess (if Bool
nightly then Int
100_000 else Int
10_000) forall a b. (a -> b) -> a -> b
$
        forall (fn :: [*] -> * -> *). TestableFn fn -> Property
prop_univSound @BaseFn
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"prop_gen_sound @BaseFn" forall a b. (a -> b) -> a -> b
$ do
      forall a. (Int -> Int) -> SpecWith a -> SpecWith a
modifyMaxSuccess (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ if Bool
nightly then Int
10_000 else Int
1000) forall a b. (a -> b) -> a -> b
$ do
        forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Int" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @Int
        forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Bool" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @Bool
        forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"(Int, Int)" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @(Int, Int)
        forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Map Int Int" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @(Map Int Int)
        forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Set Int" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @(Set Int)
        forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Set Bool" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @(Set Bool)
        forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"[Int]" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @[Int]
        forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"[(Int, Int)]" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @[(Int, Int)]
        forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Map Bool Int" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @(Map Bool Int)
      -- Slow tests that shouldn't run 1000 times
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
xprop String
"Map (Set Int) Int" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @(Map (Set Int) Int)
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"[(Set Int, Set Bool)]" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @[(Set Int, Set Bool)]
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Set (Set Bool)" forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_gen_sound @BaseFn @(Set (Set Bool))
    Spec
negativeTests
    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"prop_noNarrowLoop" forall a b. (a -> b) -> a -> b
$ forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
1000 Int
-> Int
-> Specification BaseFn Int
-> Specification BaseFn Int
-> Property
prop_noNarrowLoop
    Spec
conformsToSpecESpec

negativeTests :: Spec
negativeTests :: Spec
negativeTests =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"negative tests" forall a b. (a -> b) -> a -> b
$ do
    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"reifies 10 x id" forall a b. (a -> b) -> a -> b
$
      forall prop. Testable prop => prop -> Property
expectFailure forall a b. (a -> b) -> a -> b
$
        forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_complete @BaseFn @Int forall a b. (a -> b) -> a -> b
$
          forall a (fn :: [*] -> * -> *) p.
(IsPred p fn, HasSpec fn a) =>
(Term fn a -> p) -> Specification fn a
constrained forall a b. (a -> b) -> a -> b
$
            \Term BaseFn Int
x ->
              forall (fn :: [*] -> * -> *). NonEmpty String -> Pred fn -> Pred fn
explanation (forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"The value is decided before reifies happens") forall a b. (a -> b) -> a -> b
$
                forall (fn :: [*] -> * -> *) a b.
(HasSpec fn a, HasSpec fn b) =>
Term fn b -> Term fn a -> (a -> b) -> Pred fn
reifies Term
  (Fix
     (Oneof
        (Oneof
           (Oneof MapFn (Oneof PairFn ListFn))
           (Oneof FunFn (Oneof SetFn OrdFn)))
        (Oneof
           (Oneof SumFn (Oneof BoolFn GenericsFn))
           (Oneof SizeFn (Oneof EqFn IntFn)))))
  Int
10 Term BaseFn Int
x forall a. a -> a
id
    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"reify overconstrained" forall a b. (a -> b) -> a -> b
$
      forall prop. Testable prop => prop -> Property
expectFailure forall a b. (a -> b) -> a -> b
$
        forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_complete @BaseFn @Int forall a b. (a -> b) -> a -> b
$
          forall a (fn :: [*] -> * -> *) p.
(IsPred p fn, HasSpec fn a) =>
(Term fn a -> p) -> Specification fn a
constrained forall a b. (a -> b) -> a -> b
$ \Term BaseFn Int
x ->
            forall (fn :: [*] -> * -> *). NonEmpty String -> Pred fn -> Pred fn
explanation
              (forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"You can't constrain the variable introduced by reify as its already decided")
              forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) a b p.
(HasSpec fn a, HasSpec fn b, IsPred p fn) =>
Term fn a -> (a -> b) -> (Term fn b -> p) -> Pred fn
reify Term BaseFn Int
x forall a. a -> a
id
              forall a b. (a -> b) -> a -> b
$ \Term
  (Fix
     (Oneof
        (Oneof
           (Oneof MapFn (Oneof PairFn ListFn))
           (Oneof FunFn (Oneof SetFn OrdFn)))
        (Oneof
           (Oneof SumFn (Oneof BoolFn GenericsFn))
           (Oneof SizeFn (Oneof EqFn IntFn)))))
  Int
y -> Term
  (Fix
     (Oneof
        (Oneof
           (Oneof MapFn (Oneof PairFn ListFn))
           (Oneof FunFn (Oneof SetFn OrdFn)))
        (Oneof
           (Oneof SumFn (Oneof BoolFn GenericsFn))
           (Oneof SizeFn (Oneof EqFn IntFn)))))
  Int
y forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
==. Term
  (Fix
     (Oneof
        (Oneof
           (Oneof MapFn (Oneof PairFn ListFn))
           (Oneof FunFn (Oneof SetFn OrdFn)))
        (Oneof
           (Oneof SumFn (Oneof BoolFn GenericsFn))
           (Oneof SizeFn (Oneof EqFn IntFn)))))
  Int
10
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecFail String
"singletonErrorTooMany" Specification BaseFn Int
singletonErrorTooMany
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecFail String
"singletonErrorTooLong" Specification BaseFn Int
singletonErrorTooLong
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecFail String
"appendTooLong" Specification BaseFn [Int]
appendTooLong
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecFail String
"overconstrainedAppend" Specification BaseFn ([Int], [Int])
overconstrainedAppend
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecFail String
"overconstrainedPrefixes" Specification BaseFn ([Int], [Int], [Int])
overconstrainedPrefixes
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecFail String
"overconstrainedSuffixes" Specification BaseFn ([Int], [Int], [Int])
overconstrainedSuffixes
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecFail String
"appendForAllBad" Specification BaseFn ([Int], [Int])
appendForAllBad

testSpecFail :: HasSpec fn a => String -> Specification fn a -> Spec
testSpecFail :: forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecFail String
s Specification fn a
spec =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
s forall a. [a] -> [a] -> [a]
++ String
" fails") forall a b. (a -> b) -> a -> b
$
    forall prop. Testable prop => prop -> Property
expectFailure forall a b. (a -> b) -> a -> b
$
      forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
1 forall a b. (a -> b) -> a -> b
$
        forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_complete Specification fn a
spec

numberyTests :: Spec
numberyTests :: Spec
numberyTests =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"numbery tests" forall a b. (a -> b) -> a -> b
$ do
    String -> (forall a. Numbery a => Specification BaseFn [a]) -> Spec
testNumberyListSpec String
"listSum" forall a. Numbery a => Specification BaseFn [a]
listSum
    String -> (forall a. Numbery a => Specification BaseFn [a]) -> Spec
testNumberyListSpecNoShrink String
"listSumForall" forall a. Numbery a => Specification BaseFn [a]
listSumForall
    String -> (forall a. Numbery a => Specification BaseFn [a]) -> Spec
testNumberyListSpec String
"listSumRange" forall a. Numbery a => Specification BaseFn [a]
listSumRange
    String -> (forall a. Numbery a => Specification BaseFn [a]) -> Spec
testNumberyListSpec String
"listSumRangeUpper" forall a. Numbery a => Specification BaseFn [a]
listSumRangeUpper
    String -> (forall a. Numbery a => Specification BaseFn [a]) -> Spec
testNumberyListSpec String
"listSumRangeRange" forall a. Numbery a => Specification BaseFn [a]
listSumRangeRange
    String -> (forall a. Numbery a => Specification BaseFn [a]) -> Spec
testNumberyListSpec String
"listSumElemRange" forall a. Numbery a => Specification BaseFn [a]
listSumElemRange

sizeTests :: Spec
sizeTests :: Spec
sizeTests =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"SizeTests" forall a b. (a -> b) -> a -> b
$ do
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"sizeAddOrSub1" Specification BaseFn Integer
sizeAddOrSub1
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"sizeAddOrSub2" Specification BaseFn Integer
sizeAddOrSub2
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"sizeAddOrSub3" Specification BaseFn Integer
sizeAddOrSub3
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"sizeAddOrSub4 returns Negative Size" Specification BaseFn Integer
sizeAddOrSub4
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"sizeAddOrSub5" Specification BaseFn Integer
sizeAddOrSub5
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink String
"sizeAddOrSub5" Specification BaseFn Integer
sizeAddOrSub5
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"listSubSize" Specification BaseFn [Int]
listSubSize
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"listSubSize" Specification BaseFn (Set Int)
setSubSize
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"listSubSize" Specification BaseFn (Map Int Int)
mapSubSize
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"hasSizeList" Specification BaseFn [Int]
hasSizeList
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"hasSizeSet" Specification BaseFn (Set Int)
hasSizeSet
    forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec String
"hasSizeMap" Specification BaseFn (Map Int Int)
hasSizeMap

data NumberyType where
  N :: (Typeable a, Numbery a) => Proxy a -> NumberyType

testNumberyListSpec :: String -> (forall a. Numbery a => Specification BaseFn [a]) -> Spec
testNumberyListSpec :: String -> (forall a. Numbery a => Specification BaseFn [a]) -> Spec
testNumberyListSpec = Bool
-> String
-> (forall a. Numbery a => Specification BaseFn [a])
-> Spec
testNumberyListSpec' Bool
True

testNumberyListSpecNoShrink :: String -> (forall a. Numbery a => Specification BaseFn [a]) -> Spec
testNumberyListSpecNoShrink :: String -> (forall a. Numbery a => Specification BaseFn [a]) -> Spec
testNumberyListSpecNoShrink = Bool
-> String
-> (forall a. Numbery a => Specification BaseFn [a])
-> Spec
testNumberyListSpec' Bool
False

testNumberyListSpec' :: Bool -> String -> (forall a. Numbery a => Specification BaseFn [a]) -> Spec
testNumberyListSpec' :: Bool
-> String
-> (forall a. Numbery a => Specification BaseFn [a])
-> Spec
testNumberyListSpec' Bool
withShrink String
n forall a. Numbery a => Specification BaseFn [a]
p =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
n forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Bool -> String -> Specification fn a -> Spec
testSpec' Bool
withShrink (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
proxy) (forall a. Numbery a => Specification BaseFn [a]
p @a)
      | N (Proxy a
proxy :: Proxy a) <- [NumberyType]
numberyTypes
      ]
  where
    numberyTypes :: [NumberyType]
numberyTypes =
      [ forall a. (Typeable a, Numbery a) => Proxy a -> NumberyType
N @Int forall {k} (t :: k). Proxy t
Proxy
      , forall a. (Typeable a, Numbery a) => Proxy a -> NumberyType
N @Integer forall {k} (t :: k). Proxy t
Proxy
      , forall a. (Typeable a, Numbery a) => Proxy a -> NumberyType
N @Natural forall {k} (t :: k). Proxy t
Proxy
      , forall a. (Typeable a, Numbery a) => Proxy a -> NumberyType
N @Word64 forall {k} (t :: k). Proxy t
Proxy
      , forall a. (Typeable a, Numbery a) => Proxy a -> NumberyType
N @Word32 forall {k} (t :: k). Proxy t
Proxy
      , forall a. (Typeable a, Numbery a) => Proxy a -> NumberyType
N @Word16 forall {k} (t :: k). Proxy t
Proxy
      , forall a. (Typeable a, Numbery a) => Proxy a -> NumberyType
N @Word8 forall {k} (t :: k). Proxy t
Proxy
      , forall a. (Typeable a, Numbery a) => Proxy a -> NumberyType
N @Int64 forall {k} (t :: k). Proxy t
Proxy
      , forall a. (Typeable a, Numbery a) => Proxy a -> NumberyType
N @Int32 forall {k} (t :: k). Proxy t
Proxy
      , forall a. (Typeable a, Numbery a) => Proxy a -> NumberyType
N @Int16 forall {k} (t :: k). Proxy t
Proxy
      , forall a. (Typeable a, Numbery a) => Proxy a -> NumberyType
N @Int8 forall {k} (t :: k). Proxy t
Proxy
      ]

testSpec :: HasSpec fn a => String -> Specification fn a -> Spec
testSpec :: forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpec = forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Bool -> String -> Specification fn a -> Spec
testSpec' Bool
True

testSpecNoShrink :: HasSpec fn a => String -> Specification fn a -> Spec
testSpecNoShrink :: forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
String -> Specification fn a -> Spec
testSpecNoShrink = forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Bool -> String -> Specification fn a -> Spec
testSpec' Bool
False

testSpec' :: HasSpec fn a => Bool -> String -> Specification fn a -> Spec
testSpec' :: forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Bool -> String -> Specification fn a -> Spec
testSpec' Bool
withShrink String
n Specification fn a
s = do
  let checkCoverage' :: Property -> Property
checkCoverage' = forall prop. Testable prop => Confidence -> prop -> Property
checkCoverageWith Confidence
stdConfidence {certainty :: Integer
certainty = Integer
1_000_000}
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
n forall a b. (a -> b) -> a -> b
$ do
    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"prop_sound" forall a b. (a -> b) -> a -> b
$
      forall prop. Testable prop => Int -> prop -> Property
within Int
10_000_000 forall a b. (a -> b) -> a -> b
$
        Property -> Property
checkCoverage' forall a b. (a -> b) -> a -> b
$
          forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_sound Specification fn a
s
    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"prop_constrained_satisfies_sound" forall a b. (a -> b) -> a -> b
$
      forall prop. Testable prop => Int -> prop -> Property
within Int
10_000_000 forall a b. (a -> b) -> a -> b
$
        Property -> Property
checkCoverage' forall a b. (a -> b) -> a -> b
$
          forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_constrained_satisfies_sound Specification fn a
s
    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"prop_constrained_explained" forall a b. (a -> b) -> a -> b
$
      forall prop. Testable prop => Int -> prop -> Property
within Int
10_000_0000 forall a b. (a -> b) -> a -> b
$
        Property -> Property
checkCoverage' forall a b. (a -> b) -> a -> b
$
          forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_constrained_explained Specification fn a
s
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
withShrink forall a b. (a -> b) -> a -> b
$
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"prop_shrink_sound" forall a b. (a -> b) -> a -> b
$
        forall prop. Testable prop => Int -> prop -> Property
discardAfter Int
100_000 forall a b. (a -> b) -> a -> b
$
          Property -> Property
checkCoverage' forall a b. (a -> b) -> a -> b
$
            forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Specification fn a -> Property
prop_shrink_sound Specification fn a
s

------------------------------------------------------------------------
-- Test properties of the instance Num (NumSpec fn Integer)
------------------------------------------------------------------------

-- | When we multiply intervals, we get a bounding box, around the possible values.
--   When the intervals have infinities, the bounding box can be very loose. In fact the
--   order in which we multiply intervals with infinities can affect how loose the bounding box is.
--   So ((NegInf, n) * (a, b)) * (c,d)  AND  (NegInf, n) * ((a, b) * (c,d)) may have different bounding boxes
--   To test the associative laws we must have no infinities, and then the associative law will hold.
noInfinity :: Gen (NumSpec fn Integer)
noInfinity :: forall (fn :: [*] -> * -> *). Gen (NumSpec fn Integer)
noInfinity = do
  Integer
lo <- forall a. Arbitrary a => Gen a
arbitrary
  Integer
hi <- forall a. Gen a -> (a -> Bool) -> Gen a
suchThat forall a. Arbitrary a => Gen a
arbitrary (forall a. Ord a => a -> a -> Bool
> Integer
lo)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (fn :: [*] -> * -> *) n. Maybe n -> Maybe n -> NumSpec fn n
NumSpecInterval (forall a. a -> Maybe a
Just Integer
lo) (forall a. a -> Maybe a
Just Integer
hi)

plusNegate :: NumSpec fn Integer -> NumSpec fn Integer -> Property
plusNegate :: forall (fn :: [*] -> * -> *).
NumSpec fn Integer -> NumSpec fn Integer -> Property
plusNegate NumSpec fn Integer
x NumSpec fn Integer
y = NumSpec fn Integer
x forall a. Num a => a -> a -> a
- NumSpec fn Integer
y forall a. (Eq a, Show a) => a -> a -> Property
=== NumSpec fn Integer
x forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
negate NumSpec fn Integer
y

commutesNumSpec :: NumSpec fn Integer -> NumSpec fn Integer -> Property
commutesNumSpec :: forall (fn :: [*] -> * -> *).
NumSpec fn Integer -> NumSpec fn Integer -> Property
commutesNumSpec NumSpec fn Integer
x NumSpec fn Integer
y = NumSpec fn Integer
x forall a. Num a => a -> a -> a
+ NumSpec fn Integer
y forall a. (Eq a, Show a) => a -> a -> Property
=== NumSpec fn Integer
y forall a. Num a => a -> a -> a
+ NumSpec fn Integer
x

assocNumSpec :: NumSpec fn Integer -> NumSpec fn Integer -> NumSpec fn Integer -> Property
assocNumSpec :: forall (fn :: [*] -> * -> *).
NumSpec fn Integer
-> NumSpec fn Integer -> NumSpec fn Integer -> Property
assocNumSpec NumSpec fn Integer
x NumSpec fn Integer
y NumSpec fn Integer
z = NumSpec fn Integer
x forall a. Num a => a -> a -> a
+ (NumSpec fn Integer
y forall a. Num a => a -> a -> a
+ NumSpec fn Integer
z) forall a. (Eq a, Show a) => a -> a -> Property
=== (NumSpec fn Integer
x forall a. Num a => a -> a -> a
+ NumSpec fn Integer
y) forall a. Num a => a -> a -> a
+ NumSpec fn Integer
z

commuteTimes :: NumSpec fn Integer -> NumSpec fn Integer -> Property
commuteTimes :: forall (fn :: [*] -> * -> *).
NumSpec fn Integer -> NumSpec fn Integer -> Property
commuteTimes NumSpec fn Integer
x NumSpec fn Integer
y = NumSpec fn Integer
x forall a. Num a => a -> a -> a
* NumSpec fn Integer
y forall a. (Eq a, Show a) => a -> a -> Property
=== NumSpec fn Integer
y forall a. Num a => a -> a -> a
* NumSpec fn Integer
x

assocNumSpecTimes :: Gen Property
assocNumSpecTimes :: Gen Property
assocNumSpecTimes = do
  NumSpec Any Integer
x <- forall (fn :: [*] -> * -> *). Gen (NumSpec fn Integer)
noInfinity
  NumSpec Any Integer
y <- forall (fn :: [*] -> * -> *). Gen (NumSpec fn Integer)
noInfinity
  NumSpec Any Integer
z <- forall (fn :: [*] -> * -> *). Gen (NumSpec fn Integer)
noInfinity
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (NumSpec Any Integer
x forall a. Num a => a -> a -> a
* (NumSpec Any Integer
y forall a. Num a => a -> a -> a
* NumSpec Any Integer
z) forall a. (Eq a, Show a) => a -> a -> Property
=== (NumSpec Any Integer
x forall a. Num a => a -> a -> a
* NumSpec Any Integer
y) forall a. Num a => a -> a -> a
* NumSpec Any Integer
z)

negNegate :: NumSpec fn Integer -> Property
negNegate :: forall (fn :: [*] -> * -> *). NumSpec fn Integer -> Property
negNegate NumSpec fn Integer
x = NumSpec fn Integer
x forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. Num a => a -> a
negate (forall a. Num a => a -> a
negate NumSpec fn Integer
x)

scaleNumSpec :: NumSpec fn Integer -> Property
scaleNumSpec :: forall (fn :: [*] -> * -> *). NumSpec fn Integer -> Property
scaleNumSpec NumSpec fn Integer
y = NumSpec fn Integer
y forall a. Num a => a -> a -> a
+ NumSpec fn Integer
y forall a. (Eq a, Show a) => a -> a -> Property
=== NumSpec fn Integer
2 forall a. Num a => a -> a -> a
* NumSpec fn Integer
y

scaleOne :: NumSpec fn Integer -> Property
scaleOne :: forall (fn :: [*] -> * -> *). NumSpec fn Integer -> Property
scaleOne NumSpec fn Integer
y = NumSpec fn Integer
y forall a. (Eq a, Show a) => a -> a -> Property
=== NumSpec fn Integer
1 forall a. Num a => a -> a -> a
* NumSpec fn Integer
y

numNumSpecTree :: Spec
numNumSpecTree :: Spec
numNumSpecTree =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Num (NumSpec fn Integer) properties" forall a b. (a -> b) -> a -> b
$
    forall a. (Int -> Int) -> SpecWith a -> SpecWith a
modifyMaxSuccess (forall a b. a -> b -> a
const Int
10000) forall a b. (a -> b) -> a -> b
$ do
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"plusNegate(x - y == x + negate y)" forall (fn :: [*] -> * -> *).
NumSpec fn Integer -> NumSpec fn Integer -> Property
plusNegate
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"scaleNumSpec(y + y = 2 * y)" forall (fn :: [*] -> * -> *). NumSpec fn Integer -> Property
scaleNumSpec
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"scaleOne(y = 1 * y)" forall (fn :: [*] -> * -> *). NumSpec fn Integer -> Property
scaleOne
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"negNagate(x = x == negate (negate x))" forall (fn :: [*] -> * -> *). NumSpec fn Integer -> Property
negNegate
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"commutesNumSpec(x+y = y+x)" forall (fn :: [*] -> * -> *).
NumSpec fn Integer -> NumSpec fn Integer -> Property
commutesNumSpec
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"assocNumSpec(x+(y+z) == (x+y)+z)" forall (fn :: [*] -> * -> *).
NumSpec fn Integer
-> NumSpec fn Integer -> NumSpec fn Integer -> Property
assocNumSpec
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"assocNumSpecTimes(x*(y*z) == (x*y)*z)" Gen Property
assocNumSpecTimes
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"commuteTimes" forall (fn :: [*] -> * -> *).
NumSpec fn Integer -> NumSpec fn Integer -> Property
commuteTimes

------------------------------------------------------------------------
-- Tests for `hasSize`
------------------------------------------------------------------------

hasSizeList :: Specification BaseFn [Int]
hasSizeList :: Specification BaseFn [Int]
hasSizeList = forall (fn :: [*] -> * -> *) t.
(HasSpec fn t, Sized fn t) =>
SizeSpec fn -> Specification fn t
hasSize (forall (fn :: [*] -> * -> *). Integer -> Integer -> SizeSpec fn
rangeSize Integer
0 Integer
4)

hasSizeSet :: Specification BaseFn (Set Int)
hasSizeSet :: Specification BaseFn (Set Int)
hasSizeSet = forall (fn :: [*] -> * -> *) t.
(HasSpec fn t, Sized fn t) =>
SizeSpec fn -> Specification fn t
hasSize (forall (fn :: [*] -> * -> *). Integer -> Integer -> SizeSpec fn
rangeSize Integer
1 Integer
3)

hasSizeMap :: Specification BaseFn (Map Int Int)
hasSizeMap :: Specification BaseFn (Map Int Int)
hasSizeMap = forall (fn :: [*] -> * -> *) t.
(HasSpec fn t, Sized fn t) =>
SizeSpec fn -> Specification fn t
hasSize (forall (fn :: [*] -> * -> *). Integer -> Integer -> SizeSpec fn
rangeSize Integer
1 Integer
3)

------------------------------------------------------------------------
-- Tests for narrowing
------------------------------------------------------------------------

prop_noNarrowLoop :: Int -> Int -> Specification BaseFn Int -> Specification BaseFn Int -> Property
prop_noNarrowLoop :: Int
-> Int
-> Specification BaseFn Int
-> Specification BaseFn Int
-> Property
prop_noNarrowLoop Int
f Int
s Specification BaseFn Int
eSpec Specification BaseFn Int
fSpec =
  -- Make sure the fuel is non-negative
  Int
f forall a. Ord a => a -> a -> Bool
>= Int
0 forall prop. Testable prop => Bool -> prop -> Property
==>
    forall prop. Testable prop => Int -> prop -> Property
discardAfter Int
100_000 forall a b. (a -> b) -> a -> b
$
      forall a (fn :: [*] -> * -> *).
(BaseUniverse fn, TypeSpec fn a ~ NumSpec fn a, HasSpec fn a,
 Arbitrary a, Integral a, Ord a, Random a, MaybeBounded a) =>
a
-> Int
-> (Specification fn a, Specification fn a)
-> (Specification fn a, Specification fn a)
narrowByFuelAndSize Int
f Int
s (Specification BaseFn Int
eSpec, Specification BaseFn Int
fSpec) seq :: forall a b. a -> b -> b
`seq`
        forall prop. Testable prop => prop -> Property
property Bool
True

-- | The test succeeds if conformsToSpec and conformsToSpecE both conform, or both fail to conform.
--   We collect answers by specType (ErrorSpec, MemberSpec, SuspendedSpec, ...) and whether
--   they both conform, or they both fail to conform.
conformsToSpecETest :: forall a. HasSpec BaseFn a => a -> Specification BaseFn a -> Property
conformsToSpecETest :: forall a.
HasSpec BaseFn a =>
a -> Specification BaseFn a -> Property
conformsToSpecETest a
a Specification BaseFn a
speca =
  let resultE :: Maybe (NonEmpty String)
resultE = forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
a
-> Specification fn a -> NonEmpty String -> Maybe (NonEmpty String)
conformsToSpecE a
a Specification BaseFn a
speca (forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
"ConformsToSpecETest " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Specification BaseFn a
speca))
   in if forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
a -> Specification fn a -> Bool
conformsToSpec a
a Specification BaseFn a
speca
        then case Maybe (NonEmpty String)
resultE of
          Maybe (NonEmpty String)
Nothing -> forall prop. Testable prop => prop -> Property
property (forall a prop. (Show a, Testable prop) => a -> prop -> Property
collect (forall (fn :: [*] -> * -> *) a. Specification fn a -> String
specType Specification BaseFn a
speca forall a. [a] -> [a] -> [a]
++ String
" both conform") Bool
True)
          Just NonEmpty String
xs -> forall prop. Testable prop => String -> prop -> Property
counterexample ([String] -> String
unlines (forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
xs)) Bool
False
        else case Maybe (NonEmpty String)
resultE of
          Maybe (NonEmpty String)
Nothing ->
            forall prop. Testable prop => String -> prop -> Property
counterexample (String
"conformstoSpec returns False, but conformsToSpecE returns no explanations") Bool
False
          Just NonEmpty String
_ -> forall prop. Testable prop => prop -> Property
property (forall a prop. (Show a, Testable prop) => a -> prop -> Property
collect (forall (fn :: [*] -> * -> *) a. Specification fn a -> String
specType Specification BaseFn a
speca forall a. [a] -> [a] -> [a]
++ String
" both fail to conform") Bool
True)

conformsToSpecESpec :: Spec
conformsToSpecESpec :: Spec
conformsToSpecESpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Testing alignment of conformsToSpec and conformsToSpecE" forall a b. (a -> b) -> a -> b
$
    forall a. (Int -> Int) -> SpecWith a -> SpecWith a
modifyMaxSuccess (forall a b. a -> b -> a
const Int
1000) forall a b. (a -> b) -> a -> b
$ do
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Int" (forall a.
HasSpec BaseFn a =>
a -> Specification BaseFn a -> Property
conformsToSpecETest @Int)
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Word64" (forall a.
HasSpec BaseFn a =>
a -> Specification BaseFn a -> Property
conformsToSpecETest @Word64)
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Bool" (forall a.
HasSpec BaseFn a =>
a -> Specification BaseFn a -> Property
conformsToSpecETest @Bool)
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"[Int]" (forall a.
HasSpec BaseFn a =>
a -> Specification BaseFn a -> Property
conformsToSpecETest @[Int])
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"(Int,Bool)" (forall a.
HasSpec BaseFn a =>
a -> Specification BaseFn a -> Property
conformsToSpecETest @(Int, Bool))
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Set Integer" (forall a.
HasSpec BaseFn a =>
a -> Specification BaseFn a -> Property
conformsToSpecETest @(Set Integer))
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Set[Int]" (forall a.
HasSpec BaseFn a =>
a -> Specification BaseFn a -> Property
conformsToSpecETest @(Set [Int]))
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Map Int Int" (forall a.
HasSpec BaseFn a =>
a -> Specification BaseFn a -> Property
conformsToSpecETest @(Map Int Int))