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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
{-# LANGUAGE ScopedTypeVariables #-}
module Instances where
import Test.QuickCheck
import Utils
import XMonad.StackSet
import Control.Monad
import Data.List (nub, genericLength)
import Debug.Trace
import Graphics.X11 (Rectangle(Rectangle))
import Control.Applicative
--
-- The all important Arbitrary instance for StackSet.
--
instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary l, Arbitrary sd)
=> Arbitrary (StackSet i l a s sd) where
arbitrary = do
-- TODO: Fix this to be a reasonable higher number, Possibly use PositiveSized
numWs <- choose (1, 20) -- number of workspaces, there must be at least 1.
numScreens <- choose (1, numWs) -- number of physical screens, there must be at least 1
lay <- arbitrary -- pick any layout
wsIdxInFocus <- choose (1, numWs) -- pick index of WS to be in focus
-- The same screen id's will be present in the list, with high possibility.
screens <- replicateM numScreens arbitrary
-- Generate a list of "windows" for each workspace.
wsWindows <- vector numWs :: Gen [[a]]
-- Pick a random window "number" in each workspace, to give focus.
focus <- sequence [ if null windows
then return Nothing
else liftM Just $ choose (0, length windows - 1)
| windows <- wsWindows ]
let tags = [1 .. fromIntegral numWs]
focusWsWindows = zip focus wsWindows
wss = zip tags focusWsWindows -- tmp representation of a workspace (tag, windows)
initSs = new lay tags screens
return $
view (fromIntegral wsIdxInFocus) $
foldr (\(tag, (focus, windows)) ss -> -- Fold through all generated (tags,windows).
-- set workspace active by tag and fold through all
-- windows while inserting them. Apply the given number
-- of `focusUp` on the resulting StackSet.
applyN focus focusUp $ foldr insertUp (view tag ss) windows
) initSs wss
--
-- Just generate StackSets with Char elements.
--
type Tag = Int
type Window = Char
type T = StackSet Tag Int Window Int Int
newtype EmptyStackSet = EmptyStackSet T
deriving Show
instance Arbitrary EmptyStackSet where
arbitrary = do
(NonEmptyNubList ns) <- arbitrary
(NonEmptyNubList sds) <- arbitrary
l <- arbitrary
-- there cannot be more screens than workspaces:
return . EmptyStackSet . new l ns $ take (min (length ns) (length sds)) sds
newtype NonEmptyWindowsStackSet = NonEmptyWindowsStackSet T
deriving Show
instance Arbitrary NonEmptyWindowsStackSet where
arbitrary =
NonEmptyWindowsStackSet `fmap` (arbitrary `suchThat` (not . null . allWindows))
instance Arbitrary Rectangle where
arbitrary = Rectangle <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
newtype SizedPositive = SizedPositive Int
deriving (Eq, Ord, Show, Read)
instance Arbitrary SizedPositive where
arbitrary = sized $ \s -> do x <- choose (1, max 1 s)
return $ SizedPositive x
newtype NonEmptyNubList a = NonEmptyNubList [a]
deriving ( Eq, Ord, Show, Read )
instance (Eq a, Arbitrary a) => Arbitrary (NonEmptyNubList a) where
arbitrary = NonEmptyNubList `fmap` ((liftM nub arbitrary) `suchThat` (not . null))
-- | Pull out an arbitrary tag from the StackSet. This removes the need for the
-- precondition "n `tagMember x` in many properties and thus reduces the number
-- of discarded tests.
--
-- n <- arbitraryTag x
--
-- We can do the reverse with a simple `suchThat`:
--
-- n <- arbitrary `suchThat` \n' -> not $ n' `tagMember` x
arbitraryTag :: T -> Gen Tag
arbitraryTag x = do
let ts = tags x
-- There must be at least 1 workspace, thus at least 1 tag.
idx <- choose (0, (length ts) - 1)
return $ ts!!idx
-- | Pull out an arbitrary window from a StackSet that is guaranteed to have a
-- non empty set of windows. This eliminates the precondition "i `member` x" in
-- a few properties.
--
--
-- foo (nex :: NonEmptyWindowsStackSet) = do
-- let NonEmptyWindowsStackSet x = nex
-- w <- arbitraryWindow nex
-- return $ .......
--
-- We can do the reverse with a simple `suchThat`:
--
-- n <- arbitrary `suchThat` \n' -> not $ n `member` x
arbitraryWindow :: NonEmptyWindowsStackSet -> Gen Window
arbitraryWindow (NonEmptyWindowsStackSet x) = do
let ws = allWindows x
-- We know that there are at least 1 window in a NonEmptyWindowsStackSet.
idx <- choose(0, (length ws) - 1)
return $ ws!!idx
|
