summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDon Stewart <dons@galois.com>2007-10-14 01:21:50 +0200
committerDon Stewart <dons@galois.com>2007-10-14 01:21:50 +0200
commita175d7fbee65b22aec5f6e9dbf6d987dd040a44a (patch)
treec19cd31940cd8a98fe95d63fcfaa5cc15efd316f
parent2cdd0ccc222f5780c23765a93c4e477424aa77b0 (diff)
downloadmetatile-a175d7fbee65b22aec5f6e9dbf6d987dd040a44a.tar
metatile-a175d7fbee65b22aec5f6e9dbf6d987dd040a44a.zip
document, and use better names, for serialising/existential-dispatch framework
darcs-hash:20071013232150-cba2c-dc3ee2254f4ebdb5d0099ec0a38c5665f1ad4d3f
-rw-r--r--Operations.hs8
-rw-r--r--XMonad.hs25
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))