Simplify quickcheck-classes tests for Stack

We don't need the compat hacks for GHC 8.4.
This commit is contained in:
Tomas Janousek 2021-04-03 15:17:25 +01:00
parent 910d99cb74
commit 6c5204b91c
2 changed files with 10 additions and 38 deletions

View File

@ -12,11 +12,11 @@ import qualified XMonad.StackSet as S (filter)
import Data.Maybe
#ifdef VERSION_quickcheck_classes
import Data.Proxy
import Test.QuickCheck.Classes (
Laws (lawsTypeclass, lawsProperties), Proxy1 (Proxy1),
foldableLaws, traversableLaws,
)
import Data.Functor.Classes (Eq1 (liftEq), Show1 (liftShowsPrec))
#endif
@ -66,47 +66,18 @@ prop_differentiate xs =
newtype TestStack a = TestStack (Stack a)
deriving (Eq, Read, Show, Foldable, Functor)
instance Arbitrary1 TestStack where
liftArbitrary gen =
(\ x xu xd -> TestStack (Stack x xu xd))
<$> gen
<*> liftArbitrary gen
<*> liftArbitrary gen
instance (Arbitrary a) => Arbitrary (TestStack a) where
arbitrary = arbitrary1
shrink = shrink1
arbitrary = TestStack <$> (Stack <$> arbitrary <*> arbitrary <*> arbitrary)
shrink = traverse shrink
instance Traversable TestStack where
traverse f (TestStack sx) = fmap TestStack (traverse f sx)
instance Eq1 TestStack where
liftEq f (TestStack (Stack x xu xd)) (TestStack (Stack y yu yd)) =
f x y && liftEq f xu yu && liftEq f xd yd
instance Show1 TestStack where
liftShowsPrec shwP shwL p (TestStack (Stack x xu xd)) =
showString "TestStack (Stack {focus = "
<> shwP p x
<> showString ", up = "
<> shwL xu
<> showString ", down ="
<> shwL xd
<> showString "})"
proxy_TestStack :: Proxy1 TestStack
proxy_TestStack = Proxy1
laws_Stack_Traversable, laws_Stack_Foldable :: Laws
laws_Stack_Traversable = traversableLaws proxy_TestStack
laws_Stack_Foldable = foldableLaws proxy_TestStack
prop_laws_Stack =
format laws_Stack_Foldable <> format laws_Stack_Traversable
prop_laws_Stack = format (foldableLaws p) <> format (traversableLaws p)
where
format laws =
fmap
(\(name, prop) ->
("Stack: " <> lawsTypeclass laws <> ": " <> name, prop))
(lawsProperties laws)
p = Proxy :: Proxy TestStack
format laws = [ ("Stack: " <> lawsTypeclass laws <> ": " <> name, prop)
| (name, prop) <- lawsProperties laws ]
#else
prop_laws_Stack = []
#endif

View File

@ -143,8 +143,9 @@ test-suite properties
, containers
, xmonad
if flag(quickcheck-classes)
if flag(quickcheck-classes) && impl(ghc > 8.5)
-- no quickcheck-classes in LTS-12
-- GHC 8.4 and lower needs too much boilerplate (Eq1, Show1, …)
build-depends: quickcheck-classes >= 0.4.3
if flag(pedantic)