simplify StackSet api even further (-15 loc)

This commit is contained in:
Don Stewart
2007-03-09 04:17:07 +00:00
parent f10a61fad1
commit 7e2caa4707
3 changed files with 28 additions and 63 deletions

View File

@@ -210,11 +210,9 @@ view :: Int -> W ()
view o = do view o = do
ws <- gets workspace ws <- gets workspace
let m = W.current ws let m = W.current ws
when (n /= m) $ when (n /= m) $ do
whenJust (W.index n ws) $ \new -> mapM_ hide (W.index m ws)
whenJust (W.index m ws) $ \old -> do mapM_ reveal (W.index n ws)
mapM_ hide old
mapM_ reveal new
windows $ W.view n windows $ W.view n
where n = o-1 where n = o-1

View File

@@ -31,7 +31,7 @@ module StackSet (
-- * Inspection -- * Inspection
size, -- :: StackSet a -> Int size, -- :: StackSet a -> Int
peek, -- :: StackSet a -> Maybe a peek, -- :: StackSet a -> Maybe a
index, -- :: Int -> StackSet a -> Maybe [a] index, -- :: Int -> StackSet a -> [a]
member, -- :: Ord a => a -> StackSet a -> Bool member, -- :: Ord a => a -> StackSet a -> Bool
current, -- :: StackSet a -> Int 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 -- | Extract the element on the top of the current stack. If no such
-- element exists, Nothing is returned. -- element exists, Nothing is returned.
peek :: StackSet a -> Maybe a 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, -- | Index. Extract the stack at index 'n'.
-- Nothing is returned. -- If the index is invalid, an exception is thrown.
index :: Int -> StackSet a -> Maybe [a] index :: Int -> StackSet a -> [a]
index n w | n < 0 || n >= size w = Nothing index n w = stacks w `S.index` n
| otherwise = Just (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. -- | 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] -- where xs = [5..8] ++ [1..4]
-- --
rotate :: Ordering -> StackSet a -> StackSet a 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 where
rot s = take l . drop offset . cycle $ s rot s = take l . drop offset . cycle $ s
where where
@@ -145,38 +150,19 @@ rotate o = unsafeModify rot -- safe, since 'rot' is guaranteed to only permute t
l = length s l = length s
offset = if n < 0 then l + n else n 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'. -- | 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, and exception is thrown.
--
-- 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.
-- --
shift :: Ord a => Int -> StackSet a -> StackSet a shift :: Ord a => Int -> StackSet a -> StackSet a
shift n w | n < 0 || n >= size w = w shift n w = maybe w (\k -> insert k n (delete k w)) (peek w)
| otherwise = case peek w of
Nothing -> w -- nothing to do
Just k -> insert k n (pop w)
------------------------------------------------------------------------
-- | Insert an element onto the top of stack 'n'. -- | 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 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 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 :: Ord a => a -> Int -> StackSet a -> StackSet a
insert k n old insert k n old = new { cache = M.insert k n (cache new)
| n < 0 || n >= size old = old
| otherwise = new { cache = M.insert k n (cache new)
, stacks = S.adjust (L.nub . (k:)) n (stacks new) } , stacks = S.adjust (L.nub . (k:)) n (stacks new) }
where new = delete k old where new = delete k old
@@ -184,23 +170,6 @@ insert k n old
-- This can be used to ensure that a given element is not managed elsewhere. -- 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. -- If the element doesn't exist, the original StackSet is returned unmodified.
delete :: Ord a => a -> StackSet a -> StackSet a delete :: Ord a => a -> StackSet a -> StackSet a
delete k w = case M.lookup k (cache w) of delete k w = maybe w tweak (M.lookup k (cache w))
Nothing -> w -- we don't know about this window where tweak i = w { cache = M.delete k (cache w)
Just i -> w { cache = M.delete k (cache w)
, stacks = S.adjust (L.delete k) i (stacks 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)

View File

@@ -15,9 +15,7 @@ import Data.List (sort,group,sort,intersperse)
-- | Height of stack 'n' -- | Height of stack 'n'
height :: Int -> StackSet a -> Int height :: Int -> StackSet a -> Int
height i w = case index i w of height i w = length (index i w)
Nothing -> error $ "height: i out of range: " ++ show i
Just ss -> length ss
-- build (non-empty) StackSets with between 1 and 100 stacks -- build (non-empty) StackSets with between 1 and 100 stacks
instance (Ord a, Arbitrary a) => Arbitrary (StackSet a) where instance (Ord a, Arbitrary a) => Arbitrary (StackSet a) where