mirror of
https://github.com/xmonad/xmonad.git
synced 2025-05-19 00:20:22 -07:00
Simplify quickcheck-classes tests for Stack
We don't need the compat hacks for GHC 8.4.
This commit is contained in:
parent
910d99cb74
commit
6c5204b91c
@ -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
|
||||
instance (Arbitrary a) => Arbitrary (TestStack a) where
|
||||
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
|
||||
|
@ -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)
|
||||
|
Loading…
x
Reference in New Issue
Block a user