diff options
author | Adam Vogt <vogt.adam@gmail.com> | 2014-05-02 20:01:46 +0200 |
---|---|---|
committer | Adam Vogt <vogt.adam@gmail.com> | 2014-05-02 20:01:46 +0200 |
commit | 9660a7a64c749e181d2114cc4b66a8aa4f88be0f (patch) | |
tree | 1664b0ed1ee20f66cf3b7f550c33d49c897bed8c /tests/Instances.hs | |
parent | b682eaf8fcbb548dacb35b4103e546cbd9fca3ed (diff) | |
download | xmonad-9660a7a64c749e181d2114cc4b66a8aa4f88be0f.tar.gz xmonad-9660a7a64c749e181d2114cc4b66a8aa4f88be0f.tar.xz xmonad-9660a7a64c749e181d2114cc4b66a8aa4f88be0f.zip |
update testsuite (mostly due Jesper Reenberg)
Ignore-this: a5e926aa4e397e70d56e3c9db7108d5b
* use quickcheck2
* run them using cabal's test-suite field
* split up Properties into separate files
darcs-hash:20140502180146-1499c-dc8c09c3ec76a42a0e146925adce960435dc81db.gz
Diffstat (limited to '')
-rw-r--r-- | tests/Instances.hs | 135 |
1 files changed, 135 insertions, 0 deletions
diff --git a/tests/Instances.hs b/tests/Instances.hs new file mode 100644 index 0000000..2f087f8 --- /dev/null +++ b/tests/Instances.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Instances where + +import Test.QuickCheck + +import Utils + +import XMonad.StackSet +import Control.Monad +import Data.List (nub, genericLength) + +import Debug.Trace + +-- +-- 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)) + + + +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 |