refactoring. less code

darcs-hash:20070307055007-9c5c1-2dc9d077773b25f22954c41856e670f3b5583e9f.gz

2 files changed, 97 insertions, 119 deletions

diff --git a/Main.hs b/Main.hs
index bf5562c..6fdfbd3 100644
--- a/Main.hs
+++ b/Main.hs
@@ -13,10 +13,7 @@
 -- thunk, a minimal window manager for X11
 --
 
-import qualified Data.Map as Map
-import Data.Map (Map)
-
-import Data.Bits
+import Data.Bits hiding (rotate)
 
 import System.IO
 import System.Process (runCommand)
@@ -29,56 +26,62 @@ import Control.Monad.State
 
 import W
 
-------------------------------------------------------------------------
-
 --
 -- let's get underway
 -- 
 main :: IO ()
 main = do
     dpy <- openDisplay ""
-    runW realMain $ WState
-            { display = dpy
-            , screenWidth  = displayWidth  dpy (defaultScreen dpy)
-            , screenHeight = displayHeight dpy (defaultScreen dpy)
-            , windows      = []
-            }
+    let dflt      = defaultScreen dpy
+        initState = WState
+            { display      = dpy
+            , screenWidth  = displayWidth  dpy dflt
+            , screenHeight = displayHeight dpy dflt
+            , windows      = [] }
+
+    runW initState $ do
+        root <- io $ rootWindow dpy dflt
+        io $ do selectInput dpy root (substructureRedirectMask .|. substructureNotifyMask)
+                sync dpy False
+        registerKeys dpy root
+        go dpy
+
     return ()
+  where
+    -- The main loop
+    go dpy = forever $ do
+        e <- io $ allocaXEvent $ \ev -> nextEvent dpy ev >> getEvent ev
+        handle e
 
 --
--- Grab the display and input, and jump into the input loop
+-- | grabkeys. Register key commands
 --
-realMain :: W ()
-realMain = do
-    dpy <- getDisplay
-    let screen = defaultScreen dpy
-    io $ do root <- rootWindow dpy screen
-            selectInput dpy root (substructureRedirectMask .|. substructureNotifyMask)
-            sync dpy False
-    grabkeys
-    loop
+registerKeys :: Display -> Window -> W ()
+registerKeys dpy root =
+    forM_ keys $ \(mod, sym, _) -> do
+        kc <- io (keysymToKeycode dpy sym)
+        io $ grabKey dpy kc mod root True grabModeAsync grabModeAsync
 
---
--- The main event handling loop
---
-loop :: W ()
-loop = do
-    dpy <- getDisplay
-    forever $ do
-        e <- io $ allocaXEvent $ \ev -> nextEvent dpy ev >> getEvent ev
-        handler e
+keys :: [(KeyMask, KeySym, W ())]
+keys =
+    [ (mod1Mask .|. shiftMask, xK_Return, spawn "xterm")
+    , (mod1Mask,               xK_p,      spawn "exe=`dmenu_path | dmenu` && exec $exe")
+    , (controlMask,            xK_space,  spawn "gmrun")
+    , (mod1Mask,               xK_Tab,    switch)
+    , (mod1Mask .|. shiftMask, xK_q,      io $ exitWith ExitSuccess)
+    ]
 
 --
 -- The event handler
 -- 
-handler :: Event -> W ()
-handler (MapRequestEvent {window = w}) = manage w
+handle :: Event -> W ()
+handle (MapRequestEvent {window = w}) = manage w
 
-handler (DestroyWindowEvent {window = w}) = do
+handle (DestroyWindowEvent {window = w}) = do
     modifyWindows (filter (/= w))
     refresh
 
-handler (KeyEvent {event_type = t, state = mod, keycode = code})
+handle (KeyEvent {event_type = t, state = mod, keycode = code})
     | t == keyPress = do
         dpy <- getDisplay
         sym <- io $ keycodeToKeysym dpy code 0
@@ -86,75 +89,57 @@ handler (KeyEvent {event_type = t, state = mod, keycode = code})
             []              -> return ()
             ((_, _, act):_) -> act
 
-handler _ = return ()
+handle _ = return ()
 
---
--- switch focus to next window in list.
---
-switch :: W ()
-switch = do
-    ws <- getWindows
-    case ws of
-        []     -> return ()
-        (x:xs) -> do
-            setWindows (xs++[x]) -- snoc. polish this.
-            refresh
+-- ---------------------------------------------------------------------
+-- Managing windows
 
---
--- | spawn. Launch an external application
---
-spawn :: String -> W ()
-spawn = io_ . runCommand
+-- | Modify the current window list with a pure funtion, and refresh
+withWindows :: (Windows -> Windows) -> W ()
+withWindows f = do
+    modifyWindows f
+    refresh
 
---
--- | Keys we understand.
---
-keys :: [(KeyMask, KeySym, W ())]
-keys =
-    [ (mod1Mask .|. shiftMask, xK_Return, spawn "xterm")
-    , (mod1Mask,               xK_p,      spawn "exe=`dmenu_path | dmenu` && exec $exe")
-    , (controlMask,            xK_space,  spawn "gmrun")
-    , (mod1Mask,               xK_Tab,    switch)
-    , (mod1Mask .|. shiftMask, xK_q,      io $ exitWith ExitSuccess)
-    ]
+-- |  Run an action on the currently focused window
+withCurrent :: (Window -> W ()) -> W ()
+withCurrent f = do
+    ws <- getWindows
+    case ws of
+        []    -> return ()
+        (w:_) -> f w
 
 --
--- | grabkeys. Register key commands
+-- | refresh. Refresh the currently focused window. Resizes to full
+-- screen and raises the window.
 --
-grabkeys :: W ()
-grabkeys = do
-    dpy <- getDisplay
-    root <- io $ rootWindow dpy (defaultScreen dpy)
-    forM_ keys $ \(mod, sym, _) -> do
-        code <- io $ keysymToKeycode dpy sym
-        io $ grabKey dpy code mod root True grabModeAsync grabModeAsync
+refresh :: W ()
+refresh = withCurrent $ \w -> do
+    d  <- getDisplay
+    sw <- getScreenWidth
+    sh <- getScreenHeight
+    io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh)
+            raiseWindow d w
 
 --
---
+-- | manage. Add a new window to be managed
 --
 manage :: Window -> W ()
 manage w = do
     trace "manage"
-    d <- getDisplay
-    ws <- getWindows
-    when (w `notElem` ws) $ do
-        trace "modifying"
-        modifyWindows (w :)
-        io $ mapWindow d w
-        refresh
+    d  <- getDisplay
+    withWindows $ \ws -> if w `elem` ws then ws else w:ws -- a set
+    io $ mapWindow d w
+
 
 --
--- refresh the windows
+-- | switch. switch focus to next window in list.
+-- The currently focused window is always the head of the list
 --
-refresh :: W ()
-refresh = do
-    ws <- getWindows
-    case ws of
-        []    -> return ()
-        (w:_) -> do
-            d  <- getDisplay
-            sw <- getScreenWidth
-            sh <- getScreenHeight
-            io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh)
-                    raiseWindow d w
+switch :: W ()
+switch = withWindows rotate
 
+--
+-- | spawn. Launch an external application
+--
+spawn :: String -> W ()
+spawn = io_ . runCommand
diff --git a/W.hs b/W.hs
index 5bacfea..deed0e6 100644
--- a/W.hs
+++ b/W.hs
@@ -20,64 +20,42 @@ import System.IO
 import Graphics.X11.Xlib
 import Control.Monad.State
 
---
 -- | WState, the window manager state.
 -- Just the display, width, height and a window list
---
 data WState = WState
     { display       :: Display
     , screenWidth   :: !Int
     , screenHeight  :: !Int
-    , windows       :: Windows
+    , windows       :: !Windows
     }
 
 type Windows = [Window]
 
 -- | The W monad, a StateT transformer over IO encapuslating the window
 -- manager state
---
-newtype W a = W (StateT WState IO a)
+newtype W a = W { unW :: StateT WState IO a }
     deriving (Functor, Monad, MonadIO)
 
 -- | Run the W monad, given a chunk of W monad code, and an initial state
 -- Return the result, and final state
---
-runW :: W a -> WState -> IO (a, WState)
-runW (W m) = runStateT m
+runW :: WState -> W a -> IO (a, WState)
+runW st a = runStateT (unW a) st
 
-withIO :: (forall b. (a -> IO b) -> IO b) -> (a -> W c) -> W c
-withIO f g = do
-    s <- W get
-    (y, t) <- io (f (flip runW s . g))
-    W (put t)
-    return y
-
---
 -- | Lift an IO action into the W monad
---
 io :: IO a -> W a
 io = liftIO
 
---
 -- | Lift an IO action into the W monad, discarding any result
---
 io_ :: IO a -> W ()
 io_ f = liftIO f >> return ()
 
---
--- | A 'trace' for the W monad
---
+-- | 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 an action forever
---
-forever :: (Monad m) => m a -> m b
-forever a = a >> forever a
-
 -- ---------------------------------------------------------------------
 -- Getting at the window manager state
 
@@ -104,3 +82,18 @@ setWindows x        = W (modify (\s -> s {windows = x}))
 -- | Modify the current window list
 modifyWindows       :: (Windows -> Windows) -> W ()
 modifyWindows f     = W (modify (\s -> s {windows = f (windows s)}))
+
+-- ---------------------------------------------------------------------
+-- Generic utilities
+
+-- | Run an action forever
+forever :: (Monad m) => m a -> m b
+forever a = a >> forever a
+
+-- | Add an element onto the end of a list
+snoc :: [a] -> a -> [a]
+snoc xs x = xs ++ [x]
+
+-- | Rotate a list one element
+rotate []     = []
+rotate (x:xs) = xs `snoc` x