diff options
| author | Don Stewart <dons@cse.unsw.edu.au> | 2007-03-07 04:03:51 +0100 |
|---|---|---|
| committer | Don Stewart <dons@cse.unsw.edu.au> | 2007-03-07 04:03:51 +0100 |
| commit | 1e225b38a7303ebda37201e75ea0e69d8c99b4a2 (patch) | |
| tree | 7799fc85001e282f4e17f15cfe14cd461a7ad5df /Wm.hs | |
| parent | 67073d7595370f2e93158003f4d13031b5c64ee3 (diff) | |
| download | xmonad-1e225b38a7303ebda37201e75ea0e69d8c99b4a2.tar.gz xmonad-1e225b38a7303ebda37201e75ea0e69d8c99b4a2.tar.xz xmonad-1e225b38a7303ebda37201e75ea0e69d8c99b4a2.zip | |
comments, rename 'l' to 'io', and state explicitly that we use GeneralizedNewtypeDeriving
darcs-hash:20070307030351-9c5c1-1bdd8f6be37c4e1fa30aaed0af13ee00790cb8b4.gz
Diffstat (limited to '')
| -rw-r--r-- | Wm.hs | 35 |
1 files changed, 24 insertions, 11 deletions
@@ -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 |