1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
-----------------------------------------------------------------------------
-- |
-- Module : StackSet
-- Copyright : (c) Don Stewart 2007
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : dons@cse.unsw.edu.au
-- Stability : stable
-- Portability : portable, needs GHC 6.6
--
-----------------------------------------------------------------------------
--
-- The 'StackSet' data type encodes a set of stacks. A given stack in the
-- 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
-- may be on only 1 screen at any given time.
--
module StackSet (
StackSet, -- abstract, deriving Show,Eq
-- * Introduction
empty, -- :: Int -> StackSet a
fromList, -- :: Ord a => (Int,[[a]]) -> StackSet a
toList, -- :: StackSet a -> (Int,[[a]])
-- * Inspection
size, -- :: StackSet a -> Int
peek, -- :: StackSet a -> Maybe a
index, -- :: Int -> StackSet a -> Maybe [a]
member, -- :: Ord a => a -> StackSet a -> Bool
current, -- :: StackSet a -> Int
-- * Modification
push, -- :: Ord a => a -> StackSet a -> StackSet a
rotate, -- :: Ordering -> StackSet a -> StackSet a
shift, -- :: Ord a => Int -> StackSet a -> StackSet a
delete, -- :: Ord a => a -> StackSet a -> StackSet a
view, -- :: Int -> StackSet a -> StackSet a
) where
import Data.Maybe
import qualified Data.Foldable as F
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Sequence as S
------------------------------------------------------------------------
-- | The StackSet data structure. A table of stacks, with a current pointer
data StackSet a =
StackSet
{ current:: {-# UNPACK #-} !Int -- ^ the currently visible stack
, size :: {-# UNPACK #-} !Int -- ^ size of the stack list
, stacks :: {-# UNPACK #-} !(S.Seq [a]) -- ^ the separate stacks
, cache :: {-# UNPACK #-} !(M.Map a Int) -- ^ a cache of windows back to their stacks
} deriving Eq
instance Show a => Show (StackSet a) where
showsPrec p s r = showsPrec p (show . toList $ s) r
-- Ord a constraint on 'a' as we use it as a key.
--
-- The cache is used to check on insertion that we don't already have
-- this window managed on another stack
--
-- Currently stacks are of a fixed size. There's no firm reason to
-- do this (new empty stacks could be created on the fly).
------------------------------------------------------------------------
-- | Create a new empty stacks of size 'n', indexed from 0. The
-- 0-indexed stack will be current.
empty :: Int -> StackSet a
empty n = StackSet { current= 0
, size = n -- constant
, stacks = S.fromList (replicate n [])
, cache = M.empty
}
-- | True if x is somewhere in the StackSet
member :: Ord a => a -> StackSet a -> Bool
member a w = M.member a (cache w)
------------------------------------------------------------------------
-- | fromList. Build a new StackSet from a list of list of elements
-- If there are duplicates in the list, the last occurence wins.
fromList :: Ord a => (Int,[[a]]) -> StackSet a
fromList (_,[])
= error "Cannot build a StackSet from an empty list"
fromList (n,xs)
| n < 0 || n >= length xs
= error $ "Cursor index is out of range: " ++ show (n, length xs)
fromList (o,xs) = view o $
foldr (\(i,ys) s ->
foldr (\a t -> insert a i t) s ys)
(empty (length xs)) (zip [0..] xs)
-- | toList. Flatten a stackset to a list of lists
toList :: StackSet a -> (Int,[[a]])
toList x = (current x, F.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.
-- If the element is managed on another stack, it is removed from that
-- stack first.
push :: Ord a => a -> StackSet a -> StackSet a
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
-- | 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)
-- | rotate. cycle the current window list up or down.
--
-- rotate EQ --> [5,6,7,8,1,2,3,4]
-- rotate GT --> [6,7,8,1,2,3,4,5]
-- rotate LT --> [4,5,6,7,8,1,2,3]
--
-- 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
where
rot s = take l . drop offset . cycle $ s
where
n = fromEnum o - 1
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.
--
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)
------------------------------------------------------------------------
-- | 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.
--
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) }
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)
|