From b01dc05c971408a6484bb347e4822880dae55db3 Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@cse.unsw.edu.au>
Date: Wed, 7 Mar 2007 04:03:51 +0100
Subject: comments, rename 'l' to 'io', and state explicitly that we use
 GeneralizedNewtypeDeriving

darcs-hash:20070307030351-9c5c1-1bdd8f6be37c4e1fa30aaed0af13ee00790cb8b4
---
 Wm.hs | 35 ++++++++++++++++++++++++-----------
 1 file changed, 24 insertions(+), 11 deletions(-)

(limited to 'Wm.hs')

diff --git a/Wm.hs b/Wm.hs
index 542f66f..c95648d 100644
--- a/Wm.hs
+++ b/Wm.hs
@@ -1,4 +1,17 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Wm.hs
+-- Copyright   :  (c) Spencer Janssen 2007
+-- License     :  BSD3-style (see LICENSE)
+-- 
+-- Maintainer  :  sjanssen@cse.unl.edu
+-- Stability   :  unstable
+-- Portability :  not portable, uses cunning newtype deriving
+--
+-----------------------------------------------------------------------------
+--
+-- The Wm monad, a state monad transformer over IO, for the window manager state.
+--
 
 module Wm where
 
@@ -7,12 +20,12 @@ import Control.Monad.State
 import System.IO (hFlush, hPutStrLn, stderr)
 import Graphics.X11.Xlib
 
-data WmState = WmState 
-                { display :: Display
-                , screenWidth :: Int
-                , screenHeight :: Int
-                , windows :: Seq Window
-                }
+data WmState = WmState
+    { display       :: Display
+    , screenWidth   :: !Int
+    , screenHeight  :: !Int
+    , windows       :: Seq Window
+    }
 
 newtype Wm a = Wm (StateT WmState IO a)
     deriving (Monad, MonadIO{-, MonadState WmState-})
@@ -20,17 +33,17 @@ newtype Wm a = Wm (StateT WmState IO a)
 runWm :: Wm a -> WmState -> IO (a, WmState)
 runWm (Wm m) = runStateT m
 
-l :: IO a -> Wm a
-l = liftIO
+io :: IO a -> Wm a
+io = liftIO
 
-trace msg = l $ do
+trace msg = io $ do
     hPutStrLn stderr msg
     hFlush stderr
 
 withIO :: (forall b. (a -> IO b) -> IO b) -> (a -> Wm c) -> Wm c
 withIO f g = do
     s <- Wm get
-    (y, s') <- l $ f $ \x -> runWm (g x) s
+    (y, s') <- io $ f $ \x -> runWm (g x) s
     Wm (put s')
     return y
 
-- 
cgit v1.2.3