[Xmonad] User-specified monad transformers

Donald Bruce Stewart dons at cse.unsw.edu.au
Fri Jun 1 01:12:49 EDT 2007


Extensions will likely need state, or other abilities, not provided
currently by the X monad core. 

One approach to solve this is to add a cheap symbol table to the XState
field, allowing extensions to stick their own modifiable global state.

A more intriguing, and perhaps, dangerous, idea, is to allow arbitrary
monad transformers to be specified by user contributions. The problem of
adding state then becomes a matter of defining a StateT transformer.

But it also opens up the option of using ReaderT for config values, or
even hmm, ContT for check pointing state (!). 

By default the outer monad would be IdentityT.

Downsides are unexplored, the main being:

    * how do you combine state, or monad state, from multiple extensions?

There are cheap solutions, as we see above, but the idea of user
customised monad transformers -- redefining the entire application's
behaviour -- is very tempting.

Here's the patch for user-specified UserT transformers, to ponder.

New patches:

[User-definable monad transformers: most general state/behaviour extension we can think of
Don Stewart <dons at cse.unsw.edu.au>**20070601050546] {
hunk ./Config.hs 30
+import IdentityT
hunk ./Config.hs 146
+------------------------------------------------------------------------
+
+-- default monad transformer to run xmonad in:
+type UserT = IdentityT
+
+-- default way to run the monad transformer
+runUserT :: Monad m => UserT m a -> m a
+runUserT = runIdentityT
+
+-- Example, user defined state:
+--      type UserT = StateT ()
+--      runUserT m = evalStateT m ()
+
hunk ./Config.hs-boot 2
+import IdentityT
hunk ./Config.hs-boot 8
+runUserT    :: Monad m => UserT m a -> m a
+type UserT = IdentityT
addfile ./IdentityT.hs
hunk ./IdentityT.hs 1
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Identity.hs
+-- Copyright   :  (c) Spencer Janssen 2007
+-- License     :  BSD3-style (see LICENSE)
+-- 
+-- Maintainer  :  dons at cse.unsw.edu.au
+-- Stability   :  stable
+-- Portability :  portable
+--
+module IdentityT where
+
+import Control.Monad.Trans
+
+--
+-- IdentityT , a parameterisable identity monad, with an inner monad
+-- The user's default monad transformer
+--
+
+newtype IdentityT m a = IdentityT { runIdentityT :: m a }
+
+instance (Functor m, Monad m) => Functor (IdentityT m) where
+    fmap f = IdentityT . fmap f . runIdentityT
+
+instance (Monad m) => Monad (IdentityT m) where
+    return   = IdentityT . return
+    m >>= k  = IdentityT $ runIdentityT . k =<< runIdentityT m
+    fail msg = IdentityT $ fail msg
+
+instance (MonadIO m) => MonadIO (IdentityT m) where
+    liftIO = IdentityT . liftIO
hunk ./XMonad.hs 24
+import {-# SOURCE #-} Config   (UserT, runUserT)
hunk ./XMonad.hs 73
-newtype X a = X (ReaderT XConf (StateT XState IO) a)
+newtype X a = X (ReaderT XConf (StateT XState (UserT IO)) a)
hunk ./XMonad.hs 79
-runX c st (X a) = runStateT (runReaderT a c) st >> return ()
+runX c st (X a) = runUserT (runStateT (runReaderT a c) st) >> return ()
}

Context:

[ignore numlock/capslock on mouse bindings
Jason Creighton <jcreigh at gmail.com>**20070601015137] 
[now we handle transients properly, and restack windows, refresh from focus is ok
Don Stewart <dons at cse.unsw.edu.au>**20070601022329] 
[Rename withWorkspace to withWindowSet.
glasser at mit.edu**20070601001325] 
[Revert accidental change to border color
Spencer Janssen <sjanssen at cse.unl.edu>**20070531145509] 
[comments on why fullscreen tiling doesn't work with `implicit' floating
Don Stewart <dons at cse.unsw.edu.au>**20070531090537] 
[clean up mouse code a bit
Don Stewart <dons at cse.unsw.edu.au>**20070531085308] 
[first shot at a floating layer
Jason Creighton <jcreigh at gmail.com>**20070531044733
 
 This is a first attempting at a floating layer:
 
 mod-button1: move window
 mod-button2: swapMaster
 mod-button3: resize window
 
 mod-t: make floating window tiled again
 
 Moving or resizing a window automatically makes it floating.
 
 Known issues:
 
 Hard to manage stacking order. You can promote a window to move it to the top,
 (which you can do with mod-button2) but it should be easier than that.
 
 Moving a window by dragging it to a different Xinerama screen does not move it
 to that workspace.
 
 Code is ugly.
] 
[remove LOC cap (but still print count after tests)
Jason Creighton <jcreigh at gmail.com>**20070531043417] 
[TAG 0.2
Spencer Janssen <sjanssen at cse.unl.edu>**20070531010004] 
Patch bundle hash:
864d7acd95d9f45379cef7d18919783971b243f0


More information about the Xmonad mailing list