This is a massive update, here's what has changed:

* Read is no longer a superclass of Layout
 * All of the core layouts have moved to the new Layouts.hs module
 * Select has been replaced by the new statically typed Choose combinator,
   which is heavily based on David Roundy's NewSelect proposal for
   XMonadContrib.  Consequently:
    - Rather than a list of choosable layouts, we use the ||| combinator to
      combine several layouts into a single switchable layout
    - We've lost the capability to JumpToLayout and PrevLayout.  Both can be
      added with some effort

EventLoop.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  Main.hs
@@ -35,7 +36,8 @@ import Operations
 
 import System.IO
 
-data XMonadConfig l = XMonadConfig { normalBorderColor :: !String
+data XMonadConfig = forall l. (LayoutClass l Window, Read (l Window)) =>
+                        XMonadConfig { normalBorderColor :: !String
                                      , focusedBorderColor :: !String
                                      , defaultTerminal :: !String
                                      , layoutHook :: !(l Window)
@@ -50,7 +52,7 @@ data XMonadConfig l = XMonadConfig { normalBorderColor :: !String
 -- |
 -- The main entry point
 --
-makeMain :: LayoutClass l Window => XMonadConfig l -> IO ()
+makeMain :: XMonadConfig -> IO ()
 makeMain xmc = do
     dpy   <- openDisplay ""
     let dflt = defaultScreen dpy
@@ -62,17 +64,18 @@ makeMain xmc = do
     hSetBuffering stdout NoBuffering
     args <- getArgs
 
-    let initialWinset = new (Layout $ layoutHook xmc) (workspaces xmc) $ zipWith SD xinesc gaps
+    let (layout, lreads) = case xmc of XMonadConfig {layoutHook = lh } -> (Layout lh, \s -> [(Layout (x `asTypeOf` lh), s') | (x, s') <- reads s])
+        initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps
 
-        maybeRead s = case reads s of
+        maybeRead reads' s = case reads' s of
                                 [(x, "")] -> Just x
                                 _         -> Nothing
 
         winset = fromMaybe initialWinset $ do
                     ("--resume" : s : _) <- return args
-                    ws                   <- maybeRead s
+                    ws                   <- maybeRead reads s
-                    return . W.ensureTags (Layout $ layoutHook xmc) (workspaces xmc)
+                    return . W.ensureTags layout (workspaces xmc)
-                           $ W.mapLayout (fromMaybe (Layout $ layoutHook xmc) . maybeRead) ws
+                           $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
 
         gaps = take (length xinesc) $ defaultGaps xmc ++ repeat (0,0,0,0)
 
@@ -256,7 +259,7 @@ scan dpy rootw = do
                          && (wa_map_state wa == waIsViewable || ic)
 
 -- | Grab the keys back
-grabKeys :: XMonadConfig l -> X ()
+grabKeys :: XMonadConfig -> X ()
 grabKeys xmc = do
     XConf { display = dpy, theRoot = rootw } <- ask
     let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
@@ -268,7 +271,7 @@ grabKeys xmc = do
          when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) extraModifiers
 
 -- | XXX comment me
-grabButtons :: XMonadConfig l -> X ()
+grabButtons :: XMonadConfig -> X ()
 grabButtons xmc = do
     XConf { display = dpy, theRoot = rootw } <- ask
     let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask

Layouts.hs

@@ -0,0 +1,166 @@
+{-# OPTIONS_GHC -fglasgow-exts    #-} -- For deriving Data/Typeable
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+
+-- --------------------------------------------------------------------------
+-- |
+-- Module      :  Layouts.hs
+-- Copyright   :  (c) Spencer Janssen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  sjanssen@cse.unl.edu
+-- Stability   :  unstable
+-- Portability :  not portable, Typeable deriving, mtl, posix
+--
+-- The collection of core layouts.
+--
+-----------------------------------------------------------------------------
+
+module Layouts (ChangeLayout(..), Choose, (|||), Resize(..), IncMasterN(..),
+                Full(..), Tall(..), Mirror(..), splitVertically,
+                splitHorizontally, splitHorizontallyBy, splitVerticallyBy) where
+
+import XMonad
+
+import Graphics.X11 (Rectangle(..))
+import qualified StackSet as W
+import Control.Arrow ((***), second)
+import Control.Monad
+import Data.Maybe (fromMaybe)
+
+
+------------------------------------------------------------------------
+-- LayoutClass selection manager
+
+-- | A layout that allows users to switch between various layout options.
+
+-- | 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
+(|||) = flip SLeft
+infixr 5 |||
+
+data Choose l r a = SLeft  (r a) (l a)
+                  | SRight (l a) (r a) deriving (Read, Show)
+
+data NextNoWrap = NextNoWrap deriving (Eq, Show, Typeable)
+instance Message NextNoWrap
+
+-- This has lots of pseudo duplicated code, we must find a better way
+instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
+    doLayout (SLeft  r l) = (fmap (second . fmap $ SLeft r) .) . doLayout l
+    doLayout (SRight l r) = (fmap (second . fmap $ SRight l) .) . doLayout r
+
+    description (SLeft _ l)  = description l
+    description (SRight _ r) = description r
+
+    handleMessage lr m | Just FirstLayout <- fromMessage m = case lr of
+        SLeft {}   -> return Nothing
+        SRight l r -> fmap (Just . flip SLeft l . fromMaybe r) $ handleMessage r m
+
+    handleMessage lr m | Just NextLayout <- fromMessage m = do
+        mlr <- handleMessage lr $ SomeMessage NextNoWrap
+        maybe (handleMessage lr $ SomeMessage FirstLayout) (return . Just) mlr
+
+    handleMessage (SLeft r l) m | Just NextNoWrap <- fromMessage m = do
+        handleMessage l (SomeMessage Hide)
+        mr <- handleMessage r (SomeMessage FirstLayout)
+        return . Just . SRight l $ fromMaybe r mr
+
+    -- The default cases for left and right:
+    handleMessage (SLeft  r l) m = fmap (fmap $ SLeft  r) $ handleMessage l m
+    handleMessage (SRight l r) m = fmap (fmap $ SRight l) $ handleMessage r m
+
+--
+-- | Builtin layout algorithms:
+--
+-- > fullscreen mode
+-- > tall mode
+--
+-- The latter algorithms support the following operations:
+--
+-- >    Shrink
+-- >    Expand
+--
+data Resize     = Shrink | Expand   deriving Typeable
+
+-- | You can also increase the number of clients in the master pane
+data IncMasterN = IncMasterN Int    deriving Typeable
+
+instance Message Resize
+instance Message IncMasterN
+
+-- | Simple fullscreen mode, just render all windows fullscreen.
+data Full a = Full deriving (Show, Read)
+
+instance LayoutClass Full a
+
+-- | The inbuilt tiling mode of xmonad, and its operations.
+data Tall a = Tall Int Rational Rational deriving (Show, Read)
+
+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"
+
+-- | Mirror a rectangle
+mirrorRect :: Rectangle -> Rectangle
+mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
+
+-- | Mirror a layout, compute its 90 degree rotated form.
+data Mirror l a = Mirror (l a) deriving (Show, Read)
+
+instance LayoutClass l a => LayoutClass (Mirror l) a where
+    doLayout (Mirror l) r s = (map (second mirrorRect) *** fmap Mirror)
+                                `fmap` doLayout l (mirrorRect r) s
+    handleMessage (Mirror l) = fmap (fmap Mirror) . handleMessage l
+    description (Mirror l) = "Mirror "++ description l
+
+-- | tile.  Compute the positions for windows using the default 2 pane tiling algorithm.
+--
+-- The screen is divided (currently) 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 (by default, 1).
+-- the variable `nmaster' controls how many windows are rendered in the
+-- master pane.
+--
+-- `delta' specifies the ratio of the screen to resize by.
+--
+-- 'frac' specifies what proportion of the screen to devote to the
+-- master area.
+--
+tile :: Rational -> Rectangle -> Int -> Int -> [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.
+
+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
+
+splitVerticallyBy f = (mirrorRect *** mirrorRect) . splitHorizontallyBy f . mirrorRect

Main.hs

@@ -21,6 +21,7 @@ module Main where
 --
 import Control.Monad.Reader ( asks )
 import XMonad hiding ( logHook, borderWidth )
+import Layouts
 import Operations
 import qualified StackSet as W
 import Data.Ratio
@@ -128,14 +129,11 @@ manageHook _ _ _ _ = return id
 -- defaults, as xmonad preserves your old layout settings by default.
 --
 
--- | The list of possible layouts. Add your custom layouts to this list.
+-- | The available layouts.  Note that each layout is separated by |||, which
-layouts :: [Layout Window]
+-- denotes layout choice.
-layouts = [ Layout tiled
+layout = tiled ||| Mirror tiled ||| Full
-          , Layout $ Mirror tiled
-          , Layout Full
      -- Add extra layouts you want to use here:
      -- % Extension-provided layouts
-          ]
   where
      -- default tiling algorithm partitions the screen into two panes
      tiled   = Tall nmaster delta ratio
@@ -149,12 +147,6 @@ layouts = [ Layout tiled
      -- Percent of screen to increment by when resizing panes
      delta   = 3%100
 
--- | Register with xmonad a list of layouts whose state we can preserve over restarts.
--- There is typically no need to modify this list, the defaults are fine.
---
-serialisedLayouts :: [Layout Window]
-serialisedLayouts = Layout (layoutHook defaultConfig) : layouts
-
 ------------------------------------------------------------------------
 -- Key bindings:
 
@@ -171,7 +163,7 @@ keys = M.fromList $
     , ((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 $ layoutHook defaultConfig) -- %!  Reset the layouts on the current workspace to default
+    , ((modMask .|. shiftMask, xK_space ), setLayout $ Layout layout) -- %!  Reset the layouts on the current workspace to default
 
     , ((modMask,               xK_n     ), refresh) -- %! Resize viewed windows to the correct size
 
@@ -238,7 +230,7 @@ mouseBindings = M.fromList $
 
 -- % Extension-provided definitions
 
-defaultConfig :: XMonadConfig Select
+defaultConfig :: XMonadConfig
 defaultConfig = XMonadConfig { borderWidth = 1 -- Width of the window border in pixels.
                              , EventLoop.workspaces = workspaces
                              , defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
@@ -248,7 +240,7 @@ defaultConfig = XMonadConfig { borderWidth = 1 -- Width of the window border in
                              -- above, but you may program your own selection behaviour here. Layout
                              -- transformers, for example, would be hooked in here.
                              --
-                             , layoutHook = Select layouts
+                             , layoutHook = layout
                              , defaultTerminal = "xterm" -- The preferred terminal program.
                              , normalBorderColor = "#dddddd" -- Border color for unfocused windows.
                              , focusedBorderColor = "#ff0000" -- Border color for focused windows.

Main.hs-boot

@@ -4,4 +4,3 @@ import XMonad
 numlockMask :: KeyMask
 workspaces :: [WorkspaceId]
 manageHook :: Window -> String -> String -> String -> X (WindowSet -> WindowSet)
-serialisedLayouts :: [Layout Window]

Operations.hs

@@ -19,6 +19,7 @@
 module Operations where
 
 import XMonad
+import Layouts (Full(..))
 import qualified StackSet as W
 
 import Data.Maybe
@@ -37,7 +38,7 @@ import Graphics.X11.Xlib
 import Graphics.X11.Xinerama (getScreenInfo)
 import Graphics.X11.Xlib.Extras
 
-import {-# SOURCE #-} Main (manageHook,numlockMask,serialisedLayouts)
+import {-# SOURCE #-} Main (manageHook,numlockMask)
 
 -- ---------------------------------------------------------------------
 -- |
@@ -111,10 +112,6 @@ kill = withDisplay $ \d -> withFocused $ \w -> do
 -- ---------------------------------------------------------------------
 -- Managing windows
 
-data LayoutMessages = Hide | ReleaseResources deriving ( Typeable, Eq )
-
-instance Message LayoutMessages
-
 -- | windows. Modify the current window list with a pure function, and refresh
 windows :: (WindowSet -> WindowSet) -> X ()
 windows f = do
@@ -353,159 +350,6 @@ setLayout l = do
     handleMessage (W.layout ws) (SomeMessage ReleaseResources)
     windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = Layout l } } }
 
--- | X Events are valid Messages
-instance Message Event
-
-------------------------------------------------------------------------
--- LayoutClass selection manager
-
--- | A layout that allows users to switch between various layout options.
--- This layout accepts three Messages:
---
--- >    NextLayout
--- >    PrevLayout
--- >    JumpToLayout.
---
-data ChangeLayout = NextLayout | PrevLayout | JumpToLayout String
-                 deriving (Eq, Show, Typeable)
-
-instance Message ChangeLayout
-
-instance ReadableLayout Window where
-    readTypes = Layout (Select []) :
-                Layout Full : Layout (Tall 1 0.1 0.5) :
-                Layout (Mirror $ Tall 1 0.1 0.5) :
-                serialisedLayouts
-
-data Select a = Select [Layout a] deriving (Show, Read)
-
-instance ReadableLayout a => LayoutClass Select a where
-    doLayout (Select (l:ls)) r s =
-        second (fmap (Select . (:ls))) `fmap` doLayout l r s
-    doLayout (Select []) r s      =
-        second (const Nothing) `fmap` doLayout Full r s
-
-    -- respond to messages only when there's an actual choice:
-    handleMessage (Select (l:ls@(_:_))) m
-         | Just NextLayout       <- fromMessage m = switchl rls
-         | Just PrevLayout       <- fromMessage m = switchl rls'
-         | Just (JumpToLayout x) <- fromMessage m = switchl (j x)
-         | Just ReleaseResources <- fromMessage m = do -- each branch has a different type
-                 mlls' <- mapM (flip handleMessage m) (l:ls)
-                 let lls' = zipWith fromMaybe (l:ls) mlls'
-                 return (Just (Select lls'))
-
-        where rls []     = []
-              rls (x:xs) = xs ++ [x]
-              rls' = reverse . rls . reverse
-
-              j s zs = case partition ((s ==) . description) zs of (xs,ys) -> xs++ys
-
-              switchl f = do ml' <- handleMessage l (SomeMessage Hide)
-                             return $ Just (Select $ f $ fromMaybe l ml':ls)
-
-    -- otherwise, or if we don't understand the message, pass it along to the real layout:
-    handleMessage (Select (l:ls)) m =
-       fmap (Select . (:ls)) `fmap` handleMessage l m
-
-    -- Unless there is no layout...
-    handleMessage (Select []) _ = return Nothing
-
-    description (Select (x:_)) = description x
-    description _              = "default"
-
---
--- | Builtin layout algorithms:
---
--- > fullscreen mode
--- > tall mode
---
--- The latter algorithms support the following operations:
---
--- >    Shrink
--- >    Expand
---
-data Resize     = Shrink | Expand   deriving Typeable
-
--- | You can also increase the number of clients in the master pane
-data IncMasterN = IncMasterN Int    deriving Typeable
-
-instance Message Resize
-instance Message IncMasterN
-
--- | Simple fullscreen mode, just render all windows fullscreen.
-data Full a = Full deriving (Show, Read)
-
-instance LayoutClass Full a
-
--- | The inbuilt tiling mode of xmonad, and its operations.
-data Tall a = Tall Int Rational Rational deriving (Show, Read)
-
-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"
-
--- | Mirror a rectangle
-mirrorRect :: Rectangle -> Rectangle
-mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
-
--- | Mirror a layout, compute its 90 degree rotated form.
-data Mirror l a = Mirror (l a) deriving (Show, Read)
-
-instance LayoutClass l a => LayoutClass (Mirror l) a where
-    doLayout (Mirror l) r s = (map (second mirrorRect) *** fmap Mirror)
-                                `fmap` doLayout l (mirrorRect r) s
-    handleMessage (Mirror l) = fmap (fmap Mirror) . handleMessage l
-    description (Mirror l) = "Mirror "++ description l
-
--- | tile.  Compute the positions for windows using the default 2 pane tiling algorithm.
---
--- The screen is divided (currently) 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 (by default, 1).
--- the variable `nmaster' controls how many windows are rendered in the
--- master pane.
---
--- `delta' specifies the ratio of the screen to resize by.
---
--- 'frac' specifies what proportion of the screen to devote to the
--- master area.
---
-tile :: Rational -> Rectangle -> Int -> Int -> [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.
-
-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
-
--- | XXX comment me
-splitVerticallyBy f = (mirrorRect *** mirrorRect) . splitHorizontallyBy f . mirrorRect
-
 ------------------------------------------------------------------------
 -- Utilities
 

XMonad.hs

@@ -16,8 +16,8 @@
 -----------------------------------------------------------------------------
 
 module XMonad (
-    X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), LayoutClass(..), Layout(..), ReadableLayout(..),
+    X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), LayoutClass(..), Layout(..),
-    Typeable, Message, SomeMessage(..), fromMessage, runLayout,
+    Typeable, Message, SomeMessage(..), fromMessage, runLayout, LayoutMessages(..),
     runX, catchX, userCode, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX,
     atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
   ) where
@@ -28,14 +28,12 @@ import Prelude hiding ( catch )
 import Control.Exception (catch, throw, Exception(ExitException))
 import Control.Monad.State
 import Control.Monad.Reader
-import Control.Arrow (first)
 import System.IO
 import System.Posix.Process (executeFile, forkProcess, getProcessStatus, createSession)
 import System.Exit
 import System.Environment
 import Graphics.X11.Xlib
--- for Read instance
+import Graphics.X11.Xlib.Extras (Event)
-import Graphics.X11.Xlib.Extras ()
 import Data.Typeable
 
 import qualified Data.Map as M
@@ -135,14 +133,9 @@ atom_WM_STATE           = getAtom "WM_STATE"
 -- | LayoutClass handling. See particular instances in Operations.hs
 
 -- | An existential type that can hold any object that is in the LayoutClass.
-data Layout a = forall l. LayoutClass l a => Layout (l a)
+data Layout a = forall l. (LayoutClass l a) => Layout (l a)
 
 
--- | This class defines a set of layout types (held in Layout
---  objects) that are used when trying to read an existentially wrapped Layout.
-class ReadableLayout a where
-    readTypes :: [Layout a]
-
 -- | The different layout modes
 --
 -- 'doLayout': given a Rectangle and a Stack, layout the stack elements
@@ -150,7 +143,7 @@ class ReadableLayout a where
 -- by 'doLayout', then it is not shown on screen.  Windows are restacked
 -- according to the order they are returned by 'doLayout'.
 --
-class (Show (layout a), Read (layout a)) => LayoutClass layout a where
+class Show (layout a) => LayoutClass layout a where
 
     -- | Given a Rectangle in which to place the windows, and a Stack of
     -- windows, return a list of windows and their corresponding Rectangles.
@@ -184,22 +177,7 @@ class (Show (layout a), Read (layout a)) => LayoutClass layout a where
     description :: layout a -> String
     description      = show
 
--- Here's the magic for parsing serialised state of existentially
+instance LayoutClass Layout Window where
--- wrapped layouts: attempt to parse using the Read instance from each
--- type in our list of types, if any suceed, take the first one.
-instance ReadableLayout a => Read (Layout a) where
-
-    -- We take the first parse only, because multiple matches indicate a bad parse.
-    readsPrec _ s = take 1 $ concatMap readLayout readTypes
-        where
-            readLayout (Layout x) = map (first Layout) $ readAsType x
-
-            -- the type indicates which Read instance to dispatch to.
-            -- That is, read asTypeOf the argument from the readTypes.
-            readAsType :: LayoutClass l a => l a -> [(l a, String)]
-            readAsType _ = reads s
-
-instance ReadableLayout a => LayoutClass Layout a where
     doLayout (Layout l) r s  = fmap (fmap Layout) `liftM` doLayout l r s
     handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l
     description (Layout l)   = description l
@@ -229,6 +207,17 @@ data SomeMessage = forall a. Message a => SomeMessage a
 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
+
 -- ---------------------------------------------------------------------
 -- | General utilities
 --

tests/Properties.hs

@@ -3,7 +3,6 @@ module Properties where
 
 import StackSet hiding (filter)
 import qualified StackSet as S (filter)
-import Operations (tile)
 
 import Debug.Trace
 import Data.Word

xmonad.cabal

@@ -23,7 +23,7 @@ extra-source-files: README TODO tests/loc.hs tests/Properties.hs man/xmonad.1.in
 
 executable:         xmonad
 main-is:            Main.hs
-other-modules:      EventLoop Operations StackSet XMonad
+other-modules:      EventLoop Layouts Operations StackSet XMonad
 ghc-options:        -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s
 ghc-prof-options:   -prof -auto-all
 extensions:         GeneralizedNewtypeDeriving