HEADS UP: Rewrite StackSet as a Zipper

In order to give a better account of how focus and master interact, and
how each operation affects focus, we reimplement the StackSet type as a
two level nested 'Zipper'. To quote Oleg:

    A Zipper is essentially an `updateable' and yet pure functional
    cursor into a data structure. Zipper is also a delimited
    continuation reified as a data structure.

That is, we use the Zipper as a cursor which encodes the window which is
in focus. Thus our data structure tracks focus correctly by
construction! We then get simple, obvious semantics for e.g. insert, in
terms of how it affects focus/master. Our transient-messes-with-focus
bug evaporates. 'swap' becomes trivial.

By moving focus directly into the stackset, we can toss some QC
properties about focus handling: it is simply impossible now for focus
to go wrong. As a benefit, we get a dozen new QC properties for free,
governing how master and focus operate.

The encoding of focus in the data type also simplifies the focus
handling in Operations: several operations affecting focus are now
simply wrappers over StackSet.

For the full story, please read the StackSet module, and the QC
properties.

Finally, we save ~40 lines with the simplified logic in Operations.hs

For more info, see the blog post on the implementation,

    http://cgi.cse.unsw.edu.au/~dons/blog/2007/05/17#xmonad_part1b_zipper

darcs-hash:20070520070053-9c5c1-241f7ee7793f5db2b9e33d375965cdc21b26cbd7

1 files changed, 31 insertions, 61 deletions

diff --git a/Main.hs b/Main.hs
index ae0b596..b75c5c3 100644
--- a/Main.hs
+++ b/Main.hs
@@ -10,24 +10,21 @@
 --
 -----------------------------------------------------------------------------
 --
--- xmonad, a minimal window manager for X11
+-- xmonad, a minimalist, tiling window manager for X11
 --
 
 import Data.Bits
 import qualified Data.Map as M
+import Control.Monad.Reader
 
 import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
 import Graphics.X11.Xlib.Extras
-import Graphics.X11.Xinerama
-
-import Control.Monad.State
-import Control.Monad.Reader
-
-import qualified StackSet as W
+import Graphics.X11.Xinerama    (getScreenInfo)
 
 import XMonad
-import Operations
 import Config
+import StackSet (new)
+import Operations   (manage, unmanage, focus, setFocusX, full, isClient)
 
 --
 -- The main entry point
@@ -59,18 +56,15 @@ main = do
             , focusedBorder = fbc
             }
         st = XState
-            { workspace     = W.empty workspaces (length xinesc)
-            , layouts       = M.fromList [(w, safeLayouts) | w <- [0 .. W workspaces - 1]]
-            }
+            { workspace     = new (fromIntegral workspaces) (fromIntegral $ length xinesc)
+            , layouts       = M.fromList [(w, safeLayouts) | w <- [0 .. W workspaces - 1]] }
 
-    xSetErrorHandler -- in C, I'm too lazy to write the binding
+    xSetErrorHandler -- in C, I'm too lazy to write the binding: dons
 
     -- setup initial X environment
     sync dpy False
-    selectInput dpy rootw $  substructureRedirectMask
-                         .|. substructureNotifyMask
-                         .|. enterWindowMask
-                         .|. leaveWindowMask
+    selectInput dpy rootw $  substructureRedirectMask .|. substructureNotifyMask
+                         .|. enterWindowMask .|. leaveWindowMask
     grabKeys dpy rootw
     sync dpy False
 
@@ -78,10 +72,9 @@ main = do
     allocaXEvent $ \e ->
         runX cf st $ do
             mapM_ manage ws
-            forever $ handle =<< xevent dpy e
-      where
-        xevent d e = io (nextEvent d e >> getEvent e)
-        forever a = a >> forever a
+            -- main loop, for all you HOF/recursion fans out there.
+            forever $ handle =<< io (nextEvent dpy e >> getEvent e)
+      where forever a = a >> forever a
 
 -- ---------------------------------------------------------------------
 -- IO stuff. Doesn't require any X state
@@ -105,14 +98,14 @@ grabKeys dpy rootw = do
          kc <- keysymToKeycode dpy sym
          -- "If the specified KeySym is not defined for any KeyCode,
          -- XKeysymToKeycode() returns zero."
-         when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) $ [0, numlockMask, lockMask, numlockMask .|. lockMask]
+         when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) $
+            [0, numlockMask, lockMask, numlockMask .|. lockMask]
   where
     grab kc m = grabKey dpy kc m rootw True grabModeAsync grabModeAsync
 
 -- ---------------------------------------------------------------------
--- Event handler
---
--- | handle. Handle X events
+-- | Event handler. Map X events onto calls into Operations.hs, which
+-- modify our internal model of the window manager state.
 --
 -- Events dwm handles that we don't:
 --
@@ -120,25 +113,13 @@ grabKeys dpy rootw = do
 --    [Expose]         = expose,
 --    [PropertyNotify] = propertynotify,
 --
--- Todo: seperate IO from X monad stuff. We want to be able to test the
--- handler, and client functions, with dummy X interface ops, in QuickCheck
---
--- Will require an abstract interpreter from Event -> X Action, which
--- modifies the internal X state, and then produces an IO action to
--- evaluate.
---
--- XCreateWindowEvent(3X11)
--- Window manager clients normally should ignore this window if the
--- override_redirect member is True.
---
 
 handle :: Event -> X ()
 
 -- run window manager command
 handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
-    | t == keyPress
-    = withDisplay $ \dpy -> do
-        s   <- io $ keycodeToKeysym dpy code 0
+    | t == keyPress = withDisplay $ \dpy -> do
+        s  <- io $ keycodeToKeysym dpy code 0
         whenJust (M.lookup (complement (numlockMask .|. lockMask) .&. m,s) keys) id
 
 -- manage a new window
@@ -147,40 +128,31 @@ handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do
     when (not (wa_override_redirect wa)) $ manage w
 
 -- window destroyed, unmanage it
-handle (DestroyWindowEvent {ev_window = w}) = do b <- isClient w; when b $ unmanage w
-
--- window gone, unmanage it
-handle (UnmapEvent         {ev_window = w}) = do b <- isClient w; when b $ unmanage w
+-- window gone,      unmanage it
+handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w
+handle (UnmapEvent         {ev_window = w}) = whenX (isClient w) $ unmanage w
 
 -- set keyboard mapping
 handle e@(MappingNotifyEvent {ev_window = w}) = do
     io $ refreshKeyboardMapping e
     when (ev_request e == mappingKeyboard) $ withDisplay $ io . flip grabKeys w
 
--- click on an unfocussed window
-handle (ButtonEvent {ev_window = w, ev_event_type = t})
-    | t == buttonPress
-    = safeFocus w
+-- click on an unfocused window, makes it focused on this workspace
+handle (ButtonEvent {ev_window = w, ev_event_type = t}) | t == buttonPress = focus w
 
--- entered a normal window
+-- entered a normal window, makes this focused.
 handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
-    | t == enterNotify  && ev_mode e == notifyNormal && ev_detail e /= notifyInferior
-    = safeFocus w
+    | t == enterNotify && ev_mode   e == notifyNormal
+                       && ev_detail e /= notifyInferior = focus w
 
 -- left a window, check if we need to focus root
 handle e@(CrossingEvent {ev_event_type = t})
     | t == leaveNotify
     = do rootw <- asks theRoot
-         when (ev_window e == rootw && not (ev_same_screen e)) $ setFocus rootw
+         when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw
 
 -- configure a window
-handle e@(ConfigureRequestEvent {ev_window = w}) = do
-    dpy <- asks display
-    ws  <- gets workspace
-
-    when (W.member w ws) $ -- already managed, reconfigure (see client:configure()
-        trace ("Reconfigure already managed window: " ++ show w)
-
+handle e@(ConfigureRequestEvent {}) = withDisplay $ \dpy -> do
     io $ configureWindow dpy (ev_window e) (ev_value_mask e) $ WindowChanges
         { wc_x            = ev_x e
         , wc_y            = ev_y e
@@ -190,9 +162,7 @@ handle e@(ConfigureRequestEvent {ev_window = w}) = do
         , wc_sibling      = ev_above e
         -- this fromIntegral is only necessary with the old X11 version that uses
         -- Int instead of CInt.  TODO delete it when there is a new release of X11
-        , wc_stack_mode   = fromIntegral $ ev_detail e
-        }
-
+        , wc_stack_mode   = fromIntegral $ ev_detail e }
     io $ sync dpy False
 
-handle e = trace (eventName e) -- ignoring
+handle _ = return () -- trace (eventName e) -- ignoring