From 9e88d56b03ceaf63709cbbc7bda3f20c9a1a3320 Mon Sep 17 00:00:00 2001
From: Spencer Janssen <sjanssen@cse.unl.edu>
Date: Thu, 1 Nov 2007 09:21:55 +0100
Subject: Add readsLayout, remove the existential from XConfig

darcs-hash:20071101082155-a5988-82be25ec6b35cb1d39e0613b3d810dfd75836098
---
 EventLoop.hs  |  3 ++-
 Main.hs       |  2 +-
 Operations.hs |  4 ++--
 XMonad.hs     | 37 +++++++++++++++++++------------------
 4 files changed, 24 insertions(+), 22 deletions(-)

diff --git a/EventLoop.hs b/EventLoop.hs
index 9866287..24680f2 100644
--- a/EventLoop.hs
+++ b/EventLoop.hs
@@ -50,7 +50,8 @@ makeMain xmc = do
     hSetBuffering stdout NoBuffering
     args <- getArgs
 
-    let (layout, lreads) = case xmc of XConfig {layoutHook = lh } -> (Layout lh, \s -> [(Layout (x `asTypeOf` lh), s') | (x, s') <- reads s])
+    let layout = layoutHook xmc
+        lreads = readsLayout layout
         initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps
 
         maybeRead reads' s = case reads' s of
diff --git a/Main.hs b/Main.hs
index e228ee4..47de7d1 100644
--- a/Main.hs
+++ b/Main.hs
@@ -240,7 +240,7 @@ defaultConfig = XConfig { borderWidth = 1 -- Width of the window border in pixel
                         -- above, but you may program your own selection behaviour here. Layout
                         -- transformers, for example, would be hooked in here.
                         --
-                        , layoutHook = layout
+                        , layoutHook = Layout layout
                         , terminal = "xterm" -- The preferred terminal program.
                         , normalBorderColor = "#dddddd" -- Border color for unfocused windows.
                         , focusedBorderColor = "#ff0000" -- Border color for focused windows.
diff --git a/Operations.hs b/Operations.hs
index ae6d8e1..b911cf5 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -342,11 +342,11 @@ runOnWorkspaces job =do
     modify $ \s -> s { windowset = ws { W.current = c, W.visible = v, W.hidden = h } }
 
 -- | Set the layout of the currently viewed workspace
-setLayout :: LayoutClass l Window => l Window -> X ()
+setLayout :: Layout Window -> X ()
 setLayout l = do
     ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset
     handleMessage (W.layout ws) (SomeMessage ReleaseResources)
-    windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = Layout l } } }
+    windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }
 
 ------------------------------------------------------------------------
 -- Utilities
diff --git a/XMonad.hs b/XMonad.hs
index 6fcf6c1..7428c2f 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -16,8 +16,7 @@
 -----------------------------------------------------------------------------
 
 module XMonad (
-    X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), XConfig(..), LayoutClass(..), Layout(..),
-    Typeable, Message, SomeMessage(..), fromMessage, runLayout, LayoutMessages(..),
+    X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), XConfig(..), LayoutClass(..), Layout(..), readsLayout, 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
@@ -55,20 +54,18 @@ data XConf = XConf
     , focusedBorder :: !Pixel     }   -- ^ border color of the focused window
 
 -- todo, better name
-data XConfig = forall l. (LayoutClass l Window, Read (l Window)) =>
-                        XConfig { normalBorderColor :: !String
-                                     , focusedBorderColor :: !String
-                                     , terminal :: !String
-                                     , layoutHook :: !(l Window)
-                                     , manageHook :: Window -> String -> String -> String -> X (WindowSet -> WindowSet)
-                                     , workspaces :: ![String]
-                                     , defaultGaps :: ![(Int,Int,Int,Int)]
-                                     , numlockMask :: KeyMask
-                                     , keys :: !(M.Map (ButtonMask,KeySym) (X ()))
-                                     , mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
-                                     , borderWidth :: !Dimension
-                                     , logHook :: !(X ())
-                                     }
+data XConfig = XConfig { normalBorderColor :: !String
+                       , focusedBorderColor :: !String
+                       , terminal :: !String
+                       , layoutHook :: !(Layout Window)
+                       , manageHook :: !(Window -> String -> String -> String -> X (WindowSet -> WindowSet))
+                       , workspaces :: ![String]
+                       , defaultGaps :: ![(Int,Int,Int,Int)]
+                       , numlockMask :: KeyMask
+                       , keys :: !(M.Map (ButtonMask,KeySym) (X ()))
+                       , mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
+                       , borderWidth :: !Dimension
+                       , logHook :: !(X ()) }
 
 type WindowSet   = StackSet  WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 type WindowSpace = Workspace WorkspaceId (Layout Window) Window
@@ -147,9 +144,13 @@ 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)
+-- | 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]
 
 -- | The different layout modes
 --
-- 
cgit v1.2.3