diff --git a/tests/Instances.hs b/tests/Instances.hs index e52c5ec..77d8fb5 100644 --- a/tests/Instances.hs +++ b/tests/Instances.hs @@ -36,7 +36,7 @@ instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary l, Arbitrary sd) -- 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) + else Just <$> choose (0, length windows - 1) | windows <- wsWindows ] let tags = [1 .. fromIntegral numWs] @@ -80,7 +80,7 @@ newtype NonEmptyWindowsStackSet = NonEmptyWindowsStackSet T instance Arbitrary NonEmptyWindowsStackSet where arbitrary = - NonEmptyWindowsStackSet `fmap` (arbitrary `suchThat` (not . null . allWindows)) + NonEmptyWindowsStackSet <$> (arbitrary `suchThat` (not . null . allWindows)) instance Arbitrary Rectangle where arbitrary = Rectangle <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary @@ -99,7 +99,7 @@ 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)) + arbitrary = NonEmptyNubList <$> ((nub <$> arbitrary) `suchThat` (not . null)) @@ -116,7 +116,7 @@ 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) + idx <- choose (0, length ts - 1) return $ ts!!idx -- | Pull out an arbitrary window from a StackSet that is guaranteed to have a @@ -136,5 +136,5 @@ 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) + idx <- choose (0, length ws - 1) return $ ws!!idx diff --git a/tests/Properties/Delete.hs b/tests/Properties/Delete.hs index a8b8dd1..fed3409 100644 --- a/tests/Properties/Delete.hs +++ b/tests/Properties/Delete.hs @@ -64,7 +64,7 @@ prop_delete_focus_not_end = do -- last one in the stack. `suchThat` \(x' :: T) -> let currWins = index x' - in length (currWins) >= 2 && peek x' /= Just (last currWins) + 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/Focus.hs b/tests/Properties/Focus.hs index 6bc0055..a3ea84e 100644 --- a/tests/Properties/Focus.hs +++ b/tests/Properties/Focus.hs @@ -32,8 +32,8 @@ prop_focusWindow_master (NonNegative n) (x :: T) = 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 +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) @@ -47,9 +47,9 @@ prop_focusWindow_works (NonNegative (n :: Int)) (x :: T) = 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 +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 +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 diff --git a/tests/Properties/GreedyView.hs b/tests/Properties/GreedyView.hs index 3f2eb9b..09dd1b8 100644 --- a/tests/Properties/GreedyView.hs +++ b/tests/Properties/GreedyView.hs @@ -35,7 +35,7 @@ prop_greedyView_local (x :: T) = do -- greedyView is idempotent prop_greedyView_idem (x :: T) = do n <- arbitraryTag x - return $ greedyView n (greedyView n x) == (greedyView n 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 diff --git a/tests/Properties/Insert.hs b/tests/Properties/Insert.hs index c277795..6730269 100644 --- a/tests/Properties/Insert.hs +++ b/tests/Properties/Insert.hs @@ -46,7 +46,7 @@ prop_insert_delete x = do -- inserting n elements increases current stack size by n prop_size_insert is (EmptyStackSet x) = - size (foldr insertUp x ws ) == (length ws) + 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 index eca6ec3..3bb8d60 100644 --- a/tests/Properties/Layout/Full.hs +++ b/tests/Properties/Layout/Full.hs @@ -29,6 +29,6 @@ prop_purelayout_full rect = do -- what happens when we send an IncMaster message to Full --- Nothing prop_sendmsg_full (NonNegative k) = - isNothing (Full `pureMessage` (SomeMessage (IncMasterN 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 index 5353e62..45cfe72 100644 --- a/tests/Properties/Layout/Tall.hs +++ b/tests/Properties/Layout/Tall.hs @@ -29,12 +29,12 @@ prop_tile_non_overlap rect windows nmaster = noOverlaps (tile pct rect nmaster w -- splitting horizontally yields sensible results prop_split_horizontal (NonNegative n) x = - (noOverflows (+) (rect_x x) (rect_width x)) ==> + noOverflows (+) (rect_x x) (rect_width x) ==> sum (map rect_width xs) == rect_width x && - all (== rect_height x) (map rect_height xs) + all (\s -> rect_height s == rect_height x) xs && - (map rect_x xs) == (sort $ map rect_x xs) + map rect_x xs == sort (map rect_x xs) where xs = splitHorizontally n x @@ -72,7 +72,7 @@ prop_shrink_tall (NonNegative n) (Positive delta) (NonNegative frac) = -- remaining fraction should shrink where l1 = Tall n delta frac - Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage Shrink) + Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage Shrink -- pureMessage :: layout a -> SomeMessage -> Maybe (layout a) @@ -93,7 +93,7 @@ prop_expand_tall (NonNegative n) where frac = min 1 (n1 % d1) l1 = Tall n delta frac - Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage Expand) + 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 @@ -102,7 +102,7 @@ prop_incmaster_tall (NonNegative n) (Positive delta) (NonNegative frac) delta == delta' && frac == frac' && n' == n + k where l1 = Tall n delta frac - Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage (IncMasterN k)) + Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage (IncMasterN k) -- pureMessage :: layout a -> SomeMessage -> Maybe (layout a) diff --git a/tests/Properties/Screen.hs b/tests/Properties/Screen.hs index b679fb9..b3d3468 100644 --- a/tests/Properties/Screen.hs +++ b/tests/Properties/Screen.hs @@ -53,8 +53,8 @@ prop_aspect_hint_shrink hint (w,h) = case applyAspectHint hint (w,h) of -- the desired range prop_aspect_fits = forAll ((,,,) <$> pos <*> pos <*> pos <*> pos) $ \ (x,y,a,b) -> - let f v = applyAspectHint ((x, y+a), (x+b, y)) v - in and [ noOverflows (*) x (y+a), noOverflows (*) (x+b) y ] + let f = applyAspectHint ((x, y+a), (x+b, y)) + in noOverflows (*) x (y+a) && noOverflows (*) (x+b) y ==> f (x,y) == (x,y) where pos = choose (0, 65535) diff --git a/tests/Properties/Shift.hs b/tests/Properties/Shift.hs index 2150cbf..144b19f 100644 --- a/tests/Properties/Shift.hs +++ b/tests/Properties/Shift.hs @@ -27,7 +27,7 @@ prop_shift_reversible (x :: T) = do -- shiftMaster -- focus/local/idempotent same as swapMaster: -prop_shift_master_focus (x :: T) = peek x == (peek $ shiftMaster x) +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: @@ -57,14 +57,14 @@ 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 + in length (tags x') >= 2 && not (null otherWindows) -- 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) + idx <- choose (0, length otherWindows - 1) let w = otherWindows !! idx - return $ (current $ x) == (current $ shiftWin n w x) + return $ current x == current (shiftWin n w x) diff --git a/tests/Properties/Stack.hs b/tests/Properties/Stack.hs index 344c4c3..f85ca3e 100644 --- a/tests/Properties/Stack.hs +++ b/tests/Properties/Stack.hs @@ -1,6 +1,10 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} + +#ifdef VERSION_quickcheck_classes +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +#endif + module Properties.Stack where import Test.QuickCheck @@ -24,7 +28,7 @@ import Test.QuickCheck.Classes ( -- windows kept in the zipper prop_index_length (x :: T) = case stack . workspace . current $ x of - Nothing -> length (index x) == 0 + Nothing -> null (index x) Just it -> length (index x) == length (focus it : up it ++ down it) @@ -43,7 +47,7 @@ prop_allWindowsMember (NonEmptyWindowsStackSet x) = do -- 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) + idx <- choose (0, length ws - 1) return $ member (ws!!idx) x @@ -56,8 +60,8 @@ prop_filter_order (x :: T) = -- 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)) + if null xs then isNothing (differentiate xs) + else differentiate xs == Just (Stack (head xs) [] (tail xs)) where _ = xs :: [Int] diff --git a/tests/Properties/StackSet.hs b/tests/Properties/StackSet.hs index 7fc5192..0b1e8f1 100644 --- a/tests/Properties/StackSet.hs +++ b/tests/Properties/StackSet.hs @@ -58,7 +58,7 @@ invariant (s :: T) = and -- inBounds = and [ w >=0 && w < size s | (w,sc) <- M.assocs (screens s) ] monotonic [] = True -monotonic (x:[]) = True +monotonic [x] = True monotonic (x:y:zs) | x == y-1 = monotonic (y:zs) | otherwise = False @@ -126,7 +126,7 @@ prop_empty (EmptyStackSet x) = 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 +prop_member_empty i (EmptyStackSet x) = not (member i x) -- peek either yields nothing on the Empty workspace, or Just a valid window prop_member_peek (x :: T) = diff --git a/tests/Properties/Swap.hs b/tests/Properties/Swap.hs index a516f2c..fb8e529 100644 --- a/tests/Properties/Swap.hs +++ b/tests/Properties/Swap.hs @@ -11,8 +11,8 @@ 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 +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... @@ -26,12 +26,12 @@ prop_promote_reversible x b = (not . null . fromMaybe [] . flip index x . curren -} -- swap doesn't change focus -prop_swap_master_focus (x :: T) = peek x == (peek $ swapMaster x) +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) +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) @@ -39,9 +39,9 @@ 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 +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 +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 index ef9b58d..fe56ba3 100644 --- a/tests/Properties/View.hs +++ b/tests/Properties/View.hs @@ -37,7 +37,7 @@ prop_view_local (x :: T) = do -- view is idempotent prop_view_idem (x :: T) = do n <- arbitraryTag x - return $ view n (view n x) == (view n 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 diff --git a/tests/Utils.hs b/tests/Utils.hs index e3eef0f..4ae4416 100644 --- a/tests/Utils.hs +++ b/tests/Utils.hs @@ -12,8 +12,8 @@ hidden_spaces x = map workspace (visible x) ++ hidden x -- normalise workspace list normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) } where - f = \a b -> tag (workspace a) `compare` tag (workspace b) - g = \a b -> tag a `compare` tag b + f a b = tag (workspace a) `compare` tag (workspace b) + g a b = tag a `compare` tag b noOverlaps [] = True