aboutsummaryrefslogtreecommitdiffstats
path: root/tests/Properties
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Properties')
-rw-r--r--tests/Properties/Delete.hs70
-rw-r--r--tests/Properties/Failure.hs26
-rw-r--r--tests/Properties/Floating.hs36
-rw-r--r--tests/Properties/Focus.hs74
-rw-r--r--tests/Properties/GreedyView.hs44
-rw-r--r--tests/Properties/Insert.hs52
-rw-r--r--tests/Properties/Layout/Full.hs34
-rw-r--r--tests/Properties/Layout/Tall.hs116
-rw-r--r--tests/Properties/Screen.hs40
-rw-r--r--tests/Properties/Shift.hs70
-rw-r--r--tests/Properties/Stack.hs51
-rw-r--r--tests/Properties/StackSet.hs135
-rw-r--r--tests/Properties/Swap.hs47
-rw-r--r--tests/Properties/View.hs47
-rw-r--r--tests/Properties/Workspace.hs65
15 files changed, 907 insertions, 0 deletions
diff --git a/tests/Properties/Delete.hs b/tests/Properties/Delete.hs
new file mode 100644
index 0000000..6fb7566
--- /dev/null
+++ b/tests/Properties/Delete.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.Delete where
+
+import Test.QuickCheck
+import Instances
+import Utils
+
+import XMonad.StackSet hiding (filter)
+
+-- ---------------------------------------------------------------------
+-- 'delete'
+
+-- deleting the current item removes it.
+prop_delete x =
+ case peek x of
+ Nothing -> True
+ Just i -> not (member i (delete i x))
+ where _ = x :: T
+
+-- delete is reversible with 'insert'.
+-- It is the identiy, except for the 'master', which is reset on insert and delete.
+--
+prop_delete_insert (x :: T) =
+ case peek x of
+ Nothing -> True
+ Just n -> insertUp n (delete n y) == y
+ where
+ y = swapMaster x
+
+-- delete should be local
+prop_delete_local (x :: T) =
+ case peek x of
+ Nothing -> True
+ Just i -> hidden_spaces x == hidden_spaces (delete i x)
+
+-- delete should not affect focus unless the focused element is what is being deleted
+prop_delete_focus = do
+ -- There should be at least two windows. One in focus, and some to try and
+ -- delete (doesn't have to be windows on the current workspace). We generate
+ -- our own, since we can't rely on NonEmptyWindowsStackSet returning one in
+ -- the argument with at least two windows.
+ x <- arbitrary `suchThat` \x' -> length (allWindows x') >= 2
+ w <- arbitraryWindow (NonEmptyWindowsStackSet x)
+ -- Make sure we pick a window that is NOT the currently focused
+ `suchThat` \w' -> Just w' /= peek x
+ return $ peek (delete w x) == peek x
+
+-- focus movement in the presence of delete:
+-- when the last window in the stack set is focused, focus moves `up'.
+-- usual case is that it moves 'down'.
+prop_delete_focus_end = do
+ -- Generate a StackSet with at least two windows on the current workspace.
+ x <- arbitrary `suchThat` \(x' :: T) -> length (index x') >= 2
+ let w = last (index x)
+ y = focusWindow w x -- focus last window in stack
+ return $ peek (delete w y) == peek (focusUp y)
+
+
+-- focus movement in the presence of delete:
+-- when not in the last item in the stack, focus moves down
+prop_delete_focus_not_end = do
+ x <- arbitrary
+ -- There must be at least two windows and the current focused is not the
+ -- last one in the stack.
+ `suchThat` \(x' :: T) ->
+ let currWins = index x'
+ in length (currWins) >= 2 && peek x' /= Just (last currWins)
+ -- This is safe, as we know there are >= 2 windows
+ let Just n = peek x
+ return $ peek (delete n x) == peek (focusDown x)
diff --git a/tests/Properties/Failure.hs b/tests/Properties/Failure.hs
new file mode 100644
index 0000000..fc7a359
--- /dev/null
+++ b/tests/Properties/Failure.hs
@@ -0,0 +1,26 @@
+module Properties.Failure where
+
+import XMonad.StackSet hiding (filter)
+
+import qualified Control.Exception.Extensible as C
+import System.IO.Unsafe
+
+-- ---------------------------------------------------------------------
+-- testing for failure
+
+-- and help out hpc
+prop_abort x = unsafePerformIO $ C.catch (abort "fail")
+ (\(C.SomeException e) -> return $ show e == "xmonad: StackSet: fail" )
+ where
+ _ = x :: Int
+
+-- new should fail with an abort
+prop_new_abort x = unsafePerformIO $ C.catch f
+ (\(C.SomeException e) -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" )
+ where
+ f = new undefined{-layout-} [] [] `seq` return False
+
+ _ = x :: Int
+
+-- TODO: Fix this?
+-- prop_view_should_fail = view {- with some bogus data -}
diff --git a/tests/Properties/Floating.hs b/tests/Properties/Floating.hs
new file mode 100644
index 0000000..a9afad7
--- /dev/null
+++ b/tests/Properties/Floating.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.Floating where
+
+import Test.QuickCheck
+import Instances
+
+import XMonad.StackSet hiding (filter)
+
+import qualified Data.Map as M
+
+------------------------------------------------------------------------
+-- properties for the floating layer:
+
+prop_float_reversible (nex :: NonEmptyWindowsStackSet) = do
+ let NonEmptyWindowsStackSet x = nex
+ w <- arbitraryWindow nex
+ return $ sink w (float w geom x) == x
+ where
+ geom = RationalRect 100 100 100 100
+
+prop_float_geometry (nex :: NonEmptyWindowsStackSet) = do
+ let NonEmptyWindowsStackSet x = nex
+ w <- arbitraryWindow nex
+ let s = float w geom x
+ return $ M.lookup w (floating s) == Just geom
+ where
+ geom = RationalRect 100 100 100 100
+
+prop_float_delete (nex :: NonEmptyWindowsStackSet) = do
+ let NonEmptyWindowsStackSet x = nex
+ w <- arbitraryWindow nex
+ let s = float w geom x
+ t = delete w s
+ return $ not (w `member` t)
+ where
+ geom = RationalRect 100 100 100 100
diff --git a/tests/Properties/Focus.hs b/tests/Properties/Focus.hs
new file mode 100644
index 0000000..865dc72
--- /dev/null
+++ b/tests/Properties/Focus.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.Focus where
+
+import Test.QuickCheck
+import Instances
+import Utils
+
+import XMonad.StackSet hiding (filter)
+
+import Data.Maybe (fromJust)
+
+-- ---------------------------------------------------------------------
+-- rotating focus
+--
+
+-- master/focus
+--
+-- The tiling order, and master window, of a stack is unaffected by focus changes.
+--
+prop_focus_left_master (SizedPositive n) (x::T) =
+ index (applyN (Just n) focusUp x) == index x
+prop_focus_right_master (SizedPositive n) (x::T) =
+ index (applyN (Just n) focusDown x) == index x
+prop_focus_master_master (SizedPositive n) (x::T) =
+ index (applyN (Just n) focusMaster x) == index x
+
+prop_focusWindow_master (NonNegative n) (x :: T) =
+ case peek x of
+ Nothing -> True
+ Just _ -> let s = index x
+ i = n `mod` length s
+ in index (focusWindow (s !! i) x) == index x
+
+-- shifting focus is trivially reversible
+prop_focus_left (x :: T) = (focusUp (focusDown x)) == x
+prop_focus_right (x :: T) = (focusDown (focusUp x)) == x
+
+-- focus master is idempotent
+prop_focusMaster_idem (x :: T) = focusMaster x == focusMaster (focusMaster x)
+
+-- focusWindow actually leaves the window focused...
+prop_focusWindow_works (n :: NonNegative Int) (x :: T) =
+ case peek x of
+ Nothing -> True
+ Just _ -> let s = index x
+ i = fromIntegral n `mod` length s
+ in (focus . fromJust . stack . workspace . current) (focusWindow (s !! i) x) == (s !! i)
+
+-- rotation through the height of a stack gets us back to the start
+prop_focus_all_l (x :: T) = (foldr (const focusUp) x [1..n]) == x
+ where n = length (index x)
+prop_focus_all_r (x :: T) = (foldr (const focusDown) x [1..n]) == x
+ where n = length (index x)
+
+-- prop_rotate_all (x :: T) = f (f x) == f x
+-- f x' = foldr (\_ y -> rotate GT y) x' [1..n]
+
+-- focus is local to the current workspace
+prop_focus_down_local (x :: T) = hidden_spaces (focusDown x) == hidden_spaces x
+prop_focus_up_local (x :: T) = hidden_spaces (focusUp x) == hidden_spaces x
+
+prop_focus_master_local (x :: T) = hidden_spaces (focusMaster x) == hidden_spaces x
+
+prop_focusWindow_local (n :: NonNegative Int) (x::T ) =
+ case peek x of
+ Nothing -> True
+ Just _ -> let s = index x
+ i = fromIntegral n `mod` length s
+ in hidden_spaces (focusWindow (s !! i) x) == hidden_spaces x
+
+-- On an invalid window, the stackset is unmodified
+prop_focusWindow_identity (x::T ) = do
+ n <- arbitrary `suchThat` \n' -> not $ n' `member` x
+ return $ focusWindow n x == x
diff --git a/tests/Properties/GreedyView.hs b/tests/Properties/GreedyView.hs
new file mode 100644
index 0000000..3f2eb9b
--- /dev/null
+++ b/tests/Properties/GreedyView.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.GreedyView where
+
+import Test.QuickCheck
+import Instances
+import Utils
+
+import XMonad.StackSet hiding (filter)
+
+import Data.List (sortBy)
+
+-- ---------------------------------------------------------------------
+-- greedyViewing workspaces
+
+-- greedyView sets the current workspace to 'n'
+prop_greedyView_current (x :: T) = do
+ n <- arbitraryTag x
+ return $ currentTag (greedyView n x) == n
+
+-- greedyView leaves things unchanged for invalid workspaces
+prop_greedyView_current_id (x :: T) = do
+ n <- arbitrary `suchThat` \n' -> not $ n' `tagMember` x
+ return $ currentTag (greedyView n x) == currentTag x
+
+-- greedyView *only* sets the current workspace, and touches Xinerama.
+-- no workspace contents will be changed.
+prop_greedyView_local (x :: T) = do
+ n <- arbitraryTag x
+ return $ workspaces x == workspaces (greedyView n x)
+ where
+ workspaces a = sortBy (\s t -> tag s `compare` tag t) $
+ workspace (current a)
+ : map workspace (visible a) ++ hidden a
+
+-- greedyView is idempotent
+prop_greedyView_idem (x :: T) = do
+ n <- arbitraryTag x
+ return $ greedyView n (greedyView n x) == (greedyView n x)
+
+-- greedyView is reversible, though shuffles the order of hidden/visible
+prop_greedyView_reversible (x :: T) = do
+ n <- arbitraryTag x
+ return $ normal (greedyView n' (greedyView n x)) == normal x
+ where n' = currentTag x
diff --git a/tests/Properties/Insert.hs b/tests/Properties/Insert.hs
new file mode 100644
index 0000000..c277795
--- /dev/null
+++ b/tests/Properties/Insert.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.Insert where
+
+import Test.QuickCheck
+import Instances
+import Utils
+
+import XMonad.StackSet hiding (filter)
+
+import Data.List (nub)
+
+-- ---------------------------------------------------------------------
+-- 'insert'
+
+-- inserting a item into an empty stackset means that item is now a member
+prop_insert_empty i (EmptyStackSet x)= member i (insertUp i x)
+
+-- insert should be idempotent
+prop_insert_idem i (x :: T) = insertUp i x == insertUp i (insertUp i x)
+
+-- insert when an item is a member should leave the stackset unchanged
+prop_insert_duplicate (nex :: NonEmptyWindowsStackSet) = do
+ let NonEmptyWindowsStackSet x = nex
+ w <- arbitraryWindow nex
+ return $ insertUp w x == x
+
+-- push shouldn't change anything but the current workspace
+prop_insert_local (x :: T) = do
+ i <- arbitrary `suchThat` \i' -> not $ i' `member` x
+ return $ hidden_spaces x == hidden_spaces (insertUp i x)
+
+-- Inserting a (unique) list of items into an empty stackset should
+-- result in the last inserted element having focus.
+prop_insert_peek (EmptyStackSet x) (NonEmptyNubList is) =
+ peek (foldr insertUp x is) == Just (head is)
+
+-- insert >> delete is the identity, when i `notElem` .
+-- Except for the 'master', which is reset on insert and delete.
+--
+prop_insert_delete x = do
+ n <- arbitrary `suchThat` \n -> not $ n `member` x
+ return $ delete n (insertUp n y) == (y :: T)
+ where
+ y = swapMaster x -- sets the master window to the current focus.
+ -- otherwise, we don't have a rule for where master goes.
+
+-- inserting n elements increases current stack size by n
+prop_size_insert is (EmptyStackSet x) =
+ size (foldr insertUp x ws ) == (length ws)
+ where
+ ws = nub is
+ size = length . index
diff --git a/tests/Properties/Layout/Full.hs b/tests/Properties/Layout/Full.hs
new file mode 100644
index 0000000..eca6ec3
--- /dev/null
+++ b/tests/Properties/Layout/Full.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.Layout.Full where
+
+import Test.QuickCheck
+import Instances
+
+import XMonad.StackSet hiding (filter)
+import XMonad.Core
+import XMonad.Layout
+
+import Data.Maybe
+
+------------------------------------------------------------------------
+-- Full layout
+
+-- pureLayout works for Full
+prop_purelayout_full rect = do
+ x <- (arbitrary :: Gen T) `suchThat` (isJust . peek)
+ let layout = Full
+ st = fromJust . stack . workspace . current $ x
+ ts = pureLayout layout rect st
+ return $
+ length ts == 1 -- only one window to view
+ &&
+ snd (head ts) == rect -- and sets fullscreen
+ &&
+ fst (head ts) == fromJust (peek x) -- and the focused window is shown
+
+
+-- what happens when we send an IncMaster message to Full --- Nothing
+prop_sendmsg_full (NonNegative k) =
+ isNothing (Full `pureMessage` (SomeMessage (IncMasterN k)))
+
+prop_desc_full = description Full == show Full
diff --git a/tests/Properties/Layout/Tall.hs b/tests/Properties/Layout/Tall.hs
new file mode 100644
index 0000000..7464184
--- /dev/null
+++ b/tests/Properties/Layout/Tall.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.Layout.Tall where
+
+import Test.QuickCheck
+import Instances
+import Utils
+
+import XMonad.StackSet hiding (filter)
+import XMonad.Core
+import XMonad.Layout
+
+import Graphics.X11.Xlib.Types (Rectangle(..))
+
+import Data.Maybe
+import Data.List (sort)
+import Data.Ratio
+
+------------------------------------------------------------------------
+-- The Tall layout
+
+-- 1 window should always be tiled fullscreen
+prop_tile_fullscreen rect = tile pct rect 1 1 == [rect]
+ where pct = 1/2
+
+-- multiple windows
+prop_tile_non_overlap rect windows nmaster = noOverlaps (tile pct rect nmaster windows)
+ where _ = rect :: Rectangle
+ pct = 3 % 100
+
+-- splitting horizontally yields sensible results
+prop_split_hoziontal (NonNegative n) x =
+ sum (map rect_width xs) == rect_width x
+ &&
+ all (== rect_height x) (map rect_height xs)
+ &&
+ (map rect_x xs) == (sort $ map rect_x xs)
+
+ where
+ xs = splitHorizontally n x
+
+-- splitting horizontally yields sensible results
+prop_splitVertically (r :: Rational) x =
+
+ rect_x x == rect_x a && rect_x x == rect_x b
+ &&
+ rect_width x == rect_width a && rect_width x == rect_width b
+ where
+ (a,b) = splitVerticallyBy r x
+
+
+-- pureLayout works.
+prop_purelayout_tall n r1 r2 rect = do
+ x <- (arbitrary :: Gen T) `suchThat` (isJust . peek)
+ let layout = Tall n r1 r2
+ st = fromJust . stack . workspace . current $ x
+ ts = pureLayout layout rect st
+ return $
+ length ts == length (index x)
+ &&
+ noOverlaps (map snd ts)
+ &&
+ description layout == "Tall"
+
+
+-- Test message handling of Tall
+
+-- what happens when we send a Shrink message to Tall
+prop_shrink_tall (NonNegative n) (NonZero (NonNegative delta)) (NonNegative frac) =
+ n == n' && delta == delta' -- these state components are unchanged
+ && frac' <= frac && (if frac' < frac then frac' == 0 || frac' == frac - delta
+ else frac == 0 )
+ -- remaining fraction should shrink
+ where
+ l1 = Tall n delta frac
+ Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage Shrink)
+ -- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
+
+
+-- what happens when we send a Shrink message to Tall
+prop_expand_tall (NonNegative n)
+ (NonZero (NonNegative delta))
+ (NonNegative n1)
+ (NonZero (NonNegative d1)) =
+
+ n == n'
+ && delta == delta' -- these state components are unchanged
+ && frac' >= frac
+ && (if frac' > frac
+ then frac' == 1 || frac' == frac + delta
+ else frac == 1 )
+
+ -- remaining fraction should shrink
+ where
+ frac = min 1 (n1 % d1)
+ l1 = Tall n delta frac
+ Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage Expand)
+ -- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
+
+-- what happens when we send an IncMaster message to Tall
+prop_incmaster_tall (NonNegative n) (NonZero (NonNegative delta)) (NonNegative frac)
+ (NonNegative k) =
+ delta == delta' && frac == frac' && n' == n + k
+ where
+ l1 = Tall n delta frac
+ Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage (IncMasterN k))
+ -- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
+
+
+
+ -- toMessage LT = SomeMessage Shrink
+ -- toMessage EQ = SomeMessage Expand
+ -- toMessage GT = SomeMessage (IncMasterN 1)
+
+
+prop_desc_mirror n r1 r2 = description (Mirror $! t) == "Mirror Tall"
+ where t = Tall n r1 r2
diff --git a/tests/Properties/Screen.hs b/tests/Properties/Screen.hs
new file mode 100644
index 0000000..09a08af
--- /dev/null
+++ b/tests/Properties/Screen.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.Screen where
+
+import Test.QuickCheck
+import Instances
+
+import XMonad.StackSet hiding (filter)
+import XMonad.Operations (applyResizeIncHint, applyMaxSizeHint )
+import Graphics.X11.Xlib.Types (Dimension)
+
+prop_screens (x :: T) = n `elem` screens x
+ where
+ n = current x
+
+-- screens makes sense
+prop_screens_works (x :: T) = screens x == current x : visible x
+
+
+------------------------------------------------------------------------
+-- Aspect ratios
+
+prop_resize_inc (NonZero (NonNegative inc_w),NonZero (NonNegative inc_h)) b@(w,h) =
+ w' `mod` inc_w == 0 && h' `mod` inc_h == 0
+ where (w',h') = applyResizeIncHint a b
+ a = (inc_w,inc_h)
+
+prop_resize_inc_extra ((NonNegative inc_w)) b@(w,h) =
+ (w,h) == (w',h')
+ where (w',h') = applyResizeIncHint a b
+ a = (-inc_w,0::Dimension)-- inc_h)
+
+prop_resize_max (NonZero (NonNegative inc_w),NonZero (NonNegative inc_h)) b@(w,h) =
+ w' <= inc_w && h' <= inc_h
+ where (w',h') = applyMaxSizeHint a b
+ a = (inc_w,inc_h)
+
+prop_resize_max_extra ((NonNegative inc_w)) b@(w,h) =
+ (w,h) == (w',h')
+ where (w',h') = applyMaxSizeHint a b
+ a = (-inc_w,0::Dimension)-- inc_h)
diff --git a/tests/Properties/Shift.hs b/tests/Properties/Shift.hs
new file mode 100644
index 0000000..2150cbf
--- /dev/null
+++ b/tests/Properties/Shift.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.Shift where
+
+import Test.QuickCheck
+import Instances
+import Utils
+
+import XMonad.StackSet hiding (filter)
+
+import qualified Data.List as L
+
+-- ---------------------------------------------------------------------
+-- shift
+
+-- shift is fully reversible on current window, when focus and master
+-- are the same. otherwise, master may move.
+prop_shift_reversible (x :: T) = do
+ i <- arbitraryTag x
+ case peek y of
+ Nothing -> return True
+ Just _ -> return $ normal ((view n . shift n . view i . shift i) y) == normal y
+ where
+ y = swapMaster x
+ n = currentTag y
+
+------------------------------------------------------------------------
+-- shiftMaster
+
+-- focus/local/idempotent same as swapMaster:
+prop_shift_master_focus (x :: T) = peek x == (peek $ shiftMaster x)
+prop_shift_master_local (x :: T) = hidden_spaces x == hidden_spaces (shiftMaster x)
+prop_shift_master_idempotent (x :: T) = shiftMaster (shiftMaster x) == shiftMaster x
+-- ordering is constant modulo the focused window:
+prop_shift_master_ordering (x :: T) = case peek x of
+ Nothing -> True
+ Just m -> L.delete m (index x) == L.delete m (index $ shiftMaster x)
+
+-- ---------------------------------------------------------------------
+-- shiftWin
+
+-- shiftWin on current window is the same as shift
+prop_shift_win_focus (x :: T) = do
+ n <- arbitraryTag x
+ case peek x of
+ Nothing -> return True
+ Just w -> return $ shiftWin n w x == shift n x
+
+-- shiftWin on a non-existant window is identity
+prop_shift_win_indentity (x :: T) = do
+ n <- arbitraryTag x
+ w <- arbitrary `suchThat` \w' -> not (w' `member` x)
+ return $ shiftWin n w x == x
+
+-- shiftWin leaves the current screen as it is, if neither n is the tag
+-- of the current workspace nor w on the current workspace
+prop_shift_win_fix_current = do
+ x <- arbitrary `suchThat` \(x' :: T) ->
+ -- Invariant, otherWindows are NOT in the current workspace.
+ let otherWindows = allWindows x' L.\\ index x'
+ in length(tags x') >= 2 && length(otherWindows) >= 1
+ -- Sadly we have to construct `otherWindows` again, for the actual StackSet
+ -- that got chosen.
+ let otherWindows = allWindows x L.\\ index x
+ -- We know such tag must exists, due to the precondition
+ n <- arbitraryTag x `suchThat` (/= currentTag x)
+ -- we know length is >= 1, from above precondition
+ idx <- choose(0, length(otherWindows) - 1)
+ let w = otherWindows !! idx
+ return $ (current $ x) == (current $ shiftWin n w x)
+
diff --git a/tests/Properties/Stack.hs b/tests/Properties/Stack.hs
new file mode 100644
index 0000000..586df1d
--- /dev/null
+++ b/tests/Properties/Stack.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.Stack where
+
+import Test.QuickCheck
+import Instances
+
+import XMonad.StackSet hiding (filter)
+import qualified XMonad.StackSet as S (filter)
+
+import Data.Maybe
+
+
+-- 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 -> length (index x) == 0
+ 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 differentiate xs == Nothing
+ else (differentiate xs) == Just (Stack (head xs) [] (tail xs))
+ where _ = xs :: [Int]
diff --git a/tests/Properties/StackSet.hs b/tests/Properties/StackSet.hs
new file mode 100644
index 0000000..7fc5192
--- /dev/null
+++ b/tests/Properties/StackSet.hs
@@ -0,0 +1,135 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.StackSet where
+
+import Test.QuickCheck
+import Instances
+import Utils
+
+import XMonad.StackSet hiding (filter)
+
+import Data.Maybe
+
+import Data.List (nub)
+-- ---------------------------------------------------------------------
+-- QuickCheck properties for the StackSet
+
+-- Some general hints for creating StackSet properties:
+--
+-- * ops that mutate the StackSet are usually local
+-- * most ops on StackSet should either be trivially reversible, or
+-- idempotent, or both.
+------------------------------------------------------------------------
+
+-- Basic data invariants of the StackSet
+--
+-- With the new zipper-based StackSet, tracking focus is no longer an
+-- issue: the data structure enforces focus by construction.
+--
+-- But we still need to ensure there are no duplicates, and master/and
+-- the xinerama mapping aren't checked by the data structure at all.
+--
+-- * no element should ever appear more than once in a StackSet
+-- * the xinerama screen map should be:
+-- -- keys should always index valid workspaces
+-- -- monotonically ascending in the elements
+-- * the current workspace should be a member of the xinerama screens
+--
+invariant (s :: T) = and
+ -- no duplicates
+ [ noDuplicates
+
+ -- TODO: Fix this.
+ -- all this xinerama stuff says we don't have the right structure
+-- , validScreens
+-- , validWorkspaces
+-- , inBounds
+ ]
+ where
+ ws = concat [ focus t : up t ++ down t
+ | w <- workspace (current s) : map workspace (visible s) ++ hidden s
+ , t <- maybeToList (stack w)] :: [Char]
+ noDuplicates = nub ws == ws
+
+-- validScreens = monotonic . sort . M. . (W.current s : W.visible : W$ s
+
+-- validWorkspaces = and [ w `elem` allworkspaces | w <- (M.keys . screens) s ]
+-- where allworkspaces = map tag $ current s : prev s ++ next s
+
+-- inBounds = and [ w >=0 && w < size s | (w,sc) <- M.assocs (screens s) ]
+
+monotonic [] = True
+monotonic (x:[]) = True
+monotonic (x:y:zs) | x == y-1 = monotonic (y:zs)
+ | otherwise = False
+
+prop_invariant = invariant
+
+-- and check other ops preserve invariants
+prop_empty_I (SizedPositive n) l = forAll (choose (1, fromIntegral n)) $ \m ->
+ forAll (vector m) $ \ms ->
+ invariant $ new l [0..fromIntegral n-1] ms
+
+prop_view_I n (x :: T) =
+ invariant $ view n x
+
+prop_greedyView_I n (x :: T) =
+ invariant $ greedyView n x
+
+prop_focusUp_I (SizedPositive n) (x :: T) =
+ invariant $ applyN (Just n) focusUp x
+prop_focusMaster_I (SizedPositive n) (x :: T) =
+ invariant $ applyN (Just n) focusMaster x
+prop_focusDown_I (SizedPositive n) (x :: T) =
+ invariant $ applyN (Just n) focusDown x
+
+prop_focus_I (SizedPositive n) (x :: T) =
+ case peek x of
+ Nothing -> True
+ Just _ -> let w = focus . fromJust . stack . workspace . current $
+ applyN (Just n) focusUp x
+ in invariant $ focusWindow w x
+
+prop_insertUp_I n (x :: T) = invariant $ insertUp n x
+
+prop_delete_I (x :: T) = invariant $
+ case peek x of
+ Nothing -> x
+ Just i -> delete i x
+
+prop_swap_master_I (x :: T) = invariant $ swapMaster x
+
+prop_swap_left_I (SizedPositive n) (x :: T) =
+ invariant $ applyN (Just n) swapUp x
+prop_swap_right_I (SizedPositive n) (x :: T) =
+ invariant $ applyN (Just n) swapDown x
+
+prop_shift_I (x :: T) = do
+ n <- arbitraryTag x
+ return $ invariant $ shift (fromIntegral n) x
+
+prop_shift_win_I (nex :: NonEmptyWindowsStackSet) = do
+ let NonEmptyWindowsStackSet x = nex
+ w <- arbitraryWindow nex
+ n <- arbitraryTag x
+ return $ invariant $ shiftWin n w x
+
+
+-- ---------------------------------------------------------------------
+
+
+-- empty StackSets have no windows in them
+prop_empty (EmptyStackSet x) =
+ all (== Nothing) [ stack w | w <- workspace (current x)
+ : map workspace (visible x) ++ hidden x ]
+
+-- empty StackSets always have focus on first workspace
+prop_empty_current (EmptyStackSet x) = currentTag x == head (tags x)
+
+-- no windows will be a member of an empty workspace
+prop_member_empty i (EmptyStackSet x) = member i x == False
+
+-- peek either yields nothing on the Empty workspace, or Just a valid window
+prop_member_peek (x :: T) =
+ case peek x of
+ Nothing -> True {- then we don't know anything -}
+ Just i -> member i x
diff --git a/tests/Properties/Swap.hs b/tests/Properties/Swap.hs
new file mode 100644
index 0000000..a516f2c
--- /dev/null
+++ b/tests/Properties/Swap.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.Swap where
+
+import Test.QuickCheck
+import Instances
+import Utils
+
+import XMonad.StackSet hiding (filter)
+
+-- ---------------------------------------------------------------------
+-- swapUp, swapDown, swapMaster: reordiring windows
+
+-- swap is trivially reversible
+prop_swap_left (x :: T) = (swapUp (swapDown x)) == x
+prop_swap_right (x :: T) = (swapDown (swapUp x)) == x
+-- TODO swap is reversible
+-- swap is reversible, but involves moving focus back the window with
+-- master on it. easy to do with a mouse...
+{-
+prop_promote_reversible x b = (not . null . fromMaybe [] . flip index x . current $ x) ==>
+ (raiseFocus y . promote . raiseFocus z . promote) x == x
+ where _ = x :: T
+ dir = if b then LT else GT
+ (Just y) = peek x
+ (Just (z:_)) = flip index x . current $ x
+-}
+
+-- swap doesn't change focus
+prop_swap_master_focus (x :: T) = peek x == (peek $ swapMaster x)
+-- = case peek x of
+-- Nothing -> True
+-- Just f -> focus (stack (workspace $ current (swap x))) == f
+prop_swap_left_focus (x :: T) = peek x == (peek $ swapUp x)
+prop_swap_right_focus (x :: T) = peek x == (peek $ swapDown x)
+
+-- swap is local
+prop_swap_master_local (x :: T) = hidden_spaces x == hidden_spaces (swapMaster x)
+prop_swap_left_local (x :: T) = hidden_spaces x == hidden_spaces (swapUp x)
+prop_swap_right_local (x :: T) = hidden_spaces x == hidden_spaces (swapDown x)
+
+-- rotation through the height of a stack gets us back to the start
+prop_swap_all_l (x :: T) = (foldr (const swapUp) x [1..n]) == x
+ where n = length (index x)
+prop_swap_all_r (x :: T) = (foldr (const swapDown) x [1..n]) == x
+ where n = length (index x)
+
+prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x
diff --git a/tests/Properties/View.hs b/tests/Properties/View.hs
new file mode 100644
index 0000000..ef9b58d
--- /dev/null
+++ b/tests/Properties/View.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.View where
+
+import Test.QuickCheck
+import Instances
+import Utils
+
+import XMonad.StackSet hiding (filter)
+
+import Data.List (sortBy)
+
+-- ---------------------------------------------------------------------
+-- viewing workspaces
+
+-- view sets the current workspace to 'n'
+prop_view_current (x :: T) = do
+ n <- arbitraryTag x
+ return $ (tag . workspace . current . view n) x == n
+
+-- view *only* sets the current workspace, and touches Xinerama.
+-- no workspace contents will be changed.
+prop_view_local (x :: T) = do
+ n <- arbitraryTag x
+ return $ workspaces x == workspaces (view n x)
+ where
+ workspaces a = sortBy (\s t -> tag s `compare` tag t) $
+ workspace (current a)
+ : map workspace (visible a) ++ hidden a
+
+-- TODO: Fix this
+-- view should result in a visible xinerama screen
+-- prop_view_xinerama (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
+-- M.member i (screens (view i x))
+-- where
+-- i = fromIntegral n
+
+-- view is idempotent
+prop_view_idem (x :: T) = do
+ n <- arbitraryTag x
+ return $ view n (view n x) == (view n x)
+
+-- view is reversible, though shuffles the order of hidden/visible
+prop_view_reversible (x :: T) = do
+ n <- arbitraryTag x
+ return $ normal (view n' (view n x)) == normal x
+ where
+ n' = currentTag x
diff --git a/tests/Properties/Workspace.hs b/tests/Properties/Workspace.hs
new file mode 100644
index 0000000..612cba9
--- /dev/null
+++ b/tests/Properties/Workspace.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Properties.Workspace where
+
+import Test.QuickCheck
+import Instances
+import Utils
+
+import XMonad.StackSet hiding (filter)
+
+import Data.Maybe
+
+-- looking up the tag of the current workspace should always produce a tag.
+prop_lookup_current (x :: T) = lookupWorkspace scr x == Just tg
+ where
+ (Screen (Workspace tg _ _) scr _) = current x
+
+-- looking at a visible tag
+prop_lookup_visible = do
+ -- make sure we have some xinerama screens.
+ x <- arbitrary `suchThat` \(x' :: T) -> visible x' /= []
+ let tags = [ tag (workspace y) | y <- visible x ]
+ scr = last [ screen y | y <- visible x ]
+ return $ fromJust (lookupWorkspace scr x) `elem` tags
+
+
+prop_currentTag (x :: T) =
+ currentTag x == tag (workspace (current x))
+
+-- Rename a given tag if present in the StackSet.
+prop_rename1 (x::T) = do
+ o <- arbitraryTag x
+ n <- arbitrary `suchThat` \n' -> not $ n' `tagMember` x
+ -- Rename o to n
+ let y = renameTag o n x
+ return $ n `tagMember` y
+
+-- Ensure that a given set of workspace tags is present by renaming
+-- existing workspaces and\/or creating new hidden workspaces as
+-- necessary.
+--
+prop_ensure (x :: T) l xs = let y = ensureTags l xs x
+ in and [ n `tagMember` y | n <- xs ]
+
+-- adding a tag should create a new hidden workspace
+prop_ensure_append (x :: T) l = do
+ n <- arbitrary `suchThat` \n' -> not $ n' `tagMember` x
+ let ts = tags x
+ y = ensureTags l (n:ts) x
+ return $ hidden y /= hidden x -- doesn't append, renames
+ && and [ isNothing (stack z) && layout z == l | z <- hidden y, tag z == n ]
+
+
+
+
+prop_mapWorkspaceId (x::T) = x == mapWorkspace id x
+
+prop_mapWorkspaceInverse (x::T) = x == mapWorkspace predTag (mapWorkspace succTag x)
+ where predTag w = w { tag = pred $ tag w }
+ succTag w = w { tag = succ $ tag w }
+
+prop_mapLayoutId (x::T) = x == mapLayout id x
+
+prop_mapLayoutInverse (x::T) = x == mapLayout pred (mapLayout succ x)
+
+