twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-07-31 20:21:51 -07:00
Code Issues Packages Projects Releases Wiki Activity

added new test-suite

Browse Source
This commit is contained in:
Yecine Megdiche
2020-12-07 20:11:24 +01:00
parent 69a2886a8b
commit 7ef0faa986
10 changed files with 377 additions and 187 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
tests/SwapWorkspaces.hs
View File

@@ -1,27 +1,27 @@
{-# LANGUAGE ScopedTypeVariables #-}
module SwapWorkspaces where
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
import Data.List(find,union)
import Data.Maybe(fromJust)
module SwapWorkspaces where
import Instances
import Test.QuickCheck
import XMonad.StackSet
import Properties(T, NonNegative) -- requires tests/Properties.hs from xmonad-core
import XMonad.Actions.SwapWorkspaces
-- Ensures that no "loss of information" can happen from a swap.
prop_double_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =
prop_double_swap (ss :: T) (NonNegative t1) (NonNegative t2) =
t1 `tagMember` ss && t2 `tagMember` ss ==>
ss == swap (swap ss)
where swap = swapWorkspaces t1 t2
-- Degrade nicely when given invalid data.
prop_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =
prop_invalid_swap (ss :: T) (NonNegative t1) (NonNegative t2) =
not (t1 `tagMember` ss || t2 `tagMember` ss) ==>
ss == swapWorkspaces t1 t2 ss
-- This doesn't pass yet. Probably should.
-- prop_half_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =
-- prop_half_invalid_swap (ss :: T) (NonNegative t1) (NonNegative t2) =
-- t1 `tagMember` ss && not (t2 `tagMember` ss) ==>
-- ss == swapWorkspaces t1 t2 ss
@@ -32,26 +32,14 @@ zipWorkspacesWith f s t = f (workspace $ current s) (workspace $ current t) :
zipWith f (hidden s) (hidden t)
-- Swap only modifies the workspaces tagged t1 and t2 -- leaves all others alone.
prop_swap_only_two (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =
prop_swap_only_two (ss :: T) (NonNegative t1) (NonNegative t2) =
t1 `tagMember` ss && t2 `tagMember` ss ==>
and $ zipWorkspacesWith mostlyEqual ss (swapWorkspaces t1 t2 ss)
where mostlyEqual w1 w2 = map tag [w1, w2] `elem` [[t1, t2], [t2, t1]] || w1 == w2
-- swapWithCurrent stays on current
prop_swap_with_current (ss :: T) (t :: NonNegative Int) =
prop_swap_with_current (ss :: T) (NonNegative t) =
t `tagMember` ss ==>
layout before == layout after && stack before == stack after
where before = workspace $ current ss
after = workspace $ current $ swapWithCurrent t ss
main = do
putStrLn "Testing double swap"
quickCheck prop_double_swap
putStrLn "Testing invalid swap"
quickCheck prop_invalid_swap
-- putStrLn "Testing half-invalid swap"
-- quickCheck prop_half_invalid_swap
putStrLn "Testing swap only two"
quickCheck prop_swap_only_two
putStrLn "Testing swap with current"
quickCheck prop_swap_with_current