Rename XMonad to MetaTile

7 files changed, 2790 insertions, 0 deletions

diff --git a/MetaTile/Config.hs b/MetaTile/Config.hs
new file mode 100644
index 0000000..71706d8
--- /dev/null
+++ b/MetaTile/Config.hs
@@ -0,0 +1,321 @@
+{-# OPTIONS -fno-warn-missing-signatures -fno-warn-orphans #-}
+{-# LANGUAGE TypeFamilies #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  MetaTile.Config
+-- Copyright   :  (c) Spencer Janssen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  dons@galois.com
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- This module specifies the default configuration values for xmonad.
+--
+-- DO NOT MODIFY THIS FILE!  It won't work.  You may configure xmonad
+-- by providing your own @~\/.metatile\/metatile.hs@ that overrides
+-- specific fields in the default config, 'def'.  For a starting point, you can
+-- copy the @metatile.hs@ found in the @man@ directory, or look at
+-- examples on the xmonad wiki.
+--
+------------------------------------------------------------------------
+
+module MetaTile.Config (defaultConfig, Default(..)) where
+
+--
+-- Useful imports
+--
+import MetaTile.Core as MetaTile hiding
+    (workspaces,manageHook,keys,logHook,startupHook,mouseBindings
+    ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,defaultBorderWidth,focusFollowsMouse
+    ,handleEventHook,clickJustFocuses,rootMask,frameMask,clientMask)
+import qualified MetaTile.Core as MetaTile
+    (workspaces,manageHook,keys,logHook,startupHook,mouseBindings
+    ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,defaultBorderWidth,focusFollowsMouse
+    ,handleEventHook,clickJustFocuses,rootMask,frameMask,clientMask)
+
+import MetaTile.Layout
+import MetaTile.Operations
+import qualified MetaTile.StackSet as W
+import Data.Bits ((.|.))
+import Data.Default
+import Data.Monoid
+import qualified Data.Map as M
+import System.Exit
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+
+-- | The default number of workspaces (virtual screens) and their names.
+-- By default we use numeric strings, but any string may be used as a
+-- workspace name. The number of workspaces is determined by the length
+-- of this list.
+--
+-- A tagging example:
+--
+-- > workspaces = ["web", "irc", "code" ] ++ map show [4..9]
+--
+workspaces :: [WorkspaceId]
+workspaces = map show [1 .. 9 :: Int]
+
+-- | modMask lets you specify which modkey you want to use. The default
+-- is mod1Mask ("left alt").  You may also consider using mod3Mask
+-- ("right alt"), which does not conflict with emacs keybindings. The
+-- "windows key" is usually mod4Mask.
+--
+defaultModMask :: KeyMask
+defaultModMask = mod1Mask
+
+-- | Border colors for unfocused and focused windows, respectively.
+--
+normalBorderColor, focusedBorderColor :: String
+normalBorderColor  = "gray" -- "#dddddd"
+focusedBorderColor = "red"  -- "#ff0000" don't use hex, not <24 bit safe
+
+defaultBorderWidth :: BorderWidth
+defaultBorderWidth = BorderWidth 1 1 1 1
+
+------------------------------------------------------------------------
+-- Window rules
+
+-- | Execute arbitrary actions and WindowSet manipulations when managing
+-- a new window. You can use this to, for example, always float a
+-- particular program, or have a client always appear on a particular
+-- workspace.
+--
+-- To find the property name associated with a program, use
+--  xprop | grep WM_CLASS
+-- and click on the client you're interested in.
+--
+manageHook :: ManageHook
+manageHook = mempty
+
+------------------------------------------------------------------------
+-- Logging
+
+-- | Perform an arbitrary action on each internal state change or X event.
+-- Examples include:
+--
+--      * do nothing
+--
+--      * log the state to stdout
+--
+-- See the 'DynamicLog' extension for examples.
+--
+logHook :: X ()
+logHook = return ()
+
+------------------------------------------------------------------------
+-- Event handling
+
+-- | Defines a custom handler function for X Events. The function should
+-- return (All True) if the default handler is to be run afterwards.
+-- To combine event hooks, use mappend or mconcat from Data.Monoid.
+handleEventHook :: Event -> X All
+handleEventHook _ = return (All True)
+
+-- | Perform an arbitrary action at xmonad startup.
+startupHook :: X ()
+startupHook = return ()
+
+------------------------------------------------------------------------
+-- Extensible layouts
+--
+-- You can specify and transform your layouts by modifying these values.
+-- If you change layout bindings be sure to use 'mod-shift-space' after
+-- restarting (with 'mod-q') to reset your layout state to the new
+-- defaults, as xmonad preserves your old layout settings by default.
+--
+
+-- | The available layouts.  Note that each layout is separated by |||, which
+-- denotes layout choice.
+layout = tiled ||| Mirror tiled ||| Full
+  where
+     -- default tiling algorithm partitions the screen into two panes
+     tiled   = Tall nmaster delta ratio
+
+     -- The default number of windows in the master pane
+     nmaster = 1
+
+     -- Default proportion of screen occupied by master pane
+     ratio   = 1/2
+
+     -- Percent of screen to increment by when resizing panes
+     delta   = 3/100
+
+------------------------------------------------------------------------
+-- Event Masks:
+
+-- | The client events that xmonad is interested in
+clientMask :: EventMask
+clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
+
+-- | The frame events that xmonad is interested in
+frameMask :: EventMask
+frameMask =  substructureRedirectMask .|. substructureNotifyMask
+
+-- | The root events that xmonad is interested in
+rootMask :: EventMask
+rootMask =  substructureRedirectMask .|. substructureNotifyMask
+        .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
+        .|. buttonPressMask
+
+------------------------------------------------------------------------
+-- Key bindings:
+
+-- | The preferred terminal program, which is used in a binding below and by
+-- certain contrib modules.
+terminal :: String
+terminal = "xterm"
+
+-- | Whether focus follows the mouse pointer.
+focusFollowsMouse :: Bool
+focusFollowsMouse = True
+
+-- | Whether a mouse click select the focus or is just passed to the window
+clickJustFocuses :: Bool
+clickJustFocuses = True
+
+
+-- | The xmonad key bindings. Add, modify or remove key bindings here.
+--
+-- (The comment formatting character is used when generating the manpage)
+--
+keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
+keys conf@(XConfig {MetaTile.modMask = modMask}) = M.fromList $
+    -- launching and killing programs
+    [ ((modMask .|. shiftMask, xK_Return), spawn $ MetaTile.terminal conf) -- %! Launch terminal
+    , ((modMask,               xK_p     ), spawn "dmenu_run") -- %! Launch dmenu
+    , ((modMask .|. shiftMask, xK_p     ), spawn "gmrun") -- %! Launch gmrun
+    , ((modMask .|. shiftMask, xK_c     ), kill) -- %! Close the focused window
+
+    , ((modMask,               xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms
+    , ((modMask .|. shiftMask, xK_space ), setLayout $ MetaTile.layoutHook conf) -- %!  Reset the layouts on the current workspace to default
+
+    , ((modMask,               xK_n     ), refresh) -- %! Resize viewed windows to the correct size
+
+    -- move focus up or down the window stack
+    , ((modMask,               xK_Tab   ), windows W.focusDown) -- %! Move focus to the next window
+    , ((modMask .|. shiftMask, xK_Tab   ), windows W.focusUp  ) -- %! Move focus to the previous window
+    , ((modMask,               xK_j     ), windows W.focusDown) -- %! Move focus to the next window
+    , ((modMask,               xK_k     ), windows W.focusUp  ) -- %! Move focus to the previous window
+    , ((modMask,               xK_m     ), windows W.focusMaster  ) -- %! Move focus to the master window
+
+    -- modifying the window order
+    , ((modMask,               xK_Return), windows W.swapMaster) -- %! Swap the focused window and the master window
+    , ((modMask .|. shiftMask, xK_j     ), windows W.swapDown  ) -- %! Swap the focused window with the next window
+    , ((modMask .|. shiftMask, xK_k     ), windows W.swapUp    ) -- %! Swap the focused window with the previous window
+
+    -- resizing the master/slave ratio
+    , ((modMask,               xK_h     ), sendMessage Shrink) -- %! Shrink the master area
+    , ((modMask,               xK_l     ), sendMessage Expand) -- %! Expand the master area
+
+    -- increase or decrease number of windows in the master area
+    , ((modMask              , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area
+    , ((modMask              , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
+
+    -- quit, or restart
+    , ((modMask .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit metatile
+    , ((modMask              , xK_q     ), spawn "if type metatile; then metatile --recompile && metatile --restart; else xmessage metatile not in \\$PATH: \"$PATH\"; fi") -- %! Restart metatile
+
+    , ((modMask .|. shiftMask, xK_slash ), spawn ("echo \"" ++ help ++ "\" | xmessage -file -")) -- %! Run xmessage with a summary of the default keybindings (useful for beginners)
+    -- repeat the binding for non-American layout keyboards
+    , ((modMask              , xK_question), spawn ("echo \"" ++ help ++ "\" | xmessage -file -"))
+    ]
+    ++
+    -- mod-[1..9] %! Switch to workspace N
+    -- mod-shift-[1..9] %! Move client to workspace N
+    [((m .|. modMask, k), windows $ f i)
+        | (i, k) <- zip (MetaTile.workspaces conf) [xK_1 .. xK_9]
+        , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
+    ++
+    -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
+    -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3
+    [((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f))
+        | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
+        , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
+
+-- | Mouse bindings: default actions bound to mouse events
+mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
+mouseBindings (XConfig {MetaTile.modMask = modMask}) = M.fromList
+    -- mod-button2 %! Raise the window to the top of the stack
+    [ ((modMask, button2), windows . (W.shiftMaster .) . W.focusWindow)
+    -- you may also bind events to the mouse scroll wheel (button4 and button5)
+    ]
+
+instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) where
+  def = XConfig
+    { MetaTile.workspaces         = workspaces
+    , MetaTile.layoutHook         = layout
+    , MetaTile.terminal           = terminal
+    , MetaTile.normalBorderColor  = normalBorderColor
+    , MetaTile.focusedBorderColor = focusedBorderColor
+    , MetaTile.defaultBorderWidth = defaultBorderWidth
+    , MetaTile.modMask            = defaultModMask
+    , MetaTile.keys               = keys
+    , MetaTile.logHook            = logHook
+    , MetaTile.startupHook        = startupHook
+    , MetaTile.mouseBindings      = mouseBindings
+    , MetaTile.manageHook         = manageHook
+    , MetaTile.handleEventHook    = handleEventHook
+    , MetaTile.focusFollowsMouse  = focusFollowsMouse
+    , MetaTile.clickJustFocuses   = clickJustFocuses
+    , MetaTile.clientMask         = clientMask
+    , MetaTile.frameMask          = frameMask
+    , MetaTile.rootMask           = rootMask
+    }
+
+-- | The default set of configuration values itself
+{-# DEPRECATED defaultConfig "Use def (from Data.Default, and re-exported by MetaTile and MetaTile.Config) instead." #-}
+defaultConfig :: XConfig (Choose Tall (Choose (Mirror Tall) Full))
+defaultConfig = def
+
+-- | Finally, a copy of the default bindings in simple textual tabular format.
+help :: String
+help = unlines ["The default modifier key is 'alt'. Default keybindings:",
+    "",
+    "-- launching and killing programs",
+    "mod-Shift-Enter  Launch xterminal",
+    "mod-p            Launch dmenu",
+    "mod-Shift-p      Launch gmrun",
+    "mod-Shift-c      Close/kill the focused window",
+    "mod-Space        Rotate through the available layout algorithms",
+    "mod-Shift-Space  Reset the layouts on the current workSpace to default",
+    "mod-n            Resize/refresh viewed windows to the correct size",
+    "",
+    "-- move focus up or down the window stack",
+    "mod-Tab        Move focus to the next window",
+    "mod-Shift-Tab  Move focus to the previous window",
+    "mod-j          Move focus to the next window",
+    "mod-k          Move focus to the previous window",
+    "mod-m          Move focus to the master window",
+    "",
+    "-- modifying the window order",
+    "mod-Return   Swap the focused window and the master window",
+    "mod-Shift-j  Swap the focused window with the next window",
+    "mod-Shift-k  Swap the focused window with the previous window",
+    "",
+    "-- resizing the master/slave ratio",
+    "mod-h  Shrink the master area",
+    "mod-l  Expand the master area",
+    "",
+    "-- floating layer support",
+    "mod-t  Push window back into tiling; unfloat and re-tile it",
+    "",
+    "-- increase or decrease number of windows in the master area",
+    "mod-comma  (mod-,)   Increment the number of windows in the master area",
+    "mod-period (mod-.)   Deincrement the number of windows in the master area",
+    "",
+    "-- quit, or restart",
+    "mod-Shift-q  Quit metatile",
+    "mod-q        Restart metatile",
+    "mod-[1..9]   Switch to workSpace N",
+    "",
+    "-- Workspaces & screens",
+    "mod-Shift-[1..9]   Move client to workspace N",
+    "mod-{w,e,r}        Switch to physical/Xinerama screens 1, 2, or 3",
+    "mod-Shift-{w,e,r}  Move client to screen 1, 2, or 3",
+    "",
+    "-- Mouse bindings: default actions bound to mouse events",
+    "mod-button1  Set the window to floating mode and move by dragging",
+    "mod-button2  Raise the window to the top of the stack",
+    "mod-button3  Set the window to floating mode and resize by dragging"]
diff --git a/MetaTile/Core.hs b/MetaTile/Core.hs
new file mode 100644
index 0000000..14c4211
--- /dev/null
+++ b/MetaTile/Core.hs
@@ -0,0 +1,574 @@
+{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, PatternGuards,
+             MultiParamTypeClasses, TypeSynonymInstances, CPP, DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  MetaTile.Core
+-- Copyright   :  (c) Spencer Janssen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  spencerjanssen@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable, uses cunning newtype deriving
+--
+-- The 'X' monad, a state monad transformer over 'IO', for the window
+-- manager state, and support routines.
+--
+-----------------------------------------------------------------------------
+
+module MetaTile.Core (
+    X, WindowSet, WindowSpace, WorkspaceId, BorderWidth(..), WindowState(..),
+    ScreenId(..), ScreenDetail(..), XState(..),
+    XConf(..), XConfig(..), LayoutClass(..),
+    Layout(..), readsLayout, Typeable, Message,
+    SomeMessage(..), fromMessage, LayoutMessages(..),
+    StateExtension(..), ExtensionClass(..),
+    runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
+    withDisplay, withWindowSet, isRoot, runOnWorkspaces, getWindowState, getsWindowState, setWindowState, modifyWindowState,
+    getAtom, spawn, spawnPID, xfork, getMetaTileDir, recompile, trace, whenJust, whenX,
+    atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, ManageHook, Query(..), runQuery
+  ) where
+
+import MetaTile.StackSet hiding (modify)
+
+import Prelude hiding ( catch )
+import Codec.Binary.UTF8.String (encodeString)
+import Control.Exception.Extensible (catch, fromException, try, bracket, throw, finally, SomeException(..))
+import Control.Applicative
+import Control.Arrow ((&&&))
+import Control.Monad.State
+import Control.Monad.Reader
+import Data.Default
+import Data.Function (on)
+import System.FilePath
+import System.IO
+import System.Info
+import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus, createSession)
+import System.Posix.Signals
+import System.Posix.IO
+import System.Posix.Types (ProcessID)
+import System.Process
+import System.Directory
+import System.Exit
+import Graphics.X11.Xlib hiding (Screen)
+import Graphics.X11.Xlib.Extras (Event, none)
+import Data.Typeable
+import Data.List ((\\))
+import Data.Maybe (isJust,fromMaybe)
+import Data.Monoid
+
+import qualified Data.Map as M
+
+
+data BorderWidth = BorderWidth
+    { bwTop    :: !Dimension
+    , bwRight  :: !Dimension
+    , bwBottom :: !Dimension
+    , bwLeft   :: !Dimension
+    } deriving Show
+
+data WindowState = WindowState
+    { wsMapped       :: !Bool
+    , wsWaitingUnmap :: !Int         -- ^ the number of expected UnmapEvents
+    , wsFrame        :: !Window
+    , wsBorderWidth  :: !BorderWidth
+    } deriving Show
+
+instance Eq WindowState where
+  (==) = (==) `on` (wsMapped &&& wsWaitingUnmap &&& wsFrame)
+
+
+-- | XState, the (mutable) window manager state.
+data XState = XState
+    { windowset        :: !WindowSet                     -- ^ workspace list
+    , windowState      :: !(M.Map Window WindowState)    -- ^ the extended window state
+    , dragging         :: !(Maybe (Position -> Position -> X (), X ()))
+    , numberlockMask   :: !KeyMask                       -- ^ The numlock modifier
+    , extensibleState  :: !(M.Map String (Either String StateExtension))
+    -- ^ stores custom state information.
+    --
+    -- The module "MetaTile.Utils.ExtensibleState" in xmonad-contrib
+    -- provides additional information and a simple interface for using this.
+    }
+
+-- | XConf, the (read-only) window manager configuration.
+data XConf = XConf
+    { display       :: Display        -- ^ the X11 display
+    , config        :: !(XConfig Layout)       -- ^ initial user configuration
+    , theRoot       :: !Window        -- ^ the root window
+    , normalBorder  :: !Pixel         -- ^ border color of unfocused windows
+    , focusedBorder :: !Pixel         -- ^ border color of the focused window
+    , keyActions    :: !(M.Map (KeyMask, KeySym) (X ()))
+                                      -- ^ a mapping of key presses to actions
+    , buttonActions :: !(M.Map (KeyMask, Button) (Window -> X ()))
+                                      -- ^ a mapping of button presses to actions
+    , mouseFocused :: !Bool           -- ^ was refocus caused by mouse action?
+    , mousePosition :: !(Maybe (Position, Position))
+                                      -- ^ position of the mouse according to
+                                      -- the event currently being processed
+    , currentEvent :: !(Maybe Event)
+                                      -- ^ event currently being processed
+    }
+
+-- todo, better name
+data XConfig l = XConfig
+    { normalBorderColor  :: !String              -- ^ Non focused windows border color. Default: \"#dddddd\"
+    , focusedBorderColor :: !String              -- ^ Focused windows border color. Default: \"#ff0000\"
+    , defaultBorderWidth :: !BorderWidth
+    , terminal           :: !String              -- ^ The preferred terminal application. Default: \"xterm\"
+    , layoutHook         :: !(l Window)          -- ^ The available layouts
+    , manageHook         :: !ManageHook          -- ^ The action to run when a new window is opened
+    , handleEventHook    :: !(Event -> X All)    -- ^ Handle an X event, returns (All True) if the default handler
+                                                 -- should also be run afterwards. mappend should be used for combining
+                                                 -- event hooks in most cases.
+    , workspaces         :: ![String]            -- ^ The list of workspaces' names
+    , modMask            :: !KeyMask             -- ^ the mod modifier
+    , keys               :: !(XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()))
+                                                 -- ^ The key binding: a map from key presses and actions
+    , mouseBindings      :: !(XConfig Layout -> M.Map (ButtonMask, Button) (Window -> X ()))
+                                                 -- ^ The mouse bindings
+    , logHook            :: !(X ())              -- ^ The action to perform when the windows set is changed
+    , startupHook        :: !(X ())              -- ^ The action to perform on startup
+    , focusFollowsMouse  :: !Bool                -- ^ Whether window entry events can change focus
+    , clickJustFocuses   :: !Bool                -- ^ False to make a click which changes focus to be additionally passed to the window
+    , clientMask         :: !EventMask           -- ^ The client events that xmonad is interested in
+    , frameMask          :: !EventMask           -- ^ The frame events that xmonad is interested in
+    , rootMask           :: !EventMask           -- ^ The root events that xmonad is interested in
+    }
+
+
+type WindowSet   = StackSet  WorkspaceId (Layout Window) Window ScreenId ScreenDetail
+type WindowSpace = Workspace WorkspaceId (Layout Window) Window
+
+-- | Virtual workspace indices
+type WorkspaceId = String
+
+-- | Physical screen indices
+newtype ScreenId    = S Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
+
+-- | The 'Rectangle' with screen dimensions
+data ScreenDetail   = SD { screenRect :: !Rectangle } deriving (Eq,Show, Read)
+
+------------------------------------------------------------------------
+
+-- | The X monad, 'ReaderT' and 'StateT' transformers over 'IO'
+-- encapsulating the window manager configuration and state,
+-- respectively.
+--
+-- Dynamic components may be retrieved with 'get', static components
+-- with 'ask'. With newtype deriving we get readers and state monads
+-- instantiated on 'XConf' and 'XState' automatically.
+--
+newtype X a = X (ReaderT XConf (StateT XState IO) a)
+    deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader XConf, Typeable)
+
+instance Applicative X where
+  pure = return
+  (<*>) = ap
+
+instance (Monoid a) => Monoid (X a) where
+    mempty  = return mempty
+    mappend = liftM2 mappend
+
+instance Default a => Default (X a) where
+    def = return def
+
+type ManageHook = Query (Endo WindowSet)
+newtype Query a = Query (ReaderT Window X a)
+    deriving (Functor, Monad, MonadReader Window, MonadIO)
+
+runQuery :: Query a -> Window -> X a
+runQuery (Query m) w = runReaderT m w
+
+instance Monoid a => Monoid (Query a) where
+    mempty  = return mempty
+    mappend = liftM2 mappend
+
+instance Default a => Default (Query a) where
+    def = return def
+
+-- | Run the 'X' monad, given a chunk of 'X' monad code, and an initial state
+-- Return the result, and final state
+runX :: XConf -> XState -> X a -> IO (a, XState)
+runX c st (X a) = runStateT (runReaderT a c) st
+
+-- | Run in the 'X' monad, and in case of exception, and catch it and log it
+-- to stderr, and run the error case.
+catchX :: X a -> X a -> X a
+catchX job errcase = do
+    st <- get
+    c <- ask
+    (a, s') <- io $ runX c st job `catch` \e -> case fromException e of
+                        Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
+                        _ -> do hPrint stderr e; runX c st errcase
+    put s'
+    return a
+
+-- | Execute the argument, catching all exceptions.  Either this function or
+-- 'catchX' should be used at all callsites of user customized code.
+userCode :: X a -> X (Maybe a)
+userCode a = catchX (Just `liftM` a) (return Nothing)
+
+-- | Same as userCode but with a default argument to return instead of using
+-- Maybe, provided for convenience.
+userCodeDef :: a -> X a -> X a
+userCodeDef defValue a = fromMaybe defValue `liftM` userCode a
+
+-- ---------------------------------------------------------------------
+-- Convenient wrappers to state
+
+-- | Run a monad action with the current display settings
+withDisplay :: (Display -> X a) -> X a
+withDisplay   f = asks display >>= f
+
+-- | Run a monadic action with the current stack set
+withWindowSet :: (WindowSet -> X a) -> X a
+withWindowSet f = gets windowset >>= f
+
+-- | True if the given window is the root window
+isRoot :: Window -> X Bool
+isRoot w = (w==) <$> asks theRoot
+
+-- | Wrapper for the common case of atom internment
+getAtom :: String -> X Atom
+getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False
+
+emptyWindowState :: X WindowState
+emptyWindowState = asks (defaultBorderWidth . config) >>= return . WindowState False 0 none
+
+getWindowState :: Window -> X WindowState
+getWindowState w = do
+  ws <- gets $ (M.lookup w) . windowState
+  case ws of
+    Just s  -> return s
+    Nothing -> emptyWindowState
+
+getsWindowState :: (WindowState -> a) -> Window -> X a
+getsWindowState f w = f <$> getWindowState w
+
+setWindowState :: Window -> WindowState -> X ()
+setWindowState w ws = do
+  emptyState <- emptyWindowState
+  let  f | ws == emptyState = M.delete w
+         | otherwise        = M.insert w ws
+  modify $ \s -> s { windowState = f (windowState s) }
+
+modifyWindowState :: (WindowState -> WindowState) -> Window -> X ()
+modifyWindowState f w = getWindowState w >>= return . f >>= setWindowState w
+
+-- | Common non-predefined atoms
+atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE, atom_WM_TAKE_FOCUS :: X Atom
+atom_WM_PROTOCOLS       = getAtom "WM_PROTOCOLS"
+atom_WM_DELETE_WINDOW   = getAtom "WM_DELETE_WINDOW"
+atom_WM_STATE           = getAtom "WM_STATE"
+atom_WM_TAKE_FOCUS      = getAtom "WM_TAKE_FOCUS"
+
+------------------------------------------------------------------------
+-- LayoutClass handling. See particular instances in Operations.hs
+
+-- | An existential type that can hold any object that is in 'Read'
+--   and 'LayoutClass'.
+data Layout a = forall l. (LayoutClass l a, Read (l a)) => Layout (l a)
+
+-- | Using the 'Layout' as a witness, parse existentially wrapped windows
+-- from a 'String'.
+readsLayout :: Layout a -> String -> [(Layout a, String)]
+readsLayout (Layout l) s = [(Layout (asTypeOf x l), rs) | (x, rs) <- reads s]
+
+-- | Every layout must be an instance of 'LayoutClass', which defines
+-- the basic layout operations along with a sensible default for each.
+--
+-- Minimal complete definition:
+--
+-- * 'runLayout' || (('doLayout' || 'pureLayout') && 'emptyLayout'), and
+--
+-- * 'handleMessage' || 'pureMessage'
+--
+-- You should also strongly consider implementing 'description',
+-- although it is not required.
+--
+-- Note that any code which /uses/ 'LayoutClass' methods should only
+-- ever call 'runLayout', 'handleMessage', and 'description'!  In
+-- other words, the only calls to 'doLayout', 'pureMessage', and other
+-- such methods should be from the default implementations of
+-- 'runLayout', 'handleMessage', and so on.  This ensures that the
+-- proper methods will be used, regardless of the particular methods
+-- that any 'LayoutClass' instance chooses to define.
+class Show (layout a) => LayoutClass layout a where
+
+    -- | By default, 'runLayout' calls 'doLayout' if there are any
+    --   windows to be laid out, and 'emptyLayout' otherwise.  Most
+    --   instances of 'LayoutClass' probably do not need to implement
+    --   'runLayout'; it is only useful for layouts which wish to make
+    --   use of more of the 'Workspace' information (for example,
+    --   "MetaTile.Layout.PerWorkspace").
+    runLayout :: Workspace WorkspaceId (layout a) a
+              -> Rectangle
+              -> X ([(a, Rectangle)], Maybe (layout a))
+    runLayout (Workspace _ l ms) r = maybe (emptyLayout l r) (doLayout l r) ms
+
+    -- | Given a 'Rectangle' in which to place the windows, and a 'Stack'
+    -- of windows, return a list of windows and their corresponding
+    -- Rectangles.  If an element is not given a Rectangle by
+    -- 'doLayout', then it is not shown on screen.  The order of
+    -- windows in this list should be the desired stacking order.
+    --
+    -- Also possibly return a modified layout (by returning @Just
+    -- newLayout@), if this layout needs to be modified (e.g. if it
+    -- keeps track of some sort of state).  Return @Nothing@ if the
+    -- layout does not need to be modified.
+    --
+    -- Layouts which do not need access to the 'X' monad ('IO', window
+    -- manager state, or configuration) and do not keep track of their
+    -- own state should implement 'pureLayout' instead of 'doLayout'.
+    doLayout    :: layout a -> Rectangle -> Stack a
+                -> X ([(a, Rectangle)], Maybe (layout a))
+    doLayout l r s   = return (pureLayout l r s, Nothing)
+
+    -- | This is a pure version of 'doLayout', for cases where we
+    -- don't need access to the 'X' monad to determine how to lay out
+    -- the windows, and we don't need to modify the layout itself.
+    pureLayout  :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
+    pureLayout _ r s = [(focus s, r)]
+
+    -- | 'emptyLayout' is called when there are no windows.
+    emptyLayout :: layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
+    emptyLayout _ _ = return ([], Nothing)
+
+    -- | 'handleMessage' performs message handling.  If
+    -- 'handleMessage' returns @Nothing@, then the layout did not
+    -- respond to the message and the screen is not refreshed.
+    -- Otherwise, 'handleMessage' returns an updated layout and the
+    -- screen is refreshed.
+    --
+    -- Layouts which do not need access to the 'X' monad to decide how
+    -- to handle messages should implement 'pureMessage' instead of
+    -- 'handleMessage' (this restricts the risk of error, and makes
+    -- testing much easier).
+    handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))
+    handleMessage l  = return . pureMessage l
+
+    -- | Respond to a message by (possibly) changing our layout, but
+    -- taking no other action.  If the layout changes, the screen will
+    -- be refreshed.
+    pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
+    pureMessage _ _  = Nothing
+
+    -- | This should be a human-readable string that is used when
+    -- selecting layouts by name.  The default implementation is
+    -- 'show', which is in some cases a poor default.
+    description :: layout a -> String
+    description      = show
+
+instance LayoutClass Layout Window where
+    runLayout (Workspace i (Layout l) ms) r = fmap (fmap Layout) `fmap` runLayout (Workspace i l ms) r
+    doLayout (Layout l) r s  = fmap (fmap Layout) `fmap` doLayout l r s
+    emptyLayout (Layout l) r = fmap (fmap Layout) `fmap` emptyLayout l r
+    handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l
+    description (Layout l)   = description l
+
+instance Show (Layout a) where show (Layout l) = show l
+
+-- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of
+-- Exceptions/, Simon Marlow, 2006. Use extensible messages to the
+-- 'handleMessage' handler.
+--
+-- User-extensible messages must be a member of this class.
+--
+class Typeable a => Message a
+
+-- |
+-- A wrapped value of some type in the 'Message' class.
+--
+data SomeMessage = forall a. Message a => SomeMessage a
+
+-- |
+-- And now, unwrap a given, unknown 'Message' type, performing a (dynamic)
+-- type check on the result.
+--
+fromMessage :: Message m => SomeMessage -> Maybe m
+fromMessage (SomeMessage m) = cast m
+
+-- X Events are valid Messages.
+instance Message Event
+
+-- | 'LayoutMessages' are core messages that all layouts (especially stateful
+-- layouts) should consider handling.
+data LayoutMessages = Hide              -- ^ sent when a layout becomes non-visible
+                    | ReleaseResources  -- ^ sent when xmonad is exiting or restarting
+    deriving (Typeable, Eq)
+
+instance Message LayoutMessages
+
+-- ---------------------------------------------------------------------
+-- Extensible state
+--
+
+-- | Every module must make the data it wants to store
+-- an instance of this class.
+--
+-- Minimal complete definition: initialValue
+class Typeable a => ExtensionClass a where
+    -- | Defines an initial value for the state extension
+    initialValue :: a
+    -- | Specifies whether the state extension should be
+    -- persistent. Setting this method to 'PersistentExtension'
+    -- will make the stored data survive restarts, but
+    -- requires a to be an instance of Read and Show.
+    --
+    -- It defaults to 'StateExtension', i.e. no persistence.
+    extensionType :: a -> StateExtension
+    extensionType = StateExtension
+
+-- | Existential type to store a state extension.
+data StateExtension =
+    forall a. ExtensionClass a => StateExtension a
+    -- ^ Non-persistent state extension
+  | forall a. (Read a, Show a, ExtensionClass a) => PersistentExtension a
+    -- ^ Persistent extension
+
+-- ---------------------------------------------------------------------
+-- | General utilities
+--
+-- Lift an 'IO' action into the 'X' monad
+io :: MonadIO m => IO a -> m a
+io = liftIO
+
+-- | Lift an 'IO' action into the 'X' monad.  If the action results in an 'IO'
+-- exception, log the exception to stderr and continue normal execution.
+catchIO :: MonadIO m => IO () -> m ()
+catchIO f = io (f `catch` \(SomeException e) -> hPrint stderr e >> hFlush stderr)
+
+-- | spawn. Launch an external application. Specifically, it double-forks and
+-- runs the 'String' you pass as a command to \/bin\/sh.
+--
+-- Note this function assumes your locale uses utf8.
+spawn :: MonadIO m => String -> m ()
+spawn x = spawnPID x >> return ()
+
+-- | Like 'spawn', but returns the 'ProcessID' of the launched application
+spawnPID :: MonadIO m => String -> m ProcessID
+spawnPID x = xfork $ executeFile "/bin/sh" False ["-c", encodeString x] Nothing
+
+-- | A replacement for 'forkProcess' which resets default signal handlers.
+xfork :: MonadIO m => IO () -> m ProcessID
+xfork x = io . forkProcess . finally nullStdin $ do
+                uninstallSignalHandlers
+                createSession
+                x
+ where
+    nullStdin = do
+        fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
+        dupTo fd stdInput
+        closeFd fd
+
+-- | This is basically a map function, running a function in the 'X' monad on
+-- each workspace with the output of that function being the modified workspace.
+runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
+runOnWorkspaces job = do
+    ws <- gets windowset
+    c:v <- mapM runOnScreen $ current ws : visible ws
+    modify $ \s -> s { windowset = ws { current = c, visible = v } }
+  where
+    runOnScreen scr@Screen { screenWorkspace = w, screenHidden = ws } = do
+      w':ws' <- mapM job (w:ws)
+      return scr { screenWorkspace = w', screenHidden = ws' }
+
+-- | Return the path to @~\/.metatile@.
+getMetaTileDir :: MonadIO m => m String
+getMetaTileDir = io $ getAppUserDataDirectory "metatile"
+
+-- | 'recompile force', recompile @~\/.metatile\/metatile.hs@ when any of the
+-- following apply:
+--
+--      * force is 'True'
+--
+--      * the metatile executable does not exist
+--
+--      * the metatile executable is older than metatile.hs or any file in
+--        ~\/.metatile\/lib
+--
+-- The -i flag is used to restrict recompilation to the metatile.hs file only,
+-- and any files in the ~\/.metatile\/lib directory.
+--
+-- Compilation errors (if any) are logged to ~\/.metatile\/metatile.errors.  If
+-- GHC indicates failure with a non-zero exit code, an xmessage displaying
+-- that file is spawned.
+--
+-- 'False' is returned if there are compilation errors.
+--
+recompile :: MonadIO m => Bool -> m Bool
+recompile force = io $ do
+    dir <- getMetaTileDir
+    let binn = "metatile-"++arch++"-"++os
+        bin  = dir </> binn
+        base = dir </> "metatile"
+        err  = base ++ ".errors"
+        src  = base ++ ".hs"
+        lib  = dir </> "lib"
+    libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles lib
+    srcT <- getModTime src
+    binT <- getModTime bin
+    if force || any (binT <) (srcT : libTs)
+      then do
+        -- temporarily disable SIGCHLD ignoring:
+        uninstallSignalHandlers
+        status <- bracket (openFile err WriteMode) hClose $ \h ->
+            waitForProcess =<< runProcess "ghc" ["--make", "metatile.hs", "-i", "-ilib", "-fforce-recomp", "-main-is", "main", "-v0", "-o",binn] (Just dir)
+                                    Nothing Nothing Nothing (Just h)
+
+        -- re-enable SIGCHLD:
+        installSignalHandlers
+
+        -- now, if it fails, run xmessage to let the user know:
+        when (status /= ExitSuccess) $ do
+            ghcErr <- readFile err
+            let msg = unlines $
+                    ["Error detected while loading metatile configuration file: " ++ src]
+                    ++ lines (if null ghcErr then show status else ghcErr)
+                    ++ ["","Please check the file for errors."]
+            -- nb, the ordering of printing, then forking, is crucial due to
+            -- lazy evaluation
+            hPutStrLn stderr msg
+            forkProcess $ executeFile "xmessage" True ["-default", "okay", msg] Nothing
+            return ()
+        return (status == ExitSuccess)
+      else return True
+ where getModTime f = catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing)
+       isSource = flip elem [".hs",".lhs",".hsc"] . takeExtension
+       allFiles t = do
+            let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
+            cs <- prep <$> catch (getDirectoryContents t) (\(SomeException _) -> return [])
+            ds <- filterM doesDirectoryExist cs
+            concat . ((cs \\ ds):) <$> mapM allFiles ds
+
+-- | Conditionally run an action, using a @Maybe a@ to decide.
+whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
+whenJust mg f = maybe (return ()) f mg
+
+-- | Conditionally run an action, using a 'X' event to decide
+whenX :: X Bool -> X () -> X ()
+whenX a f = a >>= \b -> when b f
+
+-- | A 'trace' for the 'X' monad. Logs a string to stderr. The result may
+-- be found in your .xsession-errors file
+trace :: MonadIO m => String -> m ()
+trace = io . hPutStrLn stderr
+
+-- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to
+-- avoid zombie processes, and clean up any extant zombie processes.
+installSignalHandlers :: MonadIO m => m ()
+installSignalHandlers = io $ do
+    installHandler openEndedPipe Ignore Nothing
+    installHandler sigCHLD Ignore Nothing
+    (try :: IO a -> IO (Either SomeException a))
+      $ fix $ \more -> do
+        x <- getAnyProcessStatus False False
+        when (isJust x) more
+    return ()
+
+uninstallSignalHandlers :: MonadIO m => m ()
+uninstallSignalHandlers = io $ do
+    installHandler openEndedPipe Default Nothing
+    installHandler sigCHLD Default Nothing
+    return ()
diff --git a/MetaTile/Layout.hs b/MetaTile/Layout.hs
new file mode 100644
index 0000000..47fd4f9
--- /dev/null
+++ b/MetaTile/Layout.hs
@@ -0,0 +1,210 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable #-}
+
+-- --------------------------------------------------------------------------
+-- |
+-- Module      :  MetaTile.Layout
+-- Copyright   :  (c) Spencer Janssen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  spencerjanssen@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable, Typeable deriving, mtl, posix
+--
+-- The collection of core layouts.
+--
+-----------------------------------------------------------------------------
+
+module MetaTile.Layout (
+    Full(..), Tall(..), Mirror(..),
+    Resize(..), IncMasterN(..), Choose, (|||), ChangeLayout(..),
+    mirrorRect, splitVertically,
+    splitHorizontally, splitHorizontallyBy, splitVerticallyBy,
+
+    tile
+
+  ) where
+
+import MetaTile.Core
+
+import Graphics.X11 (Rectangle(..))
+import qualified MetaTile.StackSet as W
+import Control.Arrow ((***), second)
+import Control.Monad
+import Data.Maybe (fromMaybe)
+
+------------------------------------------------------------------------
+
+-- | Change the size of the master pane.
+data Resize     = Shrink | Expand   deriving Typeable
+
+-- | Increase the number of clients in the master pane.
+data IncMasterN = IncMasterN !Int    deriving Typeable
+
+instance Message Resize
+instance Message IncMasterN
+
+-- | Simple fullscreen mode. Renders the focused window fullscreen.
+data Full a = Full deriving (Show, Read)
+
+instance LayoutClass Full a
+
+-- | The builtin tiling mode of xmonad. Supports 'Shrink', 'Expand' and
+-- 'IncMasterN'.
+data Tall a = Tall { tallNMaster :: !Int               -- ^ The default number of windows in the master pane (default: 1)
+                   , tallRatioIncrement :: !Rational   -- ^ Percent of screen to increment by when resizing panes (default: 3/100)
+                   , tallRatio :: !Rational            -- ^ Default proportion of screen occupied by master pane (default: 1/2)
+                   }
+                deriving (Show, Read)
+                        -- TODO should be capped [0..1] ..
+
+-- a nice pure layout, lots of properties for the layout, and its messages, in Properties.hs
+instance LayoutClass Tall a where
+    pureLayout (Tall nmaster _ frac) r s = zip ws rs
+      where ws = W.integrate s
+            rs = tile frac r nmaster (length ws)
+
+    pureMessage (Tall nmaster delta frac) m =
+            msum [fmap resize     (fromMessage m)
+                 ,fmap incmastern (fromMessage m)]
+
+      where resize Shrink             = Tall nmaster delta (max 0 $ frac-delta)
+            resize Expand             = Tall nmaster delta (min 1 $ frac+delta)
+            incmastern (IncMasterN d) = Tall (max 0 (nmaster+d)) delta frac
+
+    description _ = "Tall"
+
+-- | Compute the positions for windows using the default two-pane tiling
+-- algorithm.
+--
+-- The screen is divided into two panes. All clients are
+-- then partioned between these two panes. One pane, the master, by
+-- convention has the least number of windows in it.
+tile
+    :: Rational  -- ^ @frac@, what proportion of the screen to devote to the master area
+    -> Rectangle -- ^ @r@, the rectangle representing the screen
+    -> Int       -- ^ @nmaster@, the number of windows in the master pane
+    -> Int       -- ^ @n@, the total number of windows to tile
+    -> [Rectangle]
+tile f r nmaster n = if n <= nmaster || nmaster == 0
+    then splitVertically n r
+    else splitVertically nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns
+  where (r1,r2) = splitHorizontallyBy f r
+
+--
+-- Divide the screen vertically into n subrectangles
+--
+splitVertically, splitHorizontally :: Int -> Rectangle -> [Rectangle]
+splitVertically n r | n < 2 = [r]
+splitVertically n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :
+    splitVertically (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))
+  where smallh = sh `div` fromIntegral n --hmm, this is a fold or map.
+
+-- Not used in the core, but exported
+splitHorizontally n = map mirrorRect . splitVertically n . mirrorRect
+
+-- Divide the screen into two rectangles, using a rational to specify the ratio
+splitHorizontallyBy, splitVerticallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
+splitHorizontallyBy f (Rectangle sx sy sw sh) =
+    ( Rectangle sx sy leftw sh
+    , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)
+  where leftw = floor $ fromIntegral sw * f
+
+-- Not used in the core, but exported
+splitVerticallyBy f = (mirrorRect *** mirrorRect) . splitHorizontallyBy f . mirrorRect
+
+------------------------------------------------------------------------
+
+-- | Mirror a layout, compute its 90 degree rotated form.
+newtype Mirror l a = Mirror (l a) deriving (Show, Read)
+
+instance LayoutClass l a => LayoutClass (Mirror l) a where
+    runLayout (W.Workspace i (Mirror l) ms) r = (map (second mirrorRect) *** fmap Mirror)
+                                                `fmap` runLayout (W.Workspace i l ms) (mirrorRect r)
+    handleMessage (Mirror l) = fmap (fmap Mirror) . handleMessage l
+    description (Mirror l) = "Mirror "++ description l
+
+-- | Mirror a rectangle.
+mirrorRect :: Rectangle -> Rectangle
+mirrorRect (Rectangle rx ry rw rh) = Rectangle ry rx rh rw
+
+------------------------------------------------------------------------
+-- LayoutClass selection manager
+-- Layouts that transition between other layouts
+
+-- | Messages to change the current layout.
+data ChangeLayout = FirstLayout | NextLayout deriving (Eq, Show, Typeable)
+
+instance Message ChangeLayout
+
+-- | The layout choice combinator
+(|||) :: (LayoutClass l a, LayoutClass r a) => l a -> r a -> Choose l r a
+(|||) = Choose L
+infixr 5 |||
+
+-- | A layout that allows users to switch between various layout options.
+data Choose l r a = Choose LR (l a) (r a) deriving (Read, Show)
+
+-- | Are we on the left or right sub-layout?
+data LR = L | R deriving (Read, Show, Eq)
+
+data NextNoWrap = NextNoWrap deriving (Eq, Show, Typeable)
+instance Message NextNoWrap
+
+-- | A small wrapper around handleMessage, as it is tedious to write
+-- SomeMessage repeatedly.
+handle :: (LayoutClass l a, Message m) => l a -> m -> X (Maybe (l a))
+handle l m = handleMessage l (SomeMessage m)
+
+-- | A smart constructor that takes some potential modifications, returns a
+-- new structure if any fields have changed, and performs any necessary cleanup
+-- on newly non-visible layouts.
+choose :: (LayoutClass l a, LayoutClass r a)
+       => Choose l r a-> LR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
+choose (Choose d _ _) d' Nothing Nothing | d == d' = return Nothing
+choose (Choose d l r) d' ml      mr = f lr
+ where
+    (l', r') = (fromMaybe l ml, fromMaybe r mr)
+    lr       = case (d, d') of
+                    (L, R) -> (hide l'  , return r')
+                    (R, L) -> (return l', hide r'  )
+                    (_, _) -> (return l', return r')
+    f (x,y)  = fmap Just $ liftM2 (Choose d') x y
+    hide x   = fmap (fromMaybe x) $ handle x Hide
+
+instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
+    runLayout (W.Workspace i (Choose L l r) ms) =
+        fmap (second . fmap $ flip (Choose L) r) . runLayout (W.Workspace i l ms)
+    runLayout (W.Workspace i (Choose R l r) ms) =
+        fmap (second . fmap $ Choose R l) . runLayout (W.Workspace i r ms)
+
+    description (Choose L l _) = description l
+    description (Choose R _ r) = description r
+
+    handleMessage lr m | Just NextLayout <- fromMessage m = do
+        mlr' <- handle lr NextNoWrap
+        maybe (handle lr FirstLayout) (return . Just) mlr'
+
+    handleMessage c@(Choose d l r) m | Just NextNoWrap <- fromMessage m =
+        case d of
+            L -> do
+                ml <- handle l NextNoWrap
+                case ml of
+                    Just _  -> choose c L ml Nothing
+                    Nothing -> choose c R Nothing =<< handle r FirstLayout
+
+            R -> choose c R Nothing =<< handle r NextNoWrap
+
+    handleMessage c@(Choose _ l _) m | Just FirstLayout <- fromMessage m =
+        flip (choose c L) Nothing =<< handle l FirstLayout
+
+    handleMessage c@(Choose d l r) m | Just ReleaseResources <- fromMessage m =
+        join $ liftM2 (choose c d) (handle l ReleaseResources) (handle r ReleaseResources)
+
+    handleMessage c@(Choose d l r) m = do
+        ml' <- case d of
+                L -> handleMessage l m
+                R -> return Nothing
+        mr' <- case d of
+                L -> return Nothing
+                R -> handleMessage r m
+        choose c d ml' mr'
diff --git a/MetaTile/Main.hsc b/MetaTile/Main.hsc
new file mode 100644
index 0000000..abdb75c
--- /dev/null
+++ b/MetaTile/Main.hsc
@@ -0,0 +1,433 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, ForeignFunctionInterface #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  MetaTile.Main
+-- Copyright   :  (c) Spencer Janssen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  spencerjanssen@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable, uses mtl, X11, posix
+--
+-- metatile, a minimalist, tiling window manager for X11
+--
+-----------------------------------------------------------------------------
+
+module MetaTile.Main (metatile) where
+
+import Control.Arrow (second)
+import Data.Bits
+import Data.List ((\\))
+import Data.Function
+import qualified Data.Map as M
+import Control.Monad.Reader
+import Control.Monad.State
+import Data.Maybe (fromMaybe)
+import Data.Monoid (getAll)
+
+import Foreign.C
+import Foreign.Ptr
+
+import System.Environment (getArgs)
+
+import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
+import Graphics.X11.Xlib.Extras
+import Graphics.X11.Xlib.Types (Visual(..))
+
+import MetaTile.Core
+import qualified MetaTile.Config as Default
+import MetaTile.StackSet (new, member)
+import qualified MetaTile.StackSet as W
+import MetaTile.Operations
+
+import System.IO
+
+------------------------------------------------------------------------
+-- Locale support
+
+#include <locale.h>
+
+foreign import ccall unsafe "locale.h setlocale"
+    c_setlocale :: CInt -> Ptr CChar -> IO (Ptr CChar)
+
+------------------------------------------------------------------------
+
+-- |
+-- The main entry point
+--
+metatile :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
+metatile initxmc = do
+    -- setup locale information from environment
+    withCString "" $ c_setlocale (#const LC_ALL)
+    -- ignore SIGPIPE and SIGCHLD
+    installSignalHandlers
+    -- First, wrap the layout in an existential, to keep things pretty:
+    let xmc = initxmc { layoutHook = Layout $ layoutHook initxmc }
+    dpy   <- openDisplay ""
+    let dflt = defaultScreen dpy
+
+    rootw  <- rootWindow dpy dflt
+
+    args <- getArgs
+
+    when ("--replace" `elem` args) $ replace dpy dflt rootw
+
+    -- If another WM is running, a BadAccess error will be returned.  The
+    -- default error handler will write the exception to stderr and exit with
+    -- an error.
+    selectInput dpy rootw $ rootMask initxmc
+
+    sync dpy False -- sync to ensure all outstanding errors are delivered
+
+    -- turn off the default handler in favor of one that ignores all errors
+    -- (ugly, I know)
+    xSetErrorHandler -- in C, I'm too lazy to write the binding: dons
+
+    xinesc <- getCleanedScreenInfo dpy
+    nbc    <- do v            <- initColor dpy $ normalBorderColor  xmc
+                 ~(Just nbc_) <- initColor dpy $ normalBorderColor Default.def
+                 return (fromMaybe nbc_ v)
+
+    fbc    <- do v <- initColor dpy $ focusedBorderColor xmc
+                 ~(Just fbc_)  <- initColor dpy $ focusedBorderColor Default.def
+                 return (fromMaybe fbc_ v)
+
+    hSetBuffering stdout NoBuffering
+
+    let layout = layoutHook xmc
+        lreads = readsLayout layout
+        initialWinset = new layout (workspaces xmc) $ map SD xinesc
+        maybeRead reads' s = case reads' s of
+                                [(x, "")] -> Just x
+                                _         -> Nothing
+
+        winset = fromMaybe initialWinset $ do
+                    ("--resume" : s : _) <- return args
+                    ws                   <- maybeRead reads s
+                    return $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
+        extState = fromMaybe M.empty $ do
+                     ("--resume" : _ : dyns : _) <- return args
+                     vals                        <- maybeRead reads dyns
+                     return . M.fromList . map (second Left) $ vals
+
+        cf = XConf
+            { display       = dpy
+            , config        = xmc
+            , theRoot       = rootw
+            , normalBorder  = nbc
+            , focusedBorder = fbc
+            , keyActions    = keys xmc xmc
+            , buttonActions = mouseBindings xmc xmc
+            , mouseFocused  = False
+            , mousePosition = Nothing
+            , currentEvent  = Nothing }
+
+        st = XState
+            { windowset       = initialWinset
+            , numberlockMask  = 0
+            , windowState     = M.empty
+            , dragging        = Nothing
+            , extensibleState = extState
+            }
+    allocaXEvent $ \e ->
+        runX cf st $ do
+
+            setNumlockMask
+            grabKeys
+            grabButtons
+
+            io $ sync dpy False
+
+            ws <- io $ scan dpy rootw
+
+            -- bootstrap the windowset, Operations.windows will identify all
+            -- the windows in winset as new and set initial properties for
+            -- those windows.  Remove all windows that are no longer top-level
+            -- children of the root, they may have disappeared since
+            -- restarting.
+            windows . const . foldr W.delete winset $ W.allWindows winset \\ ws
+
+            -- manage the as-yet-unmanaged windows
+            mapM_ (\w -> reparent w >> manage w) (ws \\ W.allWindows winset)
+
+            userCode $ startupHook initxmc
+
+            -- main loop, for all you HOF/recursion fans out there.
+            forever $ prehandle =<< io (nextEvent dpy e >> getEvent e)
+
+    return ()
+      where
+        -- if the event gives us the position of the pointer, set mousePosition
+        prehandle e = let mouse = do guard (ev_event_type e `elem` evs)
+                                     return (fromIntegral (ev_x_root e)
+                                            ,fromIntegral (ev_y_root e))
+                      in local (\c -> c { mousePosition = mouse, currentEvent = Just e }) (handleWithHook e)
+        evs = [ keyPress, keyRelease, enterNotify, leaveNotify
+              , buttonPress, buttonRelease]
+
+
+-- | Runs handleEventHook from the configuration and runs the default handler
+-- function if it returned True.
+handleWithHook :: Event -> X ()
+handleWithHook e = do
+  evHook <- asks (handleEventHook . config)
+  whenX (userCodeDef True $ getAll `fmap` evHook e) (handle e)
+
+-- ---------------------------------------------------------------------
+-- | 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:
+--
+--    [ButtonPress]    = buttonpress,
+--    [Expose]         = expose,
+--    [PropertyNotify] = propertynotify,
+--
+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
+        mClean <- cleanMask m
+        ks <- asks keyActions
+        userCodeDef () $ whenJust (M.lookup (mClean, s) ks) id
+
+-- manage a new window
+handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do
+    wa <- io $ getWindowAttributes dpy w -- ignore override windows
+    -- need to ignore mapping requests by managed windows not on the current workspace
+    managed <- isClient w
+    when (not (wa_override_redirect wa) && not managed) $ do
+      reparent w
+      manage w
+
+-- window destroyed, unmanage it
+-- window gone,      unmanage it
+handle (DestroyWindowEvent {ev_window = w}) = do
+    whenX (isClient w) $
+      unmanage w
+    unparent w
+    modify (\s -> s { windowState = M.delete w (windowState s)})
+
+-- We track expected unmap events in waitingUnmap.  We ignore this event unless
+-- it is synthetic or we are not expecting an unmap notification from a window.
+handle UnmapEvent {ev_window = w, ev_send_event = synthetic, ev_event = we} = whenX (isClient w) $ do
+    rootw <- asks theRoot
+    e <- getsWindowState wsWaitingUnmap w
+    if (synthetic || (e == 0 && we /= rootw))
+        then unmanage w >> hideParent w
+        else when (e > 0) $ modifyWindowState (\ws -> ws { wsWaitingUnmap = e - 1 }) w
+
+-- set keyboard mapping
+handle e@(MappingNotifyEvent {}) = do
+    io $ refreshKeyboardMapping e
+    when (ev_request e `elem` [mappingKeyboard, mappingModifier]) $ do
+        setNumlockMask
+        grabKeys
+
+-- handle button release, which may finish dragging.
+handle e@(ButtonEvent {ev_event_type = t})
+    | t == buttonRelease = do
+    drag <- gets dragging
+    case drag of
+        -- we're done dragging and have released the mouse:
+        Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f
+        Nothing    -> broadcastMessage e
+
+-- handle motionNotify event, which may mean we are dragging.
+handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do
+    drag <- gets dragging
+    case drag of
+        Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging
+        Nothing -> broadcastMessage e
+
+-- click on an unfocused window, makes it focused on this workspace
+handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
+    | t == buttonPress = do
+    -- If it's the root window, then it's something we
+    -- grabbed in grabButtons. Otherwise, it's click-to-focus.
+    dpy <- asks display
+    isr <- isRoot w
+    m <- cleanMask $ ev_state e
+    mact <- asks (M.lookup (m, b) . buttonActions)
+    case mact of
+        Just act | isr -> act $ ev_subwindow e
+        _              -> do
+            focus w
+            ctf <- asks (clickJustFocuses . config)
+            unless ctf $ io (allowEvents dpy replayPointer currentTime)
+    broadcastMessage e -- Always send button events.
+
+-- entered a normal window: focus it if focusFollowsMouse is set to
+-- True in the user's config.
+handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
+    | t == enterNotify && ev_mode   e == notifyNormal
+    = whenX (asks $ focusFollowsMouse . config) (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)) $ setFocusX rootw
+
+-- configure a window
+handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
+    ws <- gets windowset
+
+    if not (member w ws)
+        then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges
+                    { wc_x            = ev_x e
+                    , wc_y            = ev_y e
+                    , wc_width        = ev_width e
+                    , wc_height       = ev_height e
+                    , wc_border_width = 0
+                    , wc_sibling      = ev_above e
+                    , wc_stack_mode   = ev_detail e }
+        else configureClientWindow w
+    io $ sync dpy False
+
+-- configuration changes in the root may mean display settings have changed
+handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen
+
+-- property notify
+handle event@(PropertyEvent { ev_event_type = t, ev_atom = a })
+    | t == propertyNotify && a == wM_NAME = asks (logHook . config) >>= userCodeDef () >>
+                                         broadcastMessage event
+
+handle e@ClientMessageEvent { ev_message_type = mt } = do
+    a <- getAtom "XMONAD_RESTART"
+    if (mt == a)
+        then restart "metatile" True
+        else broadcastMessage e
+
+handle e = broadcastMessage e -- trace (eventName e) -- ignoring
+
+
+reparent :: Window -> X ()
+reparent w = withDisplay $ \dpy -> do
+    rootw <- asks theRoot
+    p <- asks normalBorder
+    fMask <- asks (frameMask . config)
+    noFrame <- getsWindowState ((==none) . wsFrame) w
+    when noFrame $ do
+        trace $ "reparent: " ++ show w
+        frame <- io $ allocaSetWindowAttributes $ \swa -> do
+            set_background_pixel swa p
+            set_border_pixel swa p
+            set_event_mask swa fMask
+            set_override_redirect swa True
+            createWindow dpy rootw (-1) (-1) 1 1 0 copyFromParent inputOutput (Visual nullPtr) (cWBackPixel.|.cWBorderPixel.|.cWEventMask.|.cWOverrideRedirect) swa
+        io $ do
+            unmapWindow dpy w
+            addToSaveSet dpy w
+            reparentWindow dpy w frame 0 0
+        modifyWindowState (\ws -> ws { wsFrame = frame }) w
+
+hideParent :: Window -> X ()
+hideParent w = withDisplay $ \dpy -> do
+    frame <- getsWindowState wsFrame w
+    when (frame /= none) $ io $ unmapWindow dpy frame
+
+unparent :: Window -> X ()
+unparent w = withDisplay $ \dpy -> do
+    frame <- getsWindowState wsFrame w
+    when (frame /= none) $ do
+        trace $ "unparent: " ++ show w
+        io $ destroyWindow dpy frame
+        modifyWindowState (\ws -> ws { wsFrame = none }) w
+
+-- ---------------------------------------------------------------------
+-- IO stuff. Doesn't require any X state
+-- Most of these things run only on startup (bar grabkeys)
+
+-- | scan for any new windows to manage. If they're already managed,
+-- this should be idempotent.
+scan :: Display -> Window -> IO [Window]
+scan dpy rootw = do
+    (_, _, ws) <- queryTree dpy rootw
+    filterM ok ws
+  -- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==
+  -- Iconic
+  where ok w = do wa <- getWindowAttributes dpy w
+                  a  <- internAtom dpy "WM_STATE" False
+                  p  <- getWindowProperty32 dpy a w
+                  let ic = case p of
+                            Just (3:_) -> True -- 3 for iconified
+                            _          -> False
+                  return $ not (wa_override_redirect wa)
+                         && (wa_map_state wa == waIsViewable || ic)
+
+setNumlockMask :: X ()
+setNumlockMask = do
+    dpy <- asks display
+    ms <- io $ getModifierMapping dpy
+    xs <- sequence [ do
+                        ks <- io $ keycodeToKeysym dpy kc 0
+                        if ks == xK_Num_Lock
+                            then return (setBit 0 (fromIntegral m))
+                            else return (0 :: KeyMask)
+                        | (m, kcs) <- ms, kc <- kcs, kc /= 0]
+    modify (\s -> s { numberlockMask = foldr (.|.) 0 xs })
+
+-- | Grab the keys back
+grabKeys :: X ()
+grabKeys = do
+    XConf { display = dpy, theRoot = rootw } <- ask
+    let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
+        (minCode, maxCode) = displayKeycodes dpy
+        allCodes = [fromIntegral minCode .. fromIntegral maxCode]
+    io $ ungrabKey dpy anyKey anyModifier rootw
+    ks <- asks keyActions
+    -- build a map from keysyms to lists of keysyms (doing what
+    -- XGetKeyboardMapping would do if the X11 package bound it)
+    syms <- forM allCodes $ \code -> io (keycodeToKeysym dpy code 0)
+    let keysymMap = M.fromListWith (++) (zip syms [[code] | code <- allCodes])
+        keysymToKeycodes sym = M.findWithDefault [] sym keysymMap
+    forM_ (M.keys ks) $ \(mask,sym) ->
+         forM_ (keysymToKeycodes sym) $ \kc ->
+              mapM_ (grab kc . (mask .|.)) =<< extraModifiers
+
+-- | XXX comment me
+grabButtons :: X ()
+grabButtons = do
+    XConf { display = dpy, theRoot = rootw } <- ask
+    let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask
+                                           grabModeAsync grabModeSync none none
+    io $ ungrabButton dpy anyButton anyModifier rootw
+    ems <- extraModifiers
+    ba <- asks buttonActions
+    mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)
+
+-- | @replace@ to signals compliant window managers to exit.
+replace :: Display -> ScreenNumber -> Window -> IO ()
+replace dpy dflt rootw = do
+    -- check for other WM
+    wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False
+    currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom
+    when (currentWmSnOwner /= 0) $ do
+        -- prepare to receive destroyNotify for old WM
+        selectInput dpy currentWmSnOwner structureNotifyMask
+
+        -- create off-screen window
+        netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do
+            set_override_redirect attributes True
+            set_event_mask attributes propertyChangeMask
+            let screen = defaultScreenOfDisplay dpy
+                visual = defaultVisualOfScreen screen
+                attrmask = cWOverrideRedirect .|. cWEventMask
+            createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes
+
+        -- try to acquire wmSnAtom, this should signal the old WM to terminate
+        xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime
+
+        -- SKIPPED: check if we acquired the selection
+        -- SKIPPED: send client message indicating that we are now the WM
+
+        -- wait for old WM to go away
+        fix $ \again -> do
+            evt <- allocaXEvent $ \event -> do
+                windowEvent dpy currentWmSnOwner structureNotifyMask event
+                get_EventType event
+
+            when (evt /= destroyNotify) again
diff --git a/MetaTile/ManageHook.hs b/MetaTile/ManageHook.hs
new file mode 100644
index 0000000..f2daf9c
--- /dev/null
+++ b/MetaTile/ManageHook.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  MetaTile.ManageHook
+-- Copyright   :  (c) Spencer Janssen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  spencerjanssen@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable, uses cunning newtype deriving
+--
+-- An EDSL for ManageHooks
+--
+-----------------------------------------------------------------------------
+
+-- XXX examples required
+
+module MetaTile.ManageHook where
+
+import Prelude hiding (catch)
+import MetaTile.Core
+import Graphics.X11.Xlib.Extras
+import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME)
+import Control.Exception.Extensible (bracket, catch, SomeException(..))
+import Control.Monad.Reader
+import Data.Maybe
+import Data.Monoid
+import qualified MetaTile.StackSet as W
+import MetaTile.Operations (reveal)
+
+-- | Lift an 'X' action to a 'Query'.
+liftX :: X a -> Query a
+liftX = Query . lift
+
+-- | The identity hook that returns the WindowSet unchanged.
+idHook :: Monoid m => m
+idHook = mempty
+
+-- | Infix 'mappend'. Compose two 'ManageHook' from right to left.
+(<+>) :: Monoid m => m -> m -> m
+(<+>) = mappend
+
+-- | Compose the list of 'ManageHook's.
+composeAll :: Monoid m => [m] -> m
+composeAll = mconcat
+
+infix 0 -->
+
+-- | @p --> x@.  If @p@ returns 'True', execute the 'ManageHook'.
+--
+-- > (-->) :: Monoid m => Query Bool -> Query m -> Query m -- a simpler type
+(-->) :: (Monad m, Monoid a) => m Bool -> m a -> m a
+p --> f = p >>= \b -> if b then f else return mempty
+
+-- | @q =? x@. if the result of @q@ equals @x@, return 'True'.
+(=?) :: Eq a => Query a -> a -> Query Bool
+q =? x = fmap (== x) q
+
+infixr 3 <&&>, <||>
+
+-- | '&&' lifted to a 'Monad'.
+(<&&>) :: Monad m => m Bool -> m Bool -> m Bool
+(<&&>) = liftM2 (&&)
+
+-- | '||' lifted to a 'Monad'.
+(<||>) :: Monad m => m Bool -> m Bool -> m Bool
+(<||>) = liftM2 (||)
+
+-- | Return the window title.
+title :: Query String
+title = ask >>= \w -> liftX $ do
+    d <- asks display
+    let
+        getProp =
+            (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w)
+                `catch` \(SomeException _) -> getTextProperty d w wM_NAME
+        extract prop = do l <- wcTextPropertyToTextList d prop
+                          return $ if null l then "" else head l
+    io $ bracket getProp (xFree . tp_value) extract `catch` \(SomeException _) -> return ""
+
+-- | Return the application name.
+appName :: Query String
+appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClassHint d w)
+
+-- | Backwards compatible alias for 'appName'.
+resource :: Query String
+resource = appName
+
+-- | Return the resource class.
+className :: Query String
+className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getClassHint d w)
+
+-- | A query that can return an arbitrary X property of type 'String',
+--   identified by name.
+stringProperty :: String -> Query String
+stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe "") $ getStringProperty d w p)
+
+getStringProperty :: Display -> Window -> String -> X (Maybe String)
+getStringProperty d w p = do
+  a  <- getAtom p
+  md <- io $ getWindowProperty8 d a w
+  return $ fmap (map (toEnum . fromIntegral)) md
+
+-- | Modify the 'WindowSet' with a pure function.
+doF :: (s -> s) -> Query (Endo s)
+doF = return . Endo
+
+-- | Map the window and remove it from the 'WindowSet'.
+doIgnore :: ManageHook
+doIgnore = ask >>= \w -> liftX (reveal w) >> doF (W.delete w)
+
+-- | Move the window to a given workspace
+doShift :: WorkspaceId -> ManageHook
+doShift i = doF . W.shiftWin i =<< ask
diff --git a/MetaTile/Operations.hs b/MetaTile/Operations.hs
new file mode 100644
index 0000000..1a2fd11
--- /dev/null
+++ b/MetaTile/Operations.hs
@@ -0,0 +1,588 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+
+-- --------------------------------------------------------------------------
+-- |
+-- Module      :  MetaTile.Operations
+-- Copyright   :  (c) Spencer Janssen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  dons@cse.unsw.edu.au
+-- Stability   :  unstable
+-- Portability :  not portable, Typeable deriving, mtl, posix
+--
+-- Operations.
+--
+-----------------------------------------------------------------------------
+
+module MetaTile.Operations where
+
+import MetaTile.Core
+import MetaTile.Layout (Full(..))
+import qualified MetaTile.StackSet as W
+
+import Data.Maybe
+import Data.Monoid          (Endo(..))
+import Data.List            (nub, (\\), find)
+import Data.Bits            ((.|.), (.&.), complement, testBit)
+import Data.Ratio
+import qualified Data.Map as M
+
+import Control.Applicative
+import Control.Arrow ((&&&))
+import Control.Monad.Reader
+import Control.Monad.State
+import qualified Control.Exception.Extensible as C
+
+import System.Posix.Process (executeFile)
+import Graphics.X11.Xlib
+import Graphics.X11.Xinerama (getScreenInfo)
+import Graphics.X11.Xlib.Extras
+
+-- ---------------------------------------------------------------------
+-- |
+-- Window manager operations
+-- manage. Add a new window to be managed in the current workspace.
+-- Bring it into focus.
+--
+-- Whether the window is already managed, or not, it is mapped, has its
+-- border set, and its event mask set.
+--
+manage :: Window -> X ()
+manage w = whenX (not <$> isClient w) $ do
+    mh <- asks (manageHook . config)
+    g <- appEndo <$> userCodeDef (Endo id) (runQuery mh w)
+    windows (g . W.insertUp w)
+
+-- | unmanage. A window no longer exists, remove it from the window
+-- list, on whatever workspace it is.
+--
+unmanage :: Window -> X ()
+unmanage = windows . W.delete
+
+-- | Kill the specified window. If we do kill it, we'll get a
+-- delete notify back from X.
+--
+-- There are two ways to delete a window. Either just kill it, or if it
+-- supports the delete protocol, send a delete event (e.g. firefox)
+--
+killWindow :: Window -> X ()
+killWindow w = withDisplay $ \d -> do
+    wmdelt <- atom_WM_DELETE_WINDOW  ;  wmprot <- atom_WM_PROTOCOLS
+
+    protocols <- io $ getWMProtocols d w
+    io $ if wmdelt `elem` protocols
+        then allocaXEvent $ \ev -> do
+                setEventType ev clientMessage
+                setClientMessageEvent ev w wmprot 32 wmdelt 0
+                sendEvent d w False noEventMask ev
+        else killClient d w >> return ()
+
+-- | Kill the currently focused client.
+kill :: X ()
+kill = withFocused killWindow
+
+-- ---------------------------------------------------------------------
+-- Managing windows
+
+-- | windows. Modify the current window list with a pure function, and refresh
+windows :: (WindowSet -> WindowSet) -> X ()
+windows f = do
+    XState { windowset = old } <- get
+    let oldvisible = concatMap (W.integrate' . W.stack . W.screenWorkspace) $ W.screens old
+        newwindows = W.allWindows ws \\ W.allWindows old
+        ws = f old
+    XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask
+
+    mapM_ setInitialProperties newwindows
+
+    whenJust (W.peek old) $ \otherw -> setFrameBackground d otherw nbc
+    modify (\s -> s { windowset = ws })
+
+    -- notify non visibility
+    let tags_oldvisible = map (W.tag . W.screenWorkspace) $ W.screens old
+        gottenhidden    = filter (flip elem tags_oldvisible . W.tag) $ W.hidden ws
+    mapM_ (sendMessageWithNoRefresh Hide) gottenhidden
+
+    -- for each workspace, layout the currently visible workspaces
+    let allscreens     = W.screens ws
+        summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.screenWorkspace) allscreens
+    rects <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do
+        let wsp   = W.screenWorkspace w
+            this  = W.view n ws
+            n     = W.tag wsp
+            tiled = (W.stack . W.screenWorkspace . W.current $ this)
+                    >>= W.filter (`notElem` vis)
+            viewrect = screenRect $ W.screenDetail w
+
+        -- just the tiled windows:
+        -- now tile the windows on this workspace, modified by the gap
+        (rs, ml') <- runLayout wsp { W.stack = tiled } viewrect `catchX`
+                     runLayout wsp { W.stack = tiled, W.layout = Layout Full } viewrect
+        updateLayout n ml'
+
+        io $ restackWindows d (map fst rs)
+        -- return the visible windows for this workspace:
+        return rs
+
+    let visible = map fst rects
+
+    mapM_ (uncurry tileWindow) rects
+
+    whenJust (W.peek ws) $ \w -> setFrameBackground d w fbc
+
+    mapM_ reveal visible
+    setTopFocus
+
+    -- hide every window that was potentially visible before, but is not
+    -- given a position by a layout now.
+    mapM_ hide (nub (oldvisible ++ newwindows) \\ visible)
+
+    -- all windows that are no longer in the windowset are marked as
+    -- withdrawn, it is important to do this after the above, otherwise 'hide'
+    -- will overwrite withdrawnState with iconicState
+    mapM_ (flip setWMState withdrawnState) (W.allWindows old \\ W.allWindows ws)
+
+    isMouseFocused <- asks mouseFocused
+    unless isMouseFocused $ clearEvents enterWindowMask
+    asks (logHook . config) >>= userCodeDef ()
+  where
+    setFrameBackground :: Display -> Window -> Pixel -> X ()
+    setFrameBackground d w p = do
+      frame <- getsWindowState wsFrame w
+      io $ do
+        setWindowBackground d frame p
+        clearWindow d frame
+
+-- | Produce the actual rectangle from a screen and a ratio on that screen.
+scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle
+scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh)
+ = Rectangle (sx + scale sw rx) (sy + scale sh ry) (scale sw rw) (scale sh rh)
+ where scale s r = floor (toRational s * r)
+
+-- | setWMState.  set the WM_STATE property
+setWMState :: Window -> Int -> X ()
+setWMState w v = withDisplay $ \dpy -> do
+    a <- atom_WM_STATE
+    io $ changeProperty32 dpy w a a propModeReplace [fromIntegral v, fromIntegral none]
+
+-- | hide. Hide a window by unmapping it, and setting Iconified.
+hide :: Window -> X ()
+hide w = whenX (getsWindowState wsMapped w) $ withDisplay $ \d -> do
+    (cMask,fMask) <- asks $ (clientMask &&& frameMask) . config
+    frame <- getsWindowState wsFrame w
+    io $ do selectInput d w (cMask .&. complement structureNotifyMask)
+            selectInput d frame (fMask .&. complement structureNotifyMask)
+            unmapWindow d frame
+            selectInput d frame fMask
+            selectInput d w cMask
+    setWMState w iconicState
+    -- this part is key: we increment the waitingUnmap counter to distinguish
+    -- between client and xmonad initiated unmaps.
+    modifyWindowState (\ws -> ws { wsMapped       = False
+                                 , wsWaitingUnmap = (wsWaitingUnmap ws) + 1 }) w
+
+configureClientWindow :: Window -> X ()
+configureClientWindow w = withDisplay $ \d -> do
+    (frame, bw) <- getsWindowState (wsFrame &&& wsBorderWidth) w
+    (_, x, y, width, height, _, _) <- io $ getGeometry d frame
+    let least1 n = max 1 n
+        x' = x + (fi $ bwLeft bw)
+        y' = y + (fi $ bwTop bw)
+        width' = least1 (width - bwLeft bw - bwRight bw)
+        height' = least1 (height - bwTop bw - bwBottom bw)
+    io $ do
+        moveResizeWindow d w (fi $ bwLeft bw) (fi $ bwTop bw) width' height'
+        -- send absolute ConfigureNotify
+        allocaXEvent $ \event -> do
+            setEventType event configureNotify
+            setConfigureEvent event w w (fi x') (fi y') (fi width') (fi height') 0 none False
+            sendEvent d w False 0 event
+  where
+    fi :: (Integral a, Num b) => a -> b
+    fi = fromIntegral
+
+-- | reveal. Show a window by mapping it and setting Normal
+-- this is harmless if the window was already visible
+reveal :: Window -> X ()
+reveal w = withDisplay $ \d -> do
+    setWMState w normalState
+    io $ mapWindow d w
+    whenX (isClient w) $ do
+        configureClientWindow w
+        getsWindowState wsFrame w >>= io . mapWindow d
+        modifyWindowState (\ws -> ws { wsMapped = True }) w
+
+-- | Set some properties when we initially gain control of a window
+setInitialProperties :: Window -> X ()
+setInitialProperties w = withDisplay $ \d -> do
+    setWMState w iconicState
+    asks (clientMask . config) >>= io . selectInput d w
+    io $ setWindowBorderWidth d w 0
+
+-- | refresh. Render the currently visible workspaces, as determined by
+-- the 'StackSet'. Also, set focus to the focused window.
+--
+-- This is our 'view' operation (MVC), in that it pretty prints our model
+-- with X calls.
+--
+refresh :: X ()
+refresh = windows id
+
+-- | clearEvents.  Remove all events of a given type from the event queue.
+clearEvents :: EventMask -> X ()
+clearEvents mask = withDisplay $ \d -> io $ do
+    sync d False
+    allocaXEvent $ \p -> fix $ \again -> do
+        more <- checkMaskEvent d mask p
+        when more again -- beautiful
+
+-- | tileWindow. Moves and resizes w such that it fits inside the given
+-- rectangle, including its border.
+tileWindow :: Window -> Rectangle -> X ()
+tileWindow w r = withDisplay $ \d -> do
+    -- give all windows at least 1x1 pixels
+    let least x | x <= 0  = 1
+                | otherwise  = x
+    frame <- getsWindowState wsFrame w
+    io $ moveResizeWindow d frame (rect_x r) (rect_y r) (least $ rect_width r) (least $ rect_height r)
+
+-- ---------------------------------------------------------------------
+
+-- | Returns 'True' if the first rectangle is contained within, but not equal
+-- to the second.
+containedIn :: Rectangle -> Rectangle -> Bool
+containedIn r1@(Rectangle x1 y1 w1 h1) r2@(Rectangle x2 y2 w2 h2)
+ = and [ r1 /= r2
+       , x1 >= x2
+       , y1 >= y2
+       , fromIntegral x1 + w1 <= fromIntegral x2 + w2
+       , fromIntegral y1 + h1 <= fromIntegral y2 + h2 ]
+
+-- | Given a list of screens, remove all duplicated screens and screens that
+-- are entirely contained within another.
+nubScreens :: [Rectangle] -> [Rectangle]
+nubScreens xs = nub . filter (\x -> not $ any (x `containedIn`) xs) $ xs
+
+-- | Cleans the list of screens according to the rules documented for
+-- nubScreens.
+getCleanedScreenInfo :: MonadIO m => Display -> m [Rectangle]
+getCleanedScreenInfo = io .  fmap nubScreens . getScreenInfo
+
+-- | rescreen.  The screen configuration may have changed (due to
+-- xrandr), update the state and refresh the screen, and reset the gap.
+rescreen :: X ()
+rescreen = do
+    xinesc <- withDisplay getCleanedScreenInfo
+
+    windows $ \ws ->
+        let (xs, ys) = splitAt (length xinesc) $ W.workspaces ws
+            (a:as)   = zipWith3 (flip W.Screen []) xs [0..] $ map SD xinesc
+        in  ws { W.current = a { W.screenHidden = ys }
+               , W.visible = as }
+
+-- ---------------------------------------------------------------------
+
+-- | setButtonGrab. Tell whether or not to intercept clicks on a given window
+setButtonGrab :: Bool -> Window -> X ()
+setButtonGrab grab w = do
+    pointerMode <- asks $ \c -> if clickJustFocuses (config c)
+                                    then grabModeAsync
+                                    else grabModeSync
+    withDisplay $ \d -> io $ if grab
+        then forM_ [button1, button2, button3] $ \b ->
+            grabButton d b anyModifier w False buttonPressMask
+                       pointerMode grabModeSync none none
+        else ungrabButton d anyButton anyModifier w
+
+-- ---------------------------------------------------------------------
+-- Setting keyboard focus
+
+-- | Set the focus to the window on top of the stack, or root
+setTopFocus :: X ()
+setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.peek
+
+-- | Set focus explicitly to window 'w' if it is managed by us, or root.
+-- This happens if X notices we've moved the mouse (and perhaps moved
+-- the mouse to a new screen).
+focus :: Window -> X ()
+focus w = local (\c -> c { mouseFocused = True }) $ withWindowSet $ \s -> do
+    let stag = W.tag . W.screenWorkspace
+        curr = stag $ W.current s
+    mnew <- maybe (return Nothing) (fmap (fmap stag) . uncurry pointScreen)
+            =<< asks mousePosition
+    root <- asks theRoot
+    case () of
+        _ | W.member w s && W.peek s /= Just w -> windows (W.focusWindow w)
+          | Just new <- mnew, w == root && curr /= new
+                                               -> windows (W.view new)
+          | otherwise                          -> return ()
+
+-- | Call X to set the keyboard focus details.
+setFocusX :: Window -> X ()
+setFocusX w = withWindowSet $ \ws -> do
+    dpy <- asks display
+
+    -- clear mouse button grab and border on other windows
+    forM_ (W.screens ws) $ \wk ->
+      forM_ (W.index (W.view (W.tag (W.screenWorkspace wk)) ws)) $ \otherw ->
+        setButtonGrab True otherw
+
+    -- If we ungrab buttons on the root window, we lose our mouse bindings.
+    whenX (not <$> isRoot w) $ setButtonGrab False w
+
+    hints <- io $ getWMHints dpy w
+    protocols <- io $ getWMProtocols dpy w
+    wmprot <- atom_WM_PROTOCOLS
+    wmtf <- atom_WM_TAKE_FOCUS
+    currevt <- asks currentEvent
+    let inputHintSet = wmh_flags hints `testBit` inputHintBit
+
+    when ((inputHintSet && wmh_input hints) || (not inputHintSet)) $
+      io $ do setInputFocus dpy w revertToPointerRoot 0
+    when (wmtf `elem` protocols) $
+      io $ allocaXEvent $ \ev -> do
+        setEventType ev clientMessage
+        setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt
+        sendEvent dpy w False noEventMask ev
+        where event_time ev =
+                if (ev_event_type ev) `elem` timedEvents then
+                  ev_time ev
+                else
+                  currentTime
+              timedEvents = [ keyPress, keyRelease, buttonPress, buttonRelease, enterNotify, leaveNotify, selectionRequest ]
+
+------------------------------------------------------------------------
+-- Message handling
+
+-- | Throw a message to the current 'LayoutClass' possibly modifying how we
+-- layout the windows, then refresh.
+sendMessage :: Message a => a -> X ()
+sendMessage a = do
+    w <- W.screenWorkspace . W.current <$> gets windowset
+    ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
+    whenJust ml' $ \l' ->
+        windows $ \ws -> ws { W.current = (W.current ws)
+                                { W.screenWorkspace = (W.screenWorkspace $ W.current ws)
+                                  { W.layout = l' }}}
+
+-- | Send a message to all layouts, without refreshing.
+broadcastMessage :: Message a => a -> X ()
+broadcastMessage a = withWindowSet $ \ws ->
+   mapM_ (sendMessageWithNoRefresh a) (W.workspaces ws)
+
+-- | Send a message to a layout, without refreshing.
+sendMessageWithNoRefresh :: Message a => a -> W.Workspace WorkspaceId (Layout Window) Window -> X ()
+sendMessageWithNoRefresh a w =
+    handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing >>=
+    updateLayout  (W.tag w)
+
+-- | Update the layout field of a workspace
+updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X ()
+updateLayout i ml = whenJust ml $ \l ->
+    runOnWorkspaces $ \ww -> return $ if W.tag ww == i then ww { W.layout = l} else ww
+
+-- | Set the layout of the currently viewed workspace
+setLayout :: Layout Window -> X ()
+setLayout l = do
+    ss@(W.StackSet { W.current = c@(W.Screen { W.screenWorkspace = ws })}) <- gets windowset
+    handleMessage (W.layout ws) (SomeMessage ReleaseResources)
+    windows $ const $ ss {W.current = c { W.screenWorkspace = ws { W.layout = l } } }
+
+------------------------------------------------------------------------
+-- Utilities
+
+-- | Return workspace visible on screen 'sc', or 'Nothing'.
+screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)
+screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc
+
+-- | Apply an 'X' operation to the currently focused window, if there is one.
+withFocused :: (Window -> X ()) -> X ()
+withFocused f = withWindowSet $ \w -> whenJust (W.peek w) f
+
+-- | 'True' if window is under management by us
+isClient :: Window -> X Bool
+isClient w = withWindowSet $ return . W.member w
+
+-- | Combinations of extra modifier masks we need to grab keys\/buttons for.
+-- (numlock and capslock)
+extraModifiers :: X [KeyMask]
+extraModifiers = do
+    nlm <- gets numberlockMask
+    return [0, nlm, lockMask, nlm .|. lockMask ]
+
+-- | Strip numlock\/capslock from a mask
+cleanMask :: KeyMask -> X KeyMask
+cleanMask km = do
+    nlm <- gets numberlockMask
+    return (complement (nlm .|. lockMask) .&. km)
+
+-- | Get the 'Pixel' value for a named color
+initColor :: Display -> String -> IO (Maybe Pixel)
+initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $
+    (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
+    where colormap = defaultColormap dpy (defaultScreen dpy)
+
+------------------------------------------------------------------------
+
+-- | @restart name resume@. Attempt to restart xmonad by executing the program
+-- @name@.  If @resume@ is 'True', restart with the current window state.
+-- When executing another window manager, @resume@ should be 'False'.
+restart :: String -> Bool -> X ()
+restart prog resume = do
+    broadcastMessage ReleaseResources
+    io . flush =<< asks display
+    let wsData = show . W.mapLayout show . windowset
+        maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext)
+        maybeShow (t, Left str) = Just (t, str)
+        maybeShow _ = Nothing
+        extState = return . show . catMaybes . map maybeShow . M.toList . extensibleState
+    args <- if resume then gets (\s -> "--resume":wsData s:extState s) else return []
+    catchIO (executeFile prog True args Nothing)
+
+------------------------------------------------------------------------
+-- | Floating layer support
+
+-- | Given a window, find the screen it is located on, and compute
+-- the geometry of that window wrt. that screen.
+floatLocation :: Window -> X (ScreenId, W.RationalRect)
+floatLocation w = withDisplay $ \d -> do
+    ws <- gets windowset
+    wa <- io $ getWindowAttributes d w
+    let bw = (fromIntegral . wa_border_width) wa
+    sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
+
+    let sr = screenRect . W.screenDetail $ sc
+        rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
+                            ((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
+                            (fi (wa_width  wa + bw*2) % fi (rect_width sr))
+                            (fi (wa_height wa + bw*2) % fi (rect_height sr))
+
+    return (W.screen sc, rr)
+  where fi x = fromIntegral x
+
+-- | Given a point, determine the screen (if any) that contains it.
+pointScreen :: Position -> Position
+            -> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
+pointScreen x y = withWindowSet $ return . find p . W.screens
+  where p = pointWithin x y . screenRect . W.screenDetail
+
+-- | @pointWithin x y r@ returns 'True' if the @(x, y)@ co-ordinate is within
+-- @r@.
+pointWithin :: Position -> Position -> Rectangle -> Bool
+pointWithin x y r = x >= rect_x r &&
+                    x <  rect_x r + fromIntegral (rect_width r) &&
+                    y >= rect_y r &&
+                    y <  rect_y r + fromIntegral (rect_height r)
+
+-- | Make a tiled window floating, using its suggested rectangle
+{-float :: Window -> X ()
+float w = do
+    (sc, rr) <- floatLocation w
+    windows $ \ws -> W.float w rr . fromMaybe ws $ do
+        i  <- W.findTag w ws
+        guard $ i `elem` concatMap (map W.tag . W.screenWorkspaces) (W.screens ws)
+        f  <- W.peek ws
+        sw <- W.lookupWorkspace sc ws
+        return (W.focusWindow f . W.shiftWin sw w $ ws)-}
+
+-- ---------------------------------------------------------------------
+-- Mouse handling
+
+-- | Accumulate mouse motion events
+mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
+mouseDrag f done = do
+    drag <- gets dragging
+    case drag of
+        Just _ -> return () -- error case? we're already dragging
+        Nothing -> do
+            XConf { theRoot = root, display = d } <- ask
+            io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
+                    grabModeAsync grabModeAsync none none currentTime
+            modify $ \s -> s { dragging = Just (motion, cleanup) }
+ where
+    cleanup = do
+        withDisplay $ io . flip ungrabPointer currentTime
+        modify $ \s -> s { dragging = Nothing }
+        done
+    motion x y = do z <- f x y
+                    clearEvents pointerMotionMask
+                    return z
+
+-- | XXX comment me
+{-mouseMoveWindow :: Window -> X ()
+mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w
+    let ox = fromIntegral ox'
+        oy = fromIntegral oy'
+    mouseDrag (\ex ey -> io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
+                                             (fromIntegral (fromIntegral (wa_y wa) + (ey - oy))))
+              (float w)
+
+-- | XXX comment me
+mouseResizeWindow :: Window -> X ()
+mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    sh <- io $ getWMNormalHints d w
+    io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
+    mouseDrag (\ex ey ->
+                 io $ resizeWindow d w `uncurry`
+                    applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
+                                               ey - fromIntegral (wa_y wa)))
+              (float w)-}
+
+-- ---------------------------------------------------------------------
+-- | Support for window size hints
+
+type D = (Dimension, Dimension)
+
+-- | Given a window, build an adjuster function that will reduce the given
+-- dimensions according to the window's border width and size hints.
+mkAdjust :: Window -> X (D -> D)
+mkAdjust w = withDisplay $ \d -> liftIO $ do
+    sh <- getWMNormalHints d w
+    bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w
+    return $ applySizeHints bw sh
+
+-- | Reduce the dimensions if needed to comply to the given SizeHints, taking
+-- window borders into account.
+applySizeHints :: Integral a => Dimension -> SizeHints -> (a, a) -> D
+applySizeHints bw sh =
+    tmap (+ 2 * bw) . applySizeHintsContents sh . tmap (subtract $ 2 * fromIntegral bw)
+    where
+    tmap f (x, y) = (f x, f y)
+
+-- | Reduce the dimensions if needed to comply to the given SizeHints.
+applySizeHintsContents :: Integral a => SizeHints -> (a, a) -> D
+applySizeHintsContents sh (w, h) =
+    applySizeHints' sh (fromIntegral $ max 1 w, fromIntegral $ max 1 h)
+
+-- | XXX comment me
+applySizeHints' :: SizeHints -> D -> D
+applySizeHints' sh =
+      maybe id applyMaxSizeHint                   (sh_max_size   sh)
+    . maybe id (\(bw, bh) (w, h) -> (w+bw, h+bh)) (sh_base_size  sh)
+    . maybe id applyResizeIncHint                 (sh_resize_inc sh)
+    . maybe id applyAspectHint                    (sh_aspect     sh)
+    . maybe id (\(bw,bh) (w,h)   -> (w-bw, h-bh)) (sh_base_size  sh)
+
+-- | Reduce the dimensions so their aspect ratio falls between the two given aspect ratios.
+applyAspectHint :: (D, D) -> D -> D
+applyAspectHint ((minx, miny), (maxx, maxy)) x@(w,h)
+    | or [minx < 1, miny < 1, maxx < 1, maxy < 1] = x
+    | w * maxy > h * maxx                         = (h * maxx `div` maxy, h)
+    | w * miny < h * minx                         = (w, w * miny `div` minx)
+    | otherwise                                   = x
+
+-- | Reduce the dimensions so they are a multiple of the size increments.
+applyResizeIncHint :: D -> D -> D
+applyResizeIncHint (iw,ih) x@(w,h) =
+    if iw > 0 && ih > 0 then (w - w `mod` iw, h - h `mod` ih) else x
+
+-- | Reduce the dimensions if they exceed the given maximum dimensions.
+applyMaxSizeHint  :: D -> D -> D
+applyMaxSizeHint (mw,mh) x@(w,h) =
+    if mw > 0 && mh > 0 then (min w mw,min h mh) else x
diff --git a/MetaTile/StackSet.hs b/MetaTile/StackSet.hs
new file mode 100644
index 0000000..907840c
--- /dev/null
+++ b/MetaTile/StackSet.hs
@@ -0,0 +1,549 @@
+{-# LANGUAGE PatternGuards #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  MetaTile.StackSet
+-- Copyright   :  (c) Don Stewart 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  dons@galois.com
+-- Stability   :  experimental
+-- Portability :  portable, Haskell 98
+--
+
+module MetaTile.StackSet (
+        -- * Introduction
+        -- $intro
+
+        -- ** The Zipper
+        -- $zipper
+
+        -- ** Xinerama support
+        -- $xinerama
+
+        -- ** Master and Focus
+        -- $focus
+
+        StackSet(..), Workspace(..), Screen(..), Stack(..), RationalRect(..),
+        -- *  Construction
+        -- $construction
+        new, view, greedyView,
+        -- * Xinerama operations
+        -- $xinerama
+        lookupWorkspace,
+        screens, screenWorkspaces, workspaces, hidden, allWindows, currentTag,
+        -- *  Operations on the current stack
+        -- $stackOperations
+        peek, index, integrate, integrate', differentiate,
+        focusUp, focusDown, focusUp', focusDown', focusMaster, focusWindow,
+        tagMember, renameTag, member, findTag, mapWorkspace, mapLayout,
+        -- * Modifying the stackset
+        -- $modifyStackset
+        insertUp, delete, filter,
+        -- * Setting the master window
+        -- $settingMW
+        swapUp, swapDown, swapMaster, shiftMaster, modify, modify', -- needed by users
+        -- * Composite operations
+        -- $composite
+        shift, shiftWin,
+
+        -- for testing
+        abort
+    ) where
+
+import Prelude hiding (filter)
+import Data.Function   (on)
+import Data.Maybe   (listToMaybe,isJust,fromMaybe)
+import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
+
+-- $intro
+--
+-- The 'StackSet' data type encodes a window manager abstraction. The
+-- window manager is a set of virtual workspaces. On each workspace is a
+-- stack of windows. A given workspace is always current, and a given
+-- window on each workspace has focus. The focused window on the current
+-- workspace is the one which will take user input. It can be visualised
+-- as follows:
+--
+-- > Workspace  { 0*}   { 1 }   { 2 }   { 3 }   { 4 }
+-- >
+-- > Windows    [1      []      [3*     [6*]    []
+-- >            ,2*]            ,4
+-- >                            ,5]
+--
+-- Note that workspaces are indexed from 0, windows are numbered
+-- uniquely. A '*' indicates the window on each workspace that has
+-- focus, and which workspace is current.
+
+-- $zipper
+--
+-- We encode all the focus tracking directly in the data structure, with a 'zipper':
+--
+--    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.
+--
+--    The Zipper lets us replace an item deep in a complex data
+--    structure, e.g., a tree or a term, without an  mutation.  The
+--    resulting data structure will share as much of its components with
+--    the old structure as possible.
+--
+--      Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"
+--
+-- We use the zipper to keep track of the focused workspace and the
+-- focused window on each workspace, allowing us to have correct focus
+-- by construction. We closely follow Huet's original implementation:
+--
+--      G. Huet, /Functional Pearl: The Zipper/,
+--      1997, J. Functional Programming 75(5):549-554.
+-- and:
+--      R. Hinze and J. Jeuring, /Functional Pearl: The Web/.
+--
+-- and Conor McBride's zipper differentiation paper.
+-- Another good reference is:
+--
+--      The Zipper, Haskell wikibook
+
+-- $xinerama
+-- Xinerama in X11 lets us view multiple virtual workspaces
+-- simultaneously. While only one will ever be in focus (i.e. will
+-- receive keyboard events), other workspaces may be passively
+-- viewable.  We thus need to track which virtual workspaces are
+-- associated (viewed) on which physical screens.  To keep track of
+-- this, 'StackSet' keeps separate lists of visible but non-focused
+-- workspaces, and non-visible workspaces.
+
+-- $focus
+--
+-- Each stack tracks a focused item, and for tiling purposes also tracks
+-- a 'master' position. The connection between 'master' and 'focus'
+-- needs to be well defined, particularly in relation to 'insert' and
+-- 'delete'.
+--
+
+------------------------------------------------------------------------
+-- |
+-- A cursor into a non-empty list of workspaces.
+--
+-- We puncture the workspace list, producing a hole in the structure
+-- used to track the currently focused workspace. The two other lists
+-- that are produced are used to track those workspaces visible as
+-- Xinerama screens, and those workspaces not visible anywhere.
+
+data StackSet i l a sid sd =
+    StackSet { current  :: !(Screen i l a sid sd)    -- ^ currently focused workspace
+             , visible  :: [Screen i l a sid sd]     -- ^ non-focused workspaces, visible in xinerama
+             } deriving (Show, Read, Eq)
+
+-- | Visible workspaces, and their Xinerama screens.
+data Screen i l a sid sd = Screen { screenWorkspace :: !(Workspace i l a)
+                                  , screenHidden :: [Workspace i l a]
+                                  , screen :: !sid
+                                  , screenDetail :: !sd }
+    deriving (Show, Read, Eq)
+
+-- |
+-- A workspace is just a tag, a layout, and a stack.
+--
+data Workspace i l a = Workspace  { tag :: !i, layout :: l, stack :: Maybe (Stack a) }
+    deriving (Show, Read, Eq)
+
+-- | A structure for window geometries
+data RationalRect = RationalRect Rational Rational Rational Rational
+    deriving (Show, Read, Eq)
+
+-- |
+-- A stack is a cursor onto a window list.
+-- The data structure tracks focus by construction, and
+-- the master window is by convention the top-most item.
+-- Focus operations will not reorder the list that results from
+-- flattening the cursor. The structure can be envisaged as:
+--
+-- >    +-- master:  < '7' >
+-- > up |            [ '2' ]
+-- >    +---------   [ '3' ]
+-- > focus:          < '4' >
+-- > dn +----------- [ '8' ]
+--
+-- A 'Stack' can be viewed as a list with a hole punched in it to make
+-- the focused position. Under the zipper\/calculus view of such
+-- structures, it is the differentiation of a [a], and integrating it
+-- back has a natural implementation used in 'index'.
+--
+data Stack a = Stack { focus  :: !a        -- focused thing in this set
+                     , up     :: [a]       -- clowns to the left
+                     , down   :: [a] }     -- jokers to the right
+    deriving (Show, Read, Eq)
+
+
+-- | this function indicates to catch that an error is expected
+abort :: String -> a
+abort x = error $ "metatile: StackSet: " ++ x
+
+-- ---------------------------------------------------------------------
+-- $construction
+
+-- | /O(n)/. Create a new stackset, of empty stacks, with given tags,
+-- with physical screens whose descriptions are given by 'm'. The
+-- number of physical screens (@length 'm'@) should be less than or
+-- equal to the number of workspace tags.  The first workspace in the
+-- list will be current.
+--
+-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
+--
+new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd
+new l wids m | not (null wids) && length m <= length wids && not (null m)
+  = StackSet cur visi
+  where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids
+        cur  = Screen (head seen) unseen 0 (head m)
+        visi = [ Screen i [] s sd |  (i, s, sd) <- zip3 (tail seen) [1..] (tail m) ]
+                -- now zip up visibles with their screen id
+new _ _ _ = abort "non-positive argument to StackSet.new"
+
+-- |
+-- /O(w)/. Set focus to the workspace with index \'i\'.
+-- If the index is out of range, return the original 'StackSet'.
+--
+-- Xinerama: If the workspace is not visible on any Xinerama screen, it
+-- becomes the current screen. If it is in the visible list, it becomes
+-- current.
+
+view :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
+view i s = s { current = head s', visible = tail s' }
+  where
+    s' = map makeVisible (current s : visible s)
+
+    makeVisible scr
+      | Just x <- L.find ((i==) . tag) (screenHidden scr) = scr { screenWorkspace = x, screenHidden = (screenWorkspace scr) : L.deleteBy ((==) `on` tag) x (screenHidden scr)}
+      | otherwise = scr
+
+    -- 'Catch'ing this might be hard. Relies on monotonically increasing
+    -- workspace tags defined in 'new'
+    --
+    -- and now tags are not monotonic, what happens here?
+
+-- |
+-- Set focus to the given workspace.  If that workspace does not exist
+-- in the stackset, the original workspace is returned.  If that workspace is
+-- 'hidden', then display that workspace on the current screen, and move the
+-- current workspace to 'hidden'.  If that workspace is 'visible' on another
+-- screen, the workspaces of the current screen and the other screen are
+-- swapped.
+
+greedyView :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
+{-greedyView w ws
+     | any wTag (hidden ws) = view w ws
+     | (Just s) <- L.find (wTag . workspace) (visible ws)
+                            = ws { current = (current ws) { workspace = workspace s }
+                                 , visible = s { workspace = workspace (current ws) }
+                                           : L.filter (not . wTag . workspace) (visible ws) }
+     | otherwise = ws
+   where wTag = (w == ) . tag-}
+greedyView = view
+
+-- ---------------------------------------------------------------------
+-- $xinerama
+
+-- | Find the tag of the workspace visible on Xinerama screen 'sc'.
+-- 'Nothing' if screen is out of bounds.
+lookupWorkspace :: Eq s => s -> StackSet i l a s sd -> Maybe i
+lookupWorkspace sc w = listToMaybe [ tag i | Screen i _ s _ <- current w : visible w, s == sc ]
+
+-- ---------------------------------------------------------------------
+-- $stackOperations
+
+-- |
+-- The 'with' function takes a default value, a function, and a
+-- StackSet. If the current stack is Nothing, 'with' returns the
+-- default value. Otherwise, it applies the function to the stack,
+-- returning the result. It is like 'maybe' for the focused workspace.
+--
+with :: b -> (Stack a -> b) -> StackSet i l a s sd -> b
+with dflt f = maybe dflt f . stack . screenWorkspace . current
+
+-- |
+-- Apply a function, and a default value for 'Nothing', to modify the current stack.
+--
+modify :: Maybe (Stack a) -> (Stack a -> Maybe (Stack a)) -> StackSet i l a s sd -> StackSet i l a s sd
+modify d f s = s { current = (current s)
+                        { screenWorkspace = (screenWorkspace (current s)) { stack = with d f s }}}
+
+-- |
+-- Apply a function to modify the current stack if it isn't empty, and we don't
+--  want to empty it.
+--
+modify' :: (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
+modify' f = modify Nothing (Just . f)
+
+-- |
+-- /O(1)/. Extract the focused element of the current stack.
+-- Return 'Just' that element, or 'Nothing' for an empty stack.
+--
+peek :: StackSet i l a s sd -> Maybe a
+peek = with Nothing (return . focus)
+
+-- |
+-- /O(n)/. Flatten a 'Stack' into a list.
+--
+integrate :: Stack a -> [a]
+integrate (Stack x l r) = reverse l ++ x : r
+
+-- |
+-- /O(n)/ Flatten a possibly empty stack into a list.
+integrate' :: Maybe (Stack a) -> [a]
+integrate' = maybe [] integrate
+
+-- |
+-- /O(n)/. Turn a list into a possibly empty stack (i.e., a zipper):
+-- the first element of the list is current, and the rest of the list
+-- is down.
+differentiate :: [a] -> Maybe (Stack a)
+differentiate []     = Nothing
+differentiate (x:xs) = Just $ Stack x [] xs
+
+-- |
+-- /O(n)/. 'filter p s' returns the elements of 's' such that 'p' evaluates to
+-- 'True'.  Order is preserved, and focus moves as described for 'delete'.
+--
+filter :: (a -> Bool) -> Stack a -> Maybe (Stack a)
+filter p (Stack f ls rs) = case L.filter p (f:rs) of
+    f':rs' -> Just $ Stack f' (L.filter p ls) rs'    -- maybe move focus down
+    []     -> case L.filter p ls of                  -- filter back up
+                    f':ls' -> Just $ Stack f' ls' [] -- else up
+                    []     -> Nothing
+
+-- |
+-- /O(s)/. Extract the stack on the current workspace, as a list.
+-- The order of the stack is determined by the master window -- it will be
+-- the head of the list. The implementation is given by the natural
+-- integration of a one-hole list cursor, back to a list.
+--
+index :: StackSet i l a s sd -> [a]
+index = with [] integrate
+
+-- |
+-- /O(1), O(w) on the wrapping case/.
+--
+-- focusUp, focusDown. Move the window focus up or down the stack,
+-- wrapping if we reach the end. The wrapping should model a 'cycle'
+-- on the current stack. The 'master' window, and window order,
+-- are unaffected by movement of focus.
+--
+-- swapUp, swapDown, swap the neighbour in the stack ordering, wrapping
+-- if we reach the end. Again the wrapping model should 'cycle' on
+-- the current stack.
+--
+focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd
+focusUp   = modify' focusUp'
+focusDown = modify' focusDown'
+
+swapUp    = modify' swapUp'
+swapDown  = modify' (reverseStack . swapUp' . reverseStack)
+
+-- | Variants of 'focusUp' and 'focusDown' that work on a
+-- 'Stack' rather than an entire 'StackSet'.
+focusUp', focusDown' :: Stack a -> Stack a
+focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)
+focusUp' (Stack t []     rs) = Stack x xs [] where (x:xs) = reverse (t:rs)
+focusDown'                   = reverseStack . focusUp' . reverseStack
+
+swapUp' :: Stack a -> Stack a
+swapUp'  (Stack t (l:ls) rs) = Stack t ls (l:rs)
+swapUp'  (Stack t []     rs) = Stack t (reverse rs) []
+
+-- | reverse a stack: up becomes down and down becomes up.
+reverseStack :: Stack a -> Stack a
+reverseStack (Stack t ls rs) = Stack t rs ls
+
+--
+-- | /O(1) on current window, O(n) in general/. Focus the window 'w',
+-- and set its workspace as current.
+--
+focusWindow :: (Eq s, Eq a, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
+focusWindow w s | Just w == peek s = s
+                | otherwise        = fromMaybe s $ do
+                    n <- findTag w s
+                    return $ until ((Just w ==) . peek) focusUp (view n s)
+
+-- | Get a list of all screens in the 'StackSet'.
+screens :: StackSet i l a s sd -> [Screen i l a s sd]
+screens s = current s : visible s
+
+-- | Get a list of all workspaces in the 'StackSet'.
+workspaces :: StackSet i l a s sd -> [Workspace i l a]
+workspaces s = concatMap screenWorkspaces $ (current s) : (visible s)
+
+screenWorkspaces :: Screen i l a sid sd -> [Workspace i l a]
+screenWorkspaces scr = screenWorkspace scr : screenHidden scr
+
+hidden :: StackSet i l a s sd -> [Workspace i l a]
+hidden = concatMap screenHidden . screens
+
+-- | Get a list of all windows in the 'StackSet' in no particular order
+allWindows :: Eq a => StackSet i l a s sd -> [a]
+allWindows = L.nub . concatMap (integrate' . stack) . workspaces
+
+-- | Get the tag of the currently focused workspace.
+currentTag :: StackSet i l a s sd -> i
+currentTag = tag . screenWorkspace . current
+
+-- | Is the given tag present in the 'StackSet'?
+tagMember :: Eq i => i -> StackSet i l a s sd -> Bool
+tagMember t = elem t . map tag . workspaces
+
+-- | Rename a given tag if present in the 'StackSet'.
+renameTag :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
+renameTag o n = mapWorkspace rename
+    where rename w = if tag w == o then w { tag = n } else w
+
+-- | Ensure that a given set of workspace tags is present by renaming
+-- existing workspaces and\/or creating new hidden workspaces as
+-- necessary.
+{-ensureTags :: Eq i => l -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
+ensureTags l allt st = et allt (map tag (workspaces st) \\ allt) st
+    where et [] _ s = s
+          et (i:is) rn s | i `tagMember` s = et is rn s
+          et (i:is) [] s = et is [] (s { hidden = Workspace i l Nothing : hidden s })
+          et (i:is) (r:rs) s = et is rs $ renameTag r i s-}
+
+-- | Map a function on all the workspaces in the 'StackSet'.
+mapWorkspace :: (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd
+mapWorkspace f s = s { current = updScr (current s)
+                     , visible = map updScr (visible s) }
+    where updScr scr = scr { screenWorkspace = f (screenWorkspace scr), screenHidden = map f (screenHidden scr) }
+
+-- | Map a function on all the layouts in the 'StackSet'.
+mapLayout :: (l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd
+mapLayout f (StackSet v vs) = StackSet (fScreen v) (map fScreen vs)
+ where
+    fScreen (Screen ws hd s sd) = Screen (fWorkspace ws) (map fWorkspace hd) s sd
+    fWorkspace (Workspace t l s) = Workspace t (f l) s
+
+-- | /O(n)/. Is a window in the 'StackSet'?
+member :: Eq a => a -> StackSet i l a s sd -> Bool
+member a s = isJust (findTag a s)
+
+-- | /O(1) on current window, O(n) in general/.
+-- Return 'Just' the workspace tag of the given window, or 'Nothing'
+-- if the window is not in the 'StackSet'.
+findTag :: Eq a => a -> StackSet i l a s sd -> Maybe i
+findTag a s = listToMaybe
+    [ tag w | w <- workspaces s, has a (stack w) ]
+    where has _ Nothing         = False
+          has x (Just (Stack t l r)) = x `elem` (t : l ++ r)
+
+-- ---------------------------------------------------------------------
+-- $modifyStackset
+
+-- |
+-- /O(n)/. (Complexity due to duplicate check). Insert a new element
+-- into the stack, above the currently focused element. The new
+-- element is given focus; the previously focused element is moved
+-- down.
+--
+-- If the element is already in the stackset, the original stackset is
+-- returned unmodified.
+--
+-- Semantics in Huet's paper is that insert doesn't move the cursor.
+-- However, we choose to insert above, and move the focus.
+--
+insertUp :: Eq a => a -> StackSet i l a s sd -> StackSet i l a s sd
+insertUp a s = if member a s then s else insert
+  where insert = modify (Just $ Stack a [] []) (\(Stack t l r) -> Just $ Stack a l (t:r)) s
+
+-- insertDown :: a -> StackSet i l a s sd -> StackSet i l a s sd
+-- insertDown a = modify (Stack a [] []) $ \(Stack t l r) -> Stack a (t:l) r
+-- Old semantics, from Huet.
+-- >    w { down = a : down w }
+
+-- |
+-- /O(1) on current window, O(n) in general/. Delete window 'w' if it exists.
+-- There are 4 cases to consider:
+--
+--   * delete on an 'Nothing' workspace leaves it Nothing
+--
+--   * otherwise, try to move focus to the down
+--
+--   * otherwise, try to move focus to the up
+--
+--   * otherwise, you've got an empty workspace, becomes 'Nothing'
+--
+-- Behaviour with respect to the master:
+--
+--   * deleting the master window resets it to the newly focused window
+--
+--   * otherwise, delete doesn't affect the master.
+--
+-- | Only temporarily remove the window from the stack, thereby not destroying special
+-- information saved in the 'Stackset'
+delete :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
+delete w s = mapWorkspace removeFromWorkspace s
+    where removeFromWorkspace ws = ws { stack = stack ws >>= filter (/=w) }
+
+------------------------------------------------------------------------
+
+-- | Given a window, and its preferred rectangle, set it as floating
+-- A floating window should already be managed by the 'StackSet'.
+--float :: Ord a => a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
+--float w r s = s { floating = M.insert w r (floating s) }
+
+-- | Clear the floating status of a window
+--sink :: Ord a => a -> StackSet i l a s sd -> StackSet i l a s sd
+--sink w s = s { floating = M.delete w (floating s) }
+
+------------------------------------------------------------------------
+-- $settingMW
+
+-- | /O(s)/. Set the master window to the focused window.
+-- The old master window is swapped in the tiling order with the focused window.
+-- Focus stays with the item moved.
+swapMaster :: StackSet i l a s sd -> StackSet i l a s sd
+swapMaster = modify' $ \c -> case c of
+    Stack _ [] _  -> c    -- already master.
+    Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls
+
+-- natural! keep focus, move current to the top, move top to current.
+
+-- | /O(s)/. Set the master window to the focused window.
+-- The other windows are kept in order and shifted down on the stack, as if you
+-- just hit mod-shift-k a bunch of times.
+-- Focus stays with the item moved.
+shiftMaster :: StackSet i l a s sd -> StackSet i l a s sd
+shiftMaster = modify' $ \c -> case c of
+    Stack _ [] _ -> c     -- already master.
+    Stack t ls rs -> Stack t [] (reverse ls ++ rs)
+
+-- | /O(s)/. Set focus to the master window.
+focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
+focusMaster = modify' $ \c -> case c of
+    Stack _ [] _  -> c
+    Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls
+
+--
+-- ---------------------------------------------------------------------
+-- $composite
+
+-- | /O(w)/. shift. Move the focused element of the current stack to stack
+-- 'n', leaving it as the focused element on that stack. The item is
+-- inserted above the currently focused element on that workspace.
+-- The actual focused workspace doesn't change. If there is no
+-- element on the current stack, the original stackSet is returned.
+--
+shift :: (Ord a, Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
+shift n s = maybe s (\w -> shiftWin n w s) (peek s)
+
+-- | /O(n)/. shiftWin. Searches for the specified window 'w' on all workspaces
+-- of the stackSet and moves it to stack 'n', leaving it as the focused
+-- element on that stack. The item is inserted above the currently
+-- focused element on that workspace.
+-- The actual focused workspace doesn't change. If the window is not
+-- found in the stackSet, the original stackSet is returned.
+shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
+shiftWin n w s = case findTag w s of
+                    Just from | n `tagMember` s && n /= from -> go from s
+                    _                                        -> s
+ where go from = onWorkspace n (insertUp w) . onWorkspace from (delete w)
+
+onWorkspace :: (Eq i, Eq s) => i -> (StackSet i l a s sd -> StackSet i l a s sd)
+            -> (StackSet i l a s sd -> StackSet i l a s sd)
+onWorkspace n f s = view (currentTag s) . f . view n $ s