summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDon Stewart <dons@cse.unsw.edu.au>2007-03-09 05:17:07 +0100
committerDon Stewart <dons@cse.unsw.edu.au>2007-03-09 05:17:07 +0100
commit74b33d1fc8aed507305f6de929303749888bde75 (patch)
tree19858fbf18a84e271bcf7f90e817ecc1d9480ff2
parent6f6785519398a926620a964e8a5125f527adcaaa (diff)
downloadmetatile-74b33d1fc8aed507305f6de929303749888bde75.tar
metatile-74b33d1fc8aed507305f6de929303749888bde75.zip
simplify StackSet api even further (-15 loc)
darcs-hash:20070309041707-9c5c1-3c9ef62c25f49b9025f137f73c8d25438a640ff4
-rw-r--r--Main.hs10
-rw-r--r--StackSet.hs77
-rw-r--r--tests/Properties.hs4
3 files changed, 28 insertions, 63 deletions
diff --git a/Main.hs b/Main.hs
index 1f51e9c..4a7a914 100644
--- a/Main.hs
+++ b/Main.hs
@@ -210,11 +210,9 @@ view :: Int -> W ()
view o = do
ws <- gets workspace
let m = W.current ws
- when (n /= m) $
- whenJust (W.index n ws) $ \new ->
- whenJust (W.index m ws) $ \old -> do
- mapM_ hide old
- mapM_ reveal new
- windows $ W.view n
+ when (n /= m) $ do
+ mapM_ hide (W.index m ws)
+ mapM_ reveal (W.index n ws)
+ windows $ W.view n
where n = o-1
diff --git a/StackSet.hs b/StackSet.hs
index c79ea13..00d0257 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -14,8 +14,8 @@
-- set is always current. Elements may appear only once in the entire
-- stack set.
--
--- A StackSet provides a nice datastructure for multiscreen
--- windowmanagers, where each screen has a stack of windows, and a window
+-- 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.
--
@@ -31,7 +31,7 @@ module StackSet (
-- * Inspection
size, -- :: StackSet a -> Int
peek, -- :: StackSet a -> Maybe a
- index, -- :: Int -> StackSet a -> Maybe [a]
+ index, -- :: Int -> StackSet a -> [a]
member, -- :: Ord a => a -> StackSet a -> Bool
current, -- :: StackSet a -> Int
@@ -120,13 +120,18 @@ push k w = insert k (current w) w
-- | Extract the element on the top of the current stack. If no such
-- element exists, Nothing is returned.
peek :: StackSet a -> Maybe a
-peek w = listToMaybe . fromJust $ index (current w) w
+peek w = listToMaybe $ index (current w) w
--- | Index. Extract stack at index 'n'. If the index is invalid,
--- Nothing is returned.
-index :: Int -> StackSet a -> Maybe [a]
-index n w | n < 0 || n >= size w = Nothing
- | otherwise = Just (stacks w `S.index` n)
+-- | Index. Extract the stack at index 'n'.
+-- If the index is invalid, an exception is thrown.
+index :: Int -> StackSet a -> [a]
+index n w = stacks w `S.index` n
+
+-- | view. Set the stack specified by the Int argument as being the
+-- current StackSet. If the index is out of range an exception is thrown.
+view :: Int -> StackSet a -> StackSet a
+view n w | n >= 0 && n < size w = w { current = n }
+ | otherwise = error $ "view: index out of bounds: " ++ show n
-- | rotate. cycle the current window list up or down.
--
@@ -137,7 +142,7 @@ index n w | n < 0 || n >= size w = Nothing
-- where xs = [5..8] ++ [1..4]
--
rotate :: Ordering -> StackSet a -> StackSet a
-rotate o = unsafeModify rot -- safe, since 'rot' is guaranteed to only permute the list
+rotate o w = w { stacks = S.adjust rot (current w) (stacks w) }
where
rot s = take l . drop offset . cycle $ s
where
@@ -145,62 +150,26 @@ rotate o = unsafeModify rot -- safe, since 'rot' is guaranteed to only permute t
l = length s
offset = if n < 0 then l + n else n
--- ---------------------------------------------------------------------
-
--- | view. Set the stack specified by the Int argument as being the
--- current StackSet. If the index is out of range, the original
--- StackSet is returned. StackSet are indexed from 0.
-view :: Int -> StackSet a -> StackSet a
-view n w | n >= 0 && n < size w = w { current = n }
- | otherwise = w
-
-- | shift. move the client on top of the current stack to the top of stack 'n'.
--- The new StackSet is returned.
---
--- If the stack to move to is not valid, the original StackSet is returned.
--- If there are no elements in the current stack, nothing changes.
+-- If the stack to move to is not valid, and exception is thrown.
--
shift :: Ord a => Int -> StackSet a -> StackSet a
-shift n w | n < 0 || n >= size w = w
- | otherwise = case peek w of
- Nothing -> w -- nothing to do
- Just k -> insert k n (pop w)
-
-------------------------------------------------------------------------
+shift n w = maybe w (\k -> insert k n (delete k w)) (peek w)
-- | Insert an element onto the top of stack 'n'.
--- If the index is wrong, the original StackSet is returned unchanged.
-- If the element is already in the stack 'n', it is moved to the top.
-- If the element exists on another stack, it is removed from that stack.
+-- If the index is wrong an exception is thrown.
--
insert :: Ord a => a -> Int -> StackSet a -> StackSet a
-insert k n old
- | n < 0 || n >= size old = old
- | otherwise = new { cache = M.insert k n (cache new)
- , stacks = S.adjust (L.nub . (k:)) n (stacks new) }
+insert k n old = new { cache = M.insert k n (cache new)
+ , stacks = S.adjust (L.nub . (k:)) n (stacks new) }
where new = delete k old
-- | Delete an element entirely from from the StackSet.
-- This can be used to ensure that a given element is not managed elsewhere.
-- If the element doesn't exist, the original StackSet is returned unmodified.
delete :: Ord a => a -> StackSet a -> StackSet a
-delete k w = case M.lookup k (cache w) of
- Nothing -> w -- we don't know about this window
- Just i -> w { cache = M.delete k (cache w)
- , stacks = S.adjust (L.delete k) i (stacks w) }
-
--- ---------------------------------------------------------------------
--- Internal functions
-
--- | modify the current stack with a pure function. This function is
--- unsafe: the argument function must only permute the current stack,
--- and must not add or remove elements, or duplicate elements.
---
-unsafeModify :: ([a] -> [a]) -> StackSet a -> StackSet a
-unsafeModify f w = w { stacks = S.adjust f (current w) (stacks w) }
-
--- | Pop. Pop the element off the top of the stack and discard it.
--- A new StackSet is returned. If the current stack is empty, the
--- original StackSet is returned unchanged.
-pop :: Ord a => StackSet a -> StackSet a
-pop w = maybe w (flip delete w) (peek w)
+delete k w = maybe w tweak (M.lookup k (cache w))
+ where tweak i = w { cache = M.delete k (cache w)
+ , stacks = S.adjust (L.delete k) i (stacks w) }
diff --git a/tests/Properties.hs b/tests/Properties.hs
index c36562b..5185314 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -15,9 +15,7 @@ import Data.List (sort,group,sort,intersperse)
-- | Height of stack 'n'
height :: Int -> StackSet a -> Int
-height i w = case index i w of
- Nothing -> error $ "height: i out of range: " ++ show i
- Just ss -> length ss
+height i w = length (index i w)
-- build (non-empty) StackSets with between 1 and 100 stacks
instance (Ord a, Arbitrary a) => Arbitrary (StackSet a) where