[Xmonad] Constrained dynamically extensible layout events: a patch

Donald Bruce Stewart dons at cse.unsw.edu.au
Fri May 4 04:03:05 EDT 2007


David, Spencer et al, are there any problems with restricting layoutMsg
arguments to being members of the (open) Message class? I'd (strongly)
prefer this over just Dynamic, since it restores most of the static
checking we'd need. 

The only change for something like Mosaic would be to add the mosaic
events to Message, with instance Message MyType, and to switch layoutMsg
to sendMessage (its our 'throw' for dynamically extensible messages, in
fact).

The idea of constrained extensible messages is from SimonM's 06 HW paper
on extensible exceptions.

Comments?

-- Don


New patches:

[Constrain layout messages to be members of a Message class
Don Stewart <dons at cse.unsw.edu.au>**20070504075233
 
 Using Typeables as the only constraint on layout messages is a bit
 scary, as a user can send arbitrary values to layoutMsg, whether they
 make sense or not: there's basically no type feedback on the values you
 supply to layoutMsg.
 
 Folloing Simon Marlow's dynamically extensible exceptions paper, we use
 an existential type, and a Message type class, to constrain valid
 arguments to layoutMsg to be valid members of Message.
 
 That is, a user writes some data type for messages their layout
 algorithm accepts:
 
     data MyLayoutEvent = Zoom
                        | Explode
                        | Flaming3DGlassEffect
                        deriving (Typeable)
 
 and they then add this to the set of valid message types:
 
     instance Message MyLayoutEvent
 
 Done. We also reimplement the dynamic type check while we're here, to
 just directly use 'cast', rather than expose a raw fromDynamic/toDyn.
 
 With this, I'm much happier about out dynamically extensible layout
 event subsystem.
 
] {
hunk ./Config.hs 157
-    , ((modMask,               xK_h     ), layoutMsg Shrink)
-    , ((modMask,               xK_l     ), layoutMsg Expand)
+    , ((modMask,               xK_h     ), sendMessage Shrink)
+    , ((modMask,               xK_l     ), sendMessage Expand)
hunk ./Operations.hs 19
-import Data.Dynamic ( Typeable, toDyn, fromDynamic )
hunk ./Operations.hs 77
+-- | Throw an (extensible) message value to the current Layout scheme,
+-- possibly modifying how we layout the windows, then refresh.
hunk ./Operations.hs 80
--- TODO, using Typeable for extensible stuff is a bit gunky. Check --
--- 'extensible exceptions' paper for other ideas.
+-- TODO, this will refresh on Nothing.
hunk ./Operations.hs 82
--- Basically this thing specifies the basic operations that vary between
--- layouts.
---
-data ShrinkOrExpand = Shrink | Expand deriving (Typeable, Eq)
-
-layoutMsg :: Typeable a => a -> X () -- FIXME: The below shouldn't refresh on Nothing
-layoutMsg a = layout $ \x@(l:ls) -> maybe x (:ls) (modifyLayout l (toDyn a))
+sendMessage :: Message a => a -> X ()
+sendMessage m = layout $ \xs -> case xs of
+    []     -> []
+    (l:ls) -> maybe xs (:ls) $ modifyLayout l (SomeMessage m)
hunk ./Operations.hs 87
+------------------------------------------------------------------------
hunk ./Operations.hs 89
--- Standard layout algorithms:
+-- Builtin layout algorithms:
hunk ./Operations.hs 94
+-- 
+-- The latter algorithms support the following operations:
hunk ./Operations.hs 97
-full :: Layout
-tall, wide :: Rational -> Rational -> Layout
+--      Shrink
+--      Expand
+--
+
+data Resize = Shrink | Expand deriving (Typeable, Show)
+instance Message Resize
hunk ./Operations.hs 104
-full            = Layout { doLayout     = \sc ws -> [ (w,sc) | w <- ws ]
-                         , modifyLayout = const Nothing }
+full :: Layout
+full = Layout { doLayout     = \sc ws -> [ (w,sc) | w <- ws ]
+              , modifyLayout = const Nothing } -- no changes
hunk ./Operations.hs 108
+tall, wide :: Rational -> Rational -> Layout
hunk ./Operations.hs 112
-                         , modifyLayout = fmap f . fromDynamic }
+                         , modifyLayout = fmap handler . fromMessage }
hunk ./Operations.hs 114
-    where f s = tall delta ((op s) frac delta)
-          op Shrink = (-) ; op Expand = (+)
+    where handler s = tall delta $ (case s of
+                                    Shrink -> (-)
+                                    Expand -> (+)) frac delta
hunk ./XMonad.hs 20
+    Typeable, Message, SomeMessage(..), fromMessage,
hunk ./XMonad.hs 32
-import Data.Dynamic ( Dynamic )
+import Data.Typeable
hunk ./XMonad.hs 40
-    , layouts           :: !(M.Map WorkspaceId [Layout])   -- ^ mapping of workspaces 
+    , layouts           :: !(M.Map WorkspaceId [Layout]) } -- ^ mapping of workspaces 
hunk ./XMonad.hs 42
-    }
hunk ./XMonad.hs 54
-    , focusedBorder     :: !Color       -- ^ border color of the focused window
-    }
+    , focusedBorder     :: !Color     } -- ^ border color of the focused window
hunk ./XMonad.hs 96
--- 'doLayout', a pure function to layout a Window set
--- 'modifyLayout', 
+-- 'doLayout', a pure function to layout a Window set 'modifyLayout', 
+-- 'modifyLayout' can be considered a branch of an exception handler.
+--
hunk ./XMonad.hs 100
-                     , modifyLayout :: Dynamic -> Maybe Layout }
+                     , modifyLayout :: SomeMessage -> Maybe Layout }
+
+-- Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/,
+-- Simon Marlow, 2006. Use extensible messages to the modifyLayout handler.
+-- 
+-- User-extensible messages must be a member of this class:
+--
+class (Typeable a, Show 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
}

Context:

[refactoring, style, comments on new layout code
Don Stewart <dons at cse.unsw.edu.au>**20070504023618] 
[use anyKey constant instead of magic number
Jason Creighton <jcreigh at gmail.com>**20070504015043] 
[added mirrorLayout to mirror arbitrary layouts
Jason Creighton <jcreigh at gmail.com>**20070504014653] 
[Fix layout switching order
Spencer Janssen <sjanssen at cse.unl.edu>**20070503235632] 
[More Config.hs bugs
Spencer Janssen <sjanssen at cse.unl.edu>**20070503234607] 
[Revert accidental change to Config.hs
Spencer Janssen <sjanssen at cse.unl.edu>**20070503233148] 
[Add -fglasgow-exts for pattern guards.  Properties.hs doesn't complain anymore
Spencer Janssen <sjanssen at cse.unl.edu>**20070503214221] 
[Avoid the unsafe pattern match, in case Config.hs has no layouts
Spencer Janssen <sjanssen at cse.unl.edu>**20070503214007] 
[add support for extensible layouts.
David Roundy <droundy at darcs.net>**20070503144750] 
[comments. and stop tracing events to stderr
Don Stewart <dons at cse.unsw.edu.au>**20070503075821] 
[-Wall police
Don Stewart <dons at cse.unsw.edu.au>**20070503074937] 
[elaborate documentation in Config.hs
Don Stewart <dons at cse.unsw.edu.au>**20070503074843] 
[Use updated refreshKeyboardMapping.  Requires latest X11-extras
Spencer Janssen <sjanssen at cse.unl.edu>**20070503032040] 
[run QC tests in addition to LOC test
Jason Creighton <jcreigh at gmail.com>**20070503003202] 
[Add 'mod-n': refreshes current layout
Spencer Janssen <sjanssen at cse.unl.edu>**20070503002252] 
[Fix tests after StackSet changes
Spencer Janssen <sjanssen at cse.unl.edu>**20070502201622] 
[First steps to adding floating layer
Spencer Janssen <sjanssen at cse.unl.edu>**20070502195917] 
[update motivational text using xmonad.org
Don Stewart <dons at cse.unsw.edu.au>**20070502061859] 
[Sort dependencies in installation order
Spencer Janssen <sjanssen at cse.unl.edu>**20070501204249] 
[Recommend X11-extras 0.1
Spencer Janssen <sjanssen at cse.unl.edu>**20070501204121] 
[elaborate description in .cabal
Don Stewart <dons at cse.unsw.edu.au>**20070501035414] 
[use -fasm by default. Much faster
Don Stewart <dons at cse.unsw.edu.au>**20070501031220] 
[Make border width configurable
Spencer Janssen <sjanssen at cse.unl.edu>**20070430163515] 
[Add Config.hs-boot, remove defaultLayoutDesc from XConf
Spencer Janssen <sjanssen at cse.unl.edu>**20070430162647] 
[Comment only
Spencer Janssen <sjanssen at cse.unl.edu>**20070430161635] 
[Comment only
Spencer Janssen <sjanssen at cse.unl.edu>**20070430161511] 
[check we never generate invalid stack sets
Don Stewart <dons at cse.unsw.edu.au>**20070430065946] 
[view n . shift n . view i . shift i) x == x --> shift + view is invertible
Don Stewart <dons at cse.unsw.edu.au>**20070430062901] 
[add rotate all and view idempotency tests
Don Stewart <dons at cse.unsw.edu.au>**20070430055751] 
[Add XConf for values that don't change.
Spencer Janssen <sjanssen at cse.unl.edu>**20070430054715] 
[Control.Arrow is suspicious, add an explicit import
Spencer Janssen <sjanssen at cse.unl.edu>**20070430053623] 
[push is idempotent
Don Stewart <dons at cse.unsw.edu.au>**20070430054345] 
[add two properties relating to empty window managers
Don Stewart <dons at cse.unsw.edu.au>**20070430051016] 
[configurable border colors
Jason Creighton <jcreigh at gmail.com>**20070430043859
 This also fixes a bug where xmonad was assuming a 24-bit display, and just
 using, eg, 0xff0000 as an index into a colormap without querying the X server
 to determine the proper pixel value for "red".
] 
[new QC property: opening a window only affects the current screen
Don Stewart <dons at cse.unsw.edu.au>**20070430050133] 
[a bit more precise about building non-empty stacksets for one test
Don Stewart <dons at cse.unsw.edu.au>**20070430035729] 
[remove redundant call to 'delete' in 'shift'
Don Stewart <dons at cse.unsw.edu.au>**20070430031151] 
[clean 'delete' a little
Don Stewart <dons at cse.unsw.edu.au>**20070430025319] 
[shrink 'swap'
Don Stewart <dons at cse.unsw.edu.au>**20070430024813] 
[shrink 'rotate' a little
Don Stewart <dons at cse.unsw.edu.au>**20070430024525] 
[move size into Properties.hs
Don Stewart <dons at cse.unsw.edu.au>**20070430021758] 
[don't need 'size' operation on StackSet
Don Stewart <dons at cse.unsw.edu.au>**20070430015927] 
[avoid grabbing all keys when a keysym is undefined
Jason Creighton <jcreigh at gmail.com>**20070428180046
 XKeysymToKeycode() returns zero if the keysym is undefined. Zero also happens
 to be the value of AnyKey.
] 
[add homepage: field to .cabal file
Don Stewart <dons at cse.unsw.edu.au>**20070429041011] 
[add fromList to Properties.hs
Don Stewart <dons at cse.unsw.edu.au>**20070429035823] 
[move fromList into Properties.hs, -17 loc
Don Stewart <dons at cse.unsw.edu.au>**20070429035804] 
[Further refactoring
Spencer Janssen <sjanssen at cse.unl.edu>**20070426212257] 
[Refactor in Config.hs (no real changes)
Spencer Janssen <sjanssen at cse.unl.edu>**20070426211407] 
[Add the manpage to extra-source-files
Spencer Janssen <sjanssen at cse.unl.edu>**20070426014105] 
[add xmonad manpage
David Lazar <davidlazar at styso.com>**20070426010812] 
[Remove toList
Spencer Janssen <sjanssen at cse.unl.edu>**20070426005713] 
[Ignore numlock and capslock in keybindings
Jason Creighton <jcreigh at gmail.com>**20070424013357] 
[Clear numlock bit
Spencer Janssen <sjanssen at cse.unl.edu>**20070424010352] 
[force window border to 1px
Jason Creighton <jcreigh at gmail.com>**20070423050824] 
[s/creigh//
Don Stewart <dons at cse.unsw.edu.au>**20070423024026] 
[some other things to do
Don Stewart <dons at cse.unsw.edu.au>**20070423023151] 
[Start TODOs for 0.2
Spencer Janssen <sjanssen at cse.unl.edu>**20070423021526] 
[update readme
Don Stewart <dons at cse.unsw.edu.au>**20070422090507] 
[TAG 0.1
Spencer Janssen <sjanssen at cse.unl.edu>**20070422083033] 
Patch bundle hash:
58f3c7c9b1d98e93c2a0aa388fd91f7ee5567446


More information about the Xmonad mailing list