1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Properties.Stack where
import Test.QuickCheck
import Instances
import XMonad.StackSet hiding (filter)
import qualified XMonad.StackSet as S (filter)
import Data.Maybe
import Data.Proxy
import Test.QuickCheck.Classes (
Laws (lawsTypeclass, lawsProperties), Proxy1 (Proxy1),
foldableLaws, traversableLaws,
)
-- The list returned by index should be the same length as the actual
-- windows kept in the zipper
prop_index_length (x :: T) =
case stack . workspace . current $ x of
Nothing -> null (index x)
Just it -> length (index x) == length (focus it : up it ++ down it)
-- For all windows in the stackSet, findTag should identify the
-- correct workspace
prop_findIndex (x :: T) =
and [ tag w == fromJust (findTag i x)
| w <- workspace (current x) : map workspace (visible x) ++ hidden x
, t <- maybeToList (stack w)
, i <- focus t : up t ++ down t
]
prop_allWindowsMember (NonEmptyWindowsStackSet x) = do
-- Reimplementation of arbitraryWindow, but to make sure that
-- implementation doesn't change in the future, and stop using allWindows,
-- which is a key component in this test (together with member).
let ws = allWindows x
-- We know that there are at least 1 window in a NonEmptyWindowsStackSet.
idx <- choose (0, length ws - 1)
return $ member (ws!!idx) x
-- preserve order
prop_filter_order (x :: T) =
case stack $ workspace $ current x of
Nothing -> True
Just s@(Stack i _ _) -> integrate' (S.filter (/= i) s) == filter (/= i) (integrate' (Just s))
-- differentiate should return Nothing if the list is empty or Just stack, with
-- the first element of the list is current, and the rest of the list is down.
prop_differentiate xs =
if null xs then isNothing (differentiate xs)
else differentiate xs == Just (Stack (head xs) [] (tail xs))
where _ = xs :: [Int]
-- Check type class laws of 'Data.Foldable.Foldable' and 'Data.Traversable.Traversable'.
newtype TestStack a = TestStack (Stack a)
deriving (Eq, Read, Show, Foldable, Functor)
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)
prop_laws_Stack = format (foldableLaws p) <> format (traversableLaws p)
where
p = Proxy :: Proxy TestStack
format laws = [ ("Stack: " <> lawsTypeclass laws <> ": " <> name, prop)
| (name, prop) <- lawsProperties laws ]
|
