diff options
author | Don Stewart <dons@cse.unsw.edu.au> | 2007-03-07 03:23:32 +0100 |
---|---|---|
committer | Don Stewart <dons@cse.unsw.edu.au> | 2007-03-07 03:23:32 +0100 |
commit | 3dc06f20fd102531a005818e28552284786091a7 (patch) | |
tree | 91d4b3472bf485575d63e67a4d7a4721f6e31fef /Wm.hs | |
parent | 89b9e95bf8a51dbab41a89626ab6a613b0593bf6 (diff) | |
download | metatile-3dc06f20fd102531a005818e28552284786091a7.tar metatile-3dc06f20fd102531a005818e28552284786091a7.zip |
Flatten module hierarchy
darcs-hash:20070307022332-9c5c1-4b24108ce990c0b74183fedf99e6de26d2e7a15c
Diffstat (limited to 'Wm.hs')
-rw-r--r-- | Wm.hs | 48 |
1 files changed, 48 insertions, 0 deletions
@@ -0,0 +1,48 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} + +module Wm where + +import Data.Sequence +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 + } + +newtype Wm a = Wm (StateT WmState IO a) + deriving (Monad, MonadIO{-, MonadState WmState-}) + +runWm :: Wm a -> WmState -> IO (a, WmState) +runWm (Wm m) = runStateT m + +l :: IO a -> Wm a +l = liftIO + +trace msg = l $ 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 + Wm (put s') + return y + +getDisplay = Wm (gets display) + +getWindows = Wm (gets windows) + +getScreenWidth = Wm (gets screenWidth) + +getScreenHeight = Wm (gets screenHeight) + +setWindows x = Wm (modify (\s -> s {windows = x})) + +modifyWindows :: (Seq Window -> Seq Window) -> Wm () +modifyWindows f = Wm (modify (\s -> s {windows = f (windows s)})) |