From a175d7fbee65b22aec5f6e9dbf6d987dd040a44a Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@galois.com>
Date: Sun, 14 Oct 2007 01:21:50 +0200
Subject: document, and use better names, for serialising/existential-dispatch
 framework

darcs-hash:20071013232150-cba2c-dc3ee2254f4ebdb5d0099ec0a38c5665f1ad4d3f
---
 Operations.hs |  8 ++++----
 XMonad.hs     | 25 ++++++++++++++++---------
 2 files changed, 20 insertions(+), 13 deletions(-)

diff --git a/Operations.hs b/Operations.hs
index 0edfbb9..5b3bb2d 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -369,10 +369,10 @@ data ChangeLayout = NextLayout | PrevLayout | JumpToLayout String
 instance Message ChangeLayout
 
 instance ReadableLayout Window where
-    defaults = Layout (Select []) :
-               Layout Full : Layout (Tall 1 0.1 0.5) :
-               Layout (Mirror $ Tall 1 0.1 0.5) :
-               serialisedLayouts
+    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)
 
diff --git a/XMonad.hs b/XMonad.hs
index 248a578..ca8a32c 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -134,10 +134,11 @@ atom_WM_STATE           = getAtom "WM_STATE"
 -- | An existential type that can hold any object that is in the LayoutClass.
 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
-    defaults :: [Layout a]
+    readTypes :: [Layout a]
 
 -- | The different layout modes
 --
@@ -180,21 +181,27 @@ 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
+-- 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
-    readsPrec _ s = take 1 $ concatMap rl defaults
-                  -- We take the first parse only, because multiple matches
-                  -- indicate a bad parse.
-        where rl (Layout x) = map (first Layout) $ rl' x
-              rl' :: LayoutClass l a => l a -> [(l a,String)]
-              rl' _ = reads s
+
+    -- 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
 
-instance Show (Layout a) where
-    show (Layout l) = show l
+instance Show (Layout a) where show (Layout l) = show l
 
 -- | This calls doLayout if there are any windows to be laid out.
 runLayout :: LayoutClass l a => l a -> Rectangle -> StackOrNot a -> X ([(a, Rectangle)], Maybe (l a))
-- 
cgit v1.2.3