summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJason Creighton <jcreigh@gmail.com>2007-04-11 06:42:15 +0200
committerJason Creighton <jcreigh@gmail.com>2007-04-11 06:42:15 +0200
commit14d62be4ec0bbdbc8d44dd5f606b5b7018f9149f (patch)
tree13fa85ae236834e80dbd8beb428c33312f38a731
parent9b4025ea874d7f5140f0e836ad21277e42996f89 (diff)
downloadmetatile-14d62be4ec0bbdbc8d44dd5f606b5b7018f9149f.tar
metatile-14d62be4ec0bbdbc8d44dd5f606b5b7018f9149f.zip
fromList/toList have # of screens + another QC property
darcs-hash:20070411044215-b9aa7-e66ef93fac9102201bfd145ebb26c38bbecd25de
-rw-r--r--StackSet.hs19
-rw-r--r--tests/Properties.hs10
2 files changed, 19 insertions, 10 deletions
diff --git a/StackSet.hs b/StackSet.hs
index cf1f343..6bc2e99 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -80,20 +80,21 @@ size = M.size . stacks
-- | fromList. Build a new StackSet from a list of list of elements
-- If there are duplicates in the list, the last occurence wins.
--- FIXME: This always makes a StackSet with 1 screen.
-fromList :: Ord a => (Int,[[a]]) -> StackSet a
-fromList (_,[]) = error "Cannot build a StackSet from an empty list"
+fromList :: Ord a => (Int,Int,[[a]]) -> StackSet a
+fromList (_,_,[]) = error "Cannot build a StackSet from an empty list"
-fromList (n,xs) | n < 0 || n >= length xs
+fromList (n,m,xs) | n < 0 || n >= length xs
= error $ "Cursor index is out of range: " ++ show (n, length xs)
+ | m < 1 || m > length xs
+ = error $ "Can't have more screens than workspaces: " ++ show (m, length xs)
-fromList (o,xs) = view o $ foldr (\(i,ys) s ->
- foldr (\a t -> insert a i t) s ys)
- (empty (length xs) 1) (zip [0..] xs)
+fromList (o,m,xs) = view o $ foldr (\(i,ys) s ->
+ foldr (\a t -> insert a i t) s ys)
+ (empty (length xs) m) (zip [0..] xs)
-- | toList. Flatten a stackset to a list of lists
-toList :: StackSet a -> (Int,[[a]])
-toList x = (current x, map snd $ M.toList (stacks x))
+toList :: StackSet a -> (Int,Int,[[a]])
+toList x = (current x, M.size $ screen2ws x, map snd $ M.toList (stacks x))
-- | Push. Insert an element onto the top of the current stack.
-- If the element is already in the current stack, it is moved to the top.
diff --git a/tests/Properties.hs b/tests/Properties.hs
index 41f729d..4a4a4b2 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -24,8 +24,9 @@ instance (Ord a, Arbitrary a) => Arbitrary (StackSet a) where
arbitrary = do
sz <- choose (1,20)
n <- choose (0,sz-1)
+ sc <- choose (1,sz)
ls <- vector sz
- return $ fromList (n,ls)
+ return $ fromList (n,sc,ls)
coarbitrary = error "no coarbitrary for StackSet"
prop_id x = fromList (toList x) == x
@@ -96,6 +97,12 @@ prop_ws2screen_screen2ws x = (ws == ws') && (sc == sc')
sc' = sort . elems $ ws2screen x
_ = x :: T
+prop_screenworkspace x = all test [0..((size x)-1)]
+ where test ws = case screen ws x of
+ Nothing -> True
+ Just sc -> workspace sc x == Just ws
+ _ = x :: T
+
------------------------------------------------------------------------
main :: IO ()
@@ -122,6 +129,7 @@ main = do
,("fullcache ", mytest prop_fullcache)
,("currentwsvisible ", mytest prop_currentwsvisible)
,("ws screen mapping", mytest prop_ws2screen_screen2ws)
+ ,("screen/workspace ", mytest prop_screenworkspace)
]
debug = False