mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-03 05:31:54 -07:00
and the tests still run
This commit is contained in:
19
StackSet.hs
19
StackSet.hs
@@ -1,3 +1,4 @@
|
|||||||
|
{-# OPTIONS -fglasgow-exts #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : StackSet
|
-- Module : StackSet
|
||||||
@@ -14,9 +15,10 @@
|
|||||||
-- set is always current. Elements may appear only once in the entire
|
-- set is always current. Elements may appear only once in the entire
|
||||||
-- stack set.
|
-- stack set.
|
||||||
--
|
--
|
||||||
-- A StackSet provides a nice data structure for multiscreen
|
-- A StackSet provides a nice data structure for window managers with
|
||||||
-- window managers, where each screen has a stack of windows, and a window
|
-- multiple physical screens, and multiple workspaces, where each screen
|
||||||
-- may be on only 1 screen at any given time.
|
-- has a stack of windows, and a window may be on only 1 screen at any
|
||||||
|
-- given time.
|
||||||
--
|
--
|
||||||
|
|
||||||
module StackSet where
|
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
|
-- | The StackSet data structure. A table of stacks, with a current pointer
|
||||||
data StackSet a =
|
data StackSet a =
|
||||||
StackSet
|
StackSet
|
||||||
@@ -226,12 +223,6 @@ promote w = w { stacks = M.adjust next (current w) (stacks w) }
|
|||||||
where next [] = []
|
where next [] = []
|
||||||
next xs = last xs : init xs
|
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 :: Eq a => a -> [a] -> Maybe a
|
||||||
elemAfter w ws = listToMaybe . filter (/= w) . dropWhile (/= w) $ ws ++ ws
|
elemAfter w ws = listToMaybe . filter (/= w) . dropWhile (/= w) $ ws ++ ws
|
||||||
|
@@ -1,3 +1,4 @@
|
|||||||
|
{-# OPTIONS -fglasgow-exts #-}
|
||||||
|
|
||||||
import StackSet
|
import StackSet
|
||||||
|
|
||||||
@@ -16,7 +17,7 @@ import Data.Map (keys,elems)
|
|||||||
-- QuickCheck properties for the StackSet
|
-- QuickCheck properties for the StackSet
|
||||||
|
|
||||||
-- | Height of stack 'n'
|
-- | Height of stack 'n'
|
||||||
height :: Int -> StackSet a -> Int
|
height :: WorkspaceId -> StackSet a -> Int
|
||||||
height i w = length (index i w)
|
height i w = length (index i w)
|
||||||
|
|
||||||
-- build (non-empty) StackSets with between 1 and 100 stacks
|
-- 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)
|
n <- choose (0,sz-1)
|
||||||
sc <- choose (1,sz)
|
sc <- choose (1,sz)
|
||||||
ls <- vector sz
|
ls <- vector sz
|
||||||
return $ fromList (n,sc,ls)
|
return $ fromList (fromIntegral n,sc,ls)
|
||||||
coarbitrary = error "no coarbitrary for StackSet"
|
coarbitrary = error "no coarbitrary for StackSet"
|
||||||
|
|
||||||
prop_id x = fromList (toList x) == x
|
prop_id x = fromList (toList x) == x
|
||||||
@@ -73,7 +74,7 @@ prop_viewview r x =
|
|||||||
let n = current x
|
let n = current x
|
||||||
sz = size x
|
sz = size x
|
||||||
i = r `mod` sz
|
i = r `mod` sz
|
||||||
in view n (view i x) == x
|
in view n (view (fromIntegral i) x) == x
|
||||||
|
|
||||||
where _ = x :: T
|
where _ = x :: T
|
||||||
|
|
||||||
@@ -97,7 +98,7 @@ prop_ws2screen_screen2ws x = (ws == ws') && (sc == sc')
|
|||||||
sc' = sort . elems $ ws2screen x
|
sc' = sort . elems $ ws2screen x
|
||||||
_ = x :: T
|
_ = 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
|
where test ws = case screen ws x of
|
||||||
Nothing -> True
|
Nothing -> True
|
||||||
Just sc -> workspace sc x == Just ws
|
Just sc -> workspace sc x == Just ws
|
||||||
|
Reference in New Issue
Block a user