From a192f6137313a60c35f6513cd8aa0237870bf358 Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@cse.unsw.edu.au>
Date: Fri, 9 Mar 2007 06:54:17 +0100
Subject: refactor, -10 or so loc

darcs-hash:20070309055417-9c5c1-6d4119932cae7f8f885b0d1ce674efc25f7488e8.gz
---
 Main.hs   | 20 ++++++++++++++------
 WMonad.hs | 46 +++++++++++++++++-----------------------------
 2 files changed, 31 insertions(+), 35 deletions(-)

diff --git a/Main.hs b/Main.hs
index 4a7a914..76fd0d7 100644
--- a/Main.hs
+++ b/Main.hs
@@ -147,14 +147,18 @@ refresh :: W ()
 refresh = do
     ws <- gets workspace
     whenJust (W.peek ws) $ \w ->
-        withScreen $ \(d,sw,sh) -> io $ do
-            moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh) -- fullscreen
-            raiseWindow d w
+        withDisplay $ \d -> do
+            sw <- gets screenWidth
+            sh <- gets screenHeight
+            io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh) -- fullscreen
+                    raiseWindow d w
 
 -- | hide. Hide a list of windows by moving them offscreen.
 hide :: Window -> W ()
-hide w = withScreen $ \(dpy,sw,sh) -> io $
-    moveWindow dpy w (2*fromIntegral sw) (2*fromIntegral sh)
+hide w = withDisplay $ \d -> do
+    sw <- gets screenWidth
+    sh <- gets screenHeight
+    io $ moveWindow d w (2*fromIntegral sw) (2*fromIntegral sh)
 
 -- | reveal. Expose a list of windows, moving them on screen
 reveal :: Window -> W ()
@@ -162,7 +166,11 @@ reveal w = withDisplay $ \d -> io $ moveWindow d w 0 0
 
 -- | windows. Modify the current window list with a pure function, and refresh
 windows :: (WorkSpace -> WorkSpace) -> W ()
-windows f = modifyWorkspace f >> refresh
+windows f = do
+    modify $ \s -> s { workspace = f (workspace s) }
+    ws <- gets workspace
+    refresh
+    trace (show ws) -- log state changes to stderr
 
 -- ---------------------------------------------------------------------
 -- Window operations
diff --git a/WMonad.hs b/WMonad.hs
index 583f805..e6e3ae7 100644
--- a/WMonad.hs
+++ b/WMonad.hs
@@ -14,7 +14,10 @@
 -- manager state, and support routines.
 --
 
-module WMonad where
+module WMonad (
+    W, WorkSpace, WState(..),
+    runW, withDisplay, io, io_, forever, spawn, trace, whenJust
+  ) where
 
 import StackSet (StackSet)
 
@@ -36,13 +39,19 @@ type WorkSpace = StackSet Window
 
 -- | The W monad, a StateT transformer over IO encapuslating the window
 -- manager state
-newtype W a = W { unW :: StateT WState IO a }
+newtype W a = W (StateT WState IO a)
     deriving (Functor, Monad, MonadIO, MonadState WState)
 
 -- | Run the W monad, given a chunk of W monad code, and an initial state
 -- Return the result, and final state
 runW :: WState -> W a -> IO (a, WState)
-runW st a = runStateT (unW a) st
+runW st (W a) = runStateT a st
+
+-- | Run a monad action with the current display settings
+withDisplay :: (Display -> W ()) -> W ()
+withDisplay f = gets display >>= f
+
+------------------------------------------------------------------------
 
 -- | Lift an IO action into the W monad
 io :: IO a -> W a
@@ -60,33 +69,12 @@ forever a = a >> forever a
 spawn :: String -> W ()
 spawn = io_ . runCommand
 
--- | A 'trace' for the W monad. Logs a string to stderr. The result may
--- be found in your .xsession-errors file
-trace :: String -> W ()
-trace msg = io $ do
-    hPutStrLn stderr msg
-    hFlush stderr
-
--- | Run a monad action with the current display settings
-withDisplay :: (Display -> W ()) -> W ()
-withDisplay f = gets display >>= f
-
--- | Run a monadic action with the display, screen width and height
-withScreen  :: ((Display,Int,Int) -> W ()) -> W ()
-withScreen f = do
-    d  <- gets display
-    sw <- gets screenWidth
-    sh <- gets screenHeight
-    f (d,sw,sh)
-
--- | Modify the workspace list.
-modifyWorkspace :: (WorkSpace -> WorkSpace) -> W ()
-modifyWorkspace f = do
-    modify $ \s -> s { workspace = f (workspace s) }
-    ws <- gets workspace
-    trace (show ws) -- log state changes to stderr
-
 -- | Run a side effecting action with the current workspace. Like 'when' but
 whenJust :: Maybe a -> (a -> W ()) -> W ()
 whenJust mg f = maybe (return ()) f mg
 
+
+-- | A 'trace' for the W monad. Logs a string to stderr. The result may
+-- be found in your .xsession-errors file
+trace :: String -> W ()
+trace msg = io $ do hPutStrLn stderr msg; hFlush stderr
-- 
cgit v1.2.3