and the tests still run

This commit is contained in:
Don Stewart
2007-04-11 08:15:00 +00:00
parent a37193f2a6
commit 4b626ff729
2 changed files with 11 additions and 19 deletions

View File

@@ -1,3 +1,4 @@
{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module : StackSet
@@ -14,9 +15,10 @@
-- set is always current. Elements may appear only once in the entire
-- stack set.
--
-- A StackSet provides a nice data structure for multiscreen
-- window managers, where each screen has a stack of windows, and a window
-- may be on only 1 screen at any given time.
-- A StackSet provides a nice data structure for window managers with
-- multiple physical screens, and multiple workspaces, where each screen
-- has a stack of windows, and a window may be on only 1 screen at any
-- given time.
--
module StackSet where
@@ -27,11 +29,6 @@ import qualified Data.Map as M
------------------------------------------------------------------------
--
-- N.B we probably want to think about strict 'adjust' and inserts on
-- these data structures in the long run.
--
-- | The StackSet data structure. A table of stacks, with a current pointer
data StackSet a =
StackSet
@@ -226,12 +223,6 @@ promote w = w { stacks = M.adjust next (current w) (stacks w) }
where next [] = []
next xs = last xs : init xs
--
-- case M.lookup k (cache w) of
-- Nothing -> w
-- Just i -> w { stacks = M.adjust (\ks -> k : filter (/= k) ks) i (stacks w) }
--
-- |
elemAfter :: Eq a => a -> [a] -> Maybe a
elemAfter w ws = listToMaybe . filter (/= w) . dropWhile (/= w) $ ws ++ ws

View File

@@ -1,3 +1,4 @@
{-# OPTIONS -fglasgow-exts #-}
import StackSet
@@ -16,7 +17,7 @@ import Data.Map (keys,elems)
-- QuickCheck properties for the StackSet
-- | Height of stack 'n'
height :: Int -> StackSet a -> Int
height :: WorkspaceId -> StackSet a -> Int
height i w = length (index i w)
-- build (non-empty) StackSets with between 1 and 100 stacks
@@ -26,7 +27,7 @@ instance (Ord a, Arbitrary a) => Arbitrary (StackSet a) where
n <- choose (0,sz-1)
sc <- choose (1,sz)
ls <- vector sz
return $ fromList (n,sc,ls)
return $ fromList (fromIntegral n,sc,ls)
coarbitrary = error "no coarbitrary for StackSet"
prop_id x = fromList (toList x) == x
@@ -73,7 +74,7 @@ prop_viewview r x =
let n = current x
sz = size x
i = r `mod` sz
in view n (view i x) == x
in view n (view (fromIntegral i) x) == x
where _ = x :: T
@@ -96,8 +97,8 @@ prop_ws2screen_screen2ws x = (ws == ws') && (sc == sc')
sc = sort . keys $ screen2ws x
sc' = sort . elems $ ws2screen x
_ = x :: T
prop_screenworkspace x = all test [0..((size x)-1)]
prop_screenworkspace x = all test [0..((fromIntegral $ size x)-1)]
where test ws = case screen ws x of
Nothing -> True
Just sc -> workspace sc x == Just ws