cleaner version of main/config inversion.

EventLoop.hs

@@ -12,7 +12,7 @@
 --
 -----------------------------------------------------------------------------
 
-module EventLoop ( makeMain ) where
+module EventLoop ( makeMain, XMonadConfig(..) ) where
 
 import Data.Bits
 import qualified Data.Map as M
@@ -27,32 +27,42 @@ import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
 import Graphics.X11.Xlib.Extras
 import Graphics.X11.Xinerama    (getScreenInfo)
 
-import XMonad
+import XMonad hiding ( logHook, borderWidth )
+import qualified XMonad ( logHook, borderWidth )
 import StackSet (new, floating, member)
 import qualified StackSet as W
 import Operations
 
 import System.IO
 
+data XMonadConfig l = XMonadConfig { normalBorderColor :: !String
+                                   , focusedBorderColor :: !String
+                                   , defaultTerminal :: !String
+                                   , layoutHook :: !(l Window)
+                                   , workspaces :: ![String]
+                                   , defaultGaps :: ![(Int,Int,Int,Int)]
+                                   , keys :: !(M.Map (ButtonMask,KeySym) (X ()))
+                                   , mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
+                                   , borderWidth :: !Dimension
+                                   , logHook :: !(X ())
+                                   }
+
 -- |
 -- The main entry point
 --
-makeMain :: String -> String -> Layout Window -> [String] -> [(Int,Int,Int,Int)]
+makeMain :: LayoutClass l Window => XMonadConfig l -> IO ()
-         -> M.Map (ButtonMask,KeySym) (X ()) -> M.Map (ButtonMask, Button) (Window -> X ())
+makeMain xmc = do
-         -> Dimension -> X () -> IO ()
-makeMain normalBorderColor focusedBorderColor layoutHook workspaces
-         defaultGaps keys mouseBindings borderWidth logHook = do
     dpy   <- openDisplay ""
     let dflt = defaultScreen dpy
 
     rootw  <- rootWindow dpy dflt
     xinesc <- getScreenInfo dpy
-    nbc    <- initColor dpy normalBorderColor
+    nbc    <- initColor dpy $ normalBorderColor xmc
-    fbc    <- initColor dpy focusedBorderColor
+    fbc    <- initColor dpy $ focusedBorderColor xmc
     hSetBuffering stdout NoBuffering
     args <- getArgs
 
-    let initialWinset = new layoutHook workspaces $ zipWith SD xinesc gaps
+    let initialWinset = new (Layout $ layoutHook xmc) (workspaces xmc) $ zipWith SD xinesc gaps
 
         maybeRead s = case reads s of
                             [(x, "")] -> Just x
@@ -61,13 +71,16 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
         winset = fromMaybe initialWinset $ do
                     ("--resume" : s : _) <- return args
                     ws                   <- maybeRead s
-                    return . W.ensureTags layoutHook workspaces
+                    return . W.ensureTags (Layout $ layoutHook xmc) (workspaces xmc)
-                           $ W.mapLayout (fromMaybe layoutHook . maybeRead) ws
+                           $ W.mapLayout (fromMaybe (Layout $ layoutHook xmc) . maybeRead) ws
 
-        gaps = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0)
+        gaps = take (length xinesc) $ defaultGaps xmc ++ repeat (0,0,0,0)
 
         cf = XConf
             { display       = dpy
+            , XMonad.logHook = logHook xmc
+            , XMonad.borderWidth = borderWidth xmc
+            , terminal      = defaultTerminal xmc
             , theRoot       = rootw
             , normalBorder  = nbc
             , focusedBorder = fbc }
@@ -87,8 +100,8 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
     allocaXEvent $ \e ->
         runX cf st $ do
 
-            grabKeys keys
+            grabKeys xmc
-            grabButtons mouseBindings
+            grabButtons xmc
 
             io $ sync dpy False
 
@@ -124,7 +137,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
             handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
                 | t == keyPress = withDisplay $ \dpy -> do
                     s  <- io $ keycodeToKeysym dpy code 0
-                    userCode $ whenJust (M.lookup (cleanMask m,s) keys) id
+                    userCode $ whenJust (M.lookup (cleanMask m,s) (keys xmc)) id
 
             -- manage a new window
             handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do
@@ -148,7 +161,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
             -- set keyboard mapping
             handle e@(MappingNotifyEvent {}) = do
                 io $ refreshKeyboardMapping e
-                when (ev_request e == mappingKeyboard) (grabKeys keys)
+                when (ev_request e == mappingKeyboard) (grabKeys xmc)
 
             -- handle button release, which may finish dragging.
             handle e@(ButtonEvent {ev_event_type = t})
@@ -172,7 +185,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
                 -- If it's the root window, then it's something we
                 -- grabbed in grabButtons. Otherwise, it's click-to-focus.
                 isr <- isRoot w
-                if isr then userCode $ whenJust (M.lookup (cleanMask (ev_state e), b) mouseBindings) ($ ev_subwindow e)
+                if isr then userCode $ whenJust (M.lookup (cleanMask (ev_state e), b) $ mouseBindings xmc) ($ ev_subwindow e)
                        else focus w
                 sendMessage e -- Always send button events.
 
@@ -199,7 +212,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
                                 , wc_y            = ev_y e
                                 , wc_width        = ev_width e
                                 , wc_height       = ev_height e
-                                , wc_border_width = fromIntegral borderWidth
+                                , wc_border_width = fromIntegral (borderWidth xmc)
                                 , wc_sibling      = ev_above e
                                 , wc_stack_mode   = ev_detail e }
                             when (member w ws) (float w)
@@ -216,7 +229,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces
 
             -- property notify
             handle PropertyEvent { ev_event_type = t, ev_atom = a }
-                | t == propertyNotify && a == wM_NAME = userCode logHook
+                | t == propertyNotify && a == wM_NAME = userCode $ logHook xmc
 
             handle e = broadcastMessage e -- trace (eventName e) -- ignoring
 
@@ -243,22 +256,22 @@ scan dpy rootw = do
                          && (wa_map_state wa == waIsViewable || ic)
 
 -- | Grab the keys back
-grabKeys :: M.Map (ButtonMask,KeySym) (X ()) -> X ()
+grabKeys :: XMonadConfig l -> X ()
-grabKeys keys = do
+grabKeys xmc = do
     XConf { display = dpy, theRoot = rootw } <- ask
     let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
     io $ ungrabKey dpy anyKey anyModifier rootw
-    forM_ (M.keys keys) $ \(mask,sym) -> do
+    forM_ (M.keys $ keys xmc) $ \(mask,sym) -> do
          kc <- io $ keysymToKeycode dpy sym
          -- "If the specified KeySym is not defined for any KeyCode,
          -- XKeysymToKeycode() returns zero."
          when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) extraModifiers
 
 -- | XXX comment me
-grabButtons :: M.Map (ButtonMask, Button)  (Window -> X ()) -> X ()
+grabButtons :: XMonadConfig l -> X ()
-grabButtons mouseBindings = do
+grabButtons xmc = do
     XConf { display = dpy, theRoot = rootw } <- ask
     let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask
                                            grabModeAsync grabModeSync none none
     io $ ungrabButton dpy anyButton anyModifier rootw
-    mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) extraModifiers) (M.keys mouseBindings)
+    mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) extraModifiers) (M.keys $ mouseBindings xmc)

Main.hs

@@ -19,7 +19,8 @@ module Main where
 --
 -- Useful imports
 --
-import XMonad
+import Control.Monad.Reader ( asks )
+import XMonad hiding ( logHook, borderWidth )
 import Operations
 import qualified StackSet as W
 import Data.Ratio
@@ -27,7 +28,8 @@ import Data.Bits ((.|.))
 import qualified Data.Map as M
 import System.Exit
 import Graphics.X11.Xlib
-import EventLoop
+import EventLoop hiding ( workspaces )
+import qualified EventLoop ( workspaces )
 
 -- % Extension-provided imports
 
@@ -67,17 +69,6 @@ modMask = mod1Mask
 numlockMask :: KeyMask
 numlockMask = mod2Mask
 
--- | Width of the window border in pixels.
---
-borderWidth :: Dimension
-borderWidth = 1
-
--- | Border colors for unfocused and focused windows, respectively.
---
-normalBorderColor, focusedBorderColor :: String
-normalBorderColor  = "#dddddd"
-focusedBorderColor = "#ff0000"
-
 -- | Default offset of drawable screen boundaries from each physical
 -- screen. Anything non-zero here will leave a gap of that many pixels
 -- on the given edge, on the that screen. A useful gap at top of screen
@@ -90,8 +81,8 @@ focusedBorderColor = "#ff0000"
 --
 -- Fields are: top, bottom, left, right.
 --
-defaultGaps :: [(Int,Int,Int,Int)]
+--defaultGaps :: [(Int,Int,Int,Int)]
-defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
+
 
 ------------------------------------------------------------------------
 -- Window rules
@@ -158,42 +149,15 @@ layouts = [ Layout tiled
      -- Percent of screen to increment by when resizing panes
      delta   = 3%100
 
--- | The top level layout switcher. Most users will not need to modify this binding.
---
--- By default, we simply switch between the layouts listed in `layouts'
--- above, but you may program your own selection behaviour here. Layout
--- transformers, for example, would be hooked in here.
---
-layoutHook :: Layout Window
-layoutHook = Layout $ Select layouts
-
 -- | Register with xmonad a list of layouts whose state we can preserve over restarts.
 -- There is typically no need to modify this list, the defaults are fine.
 --
 serialisedLayouts :: [Layout Window]
-serialisedLayouts = layoutHook : layouts
+serialisedLayouts = Layout (layoutHook defaultConfig) : layouts
-
-------------------------------------------------------------------------
--- Logging
-
--- | Perform an arbitrary action on each internal state change or X event.
--- Examples include:
---      * do nothing
---      * log the state to stdout
---
--- See the 'DynamicLog' extension for examples.
---
-logHook :: X ()
-logHook = return ()
 
 ------------------------------------------------------------------------
 -- Key bindings:
 
--- | The preferred terminal program, which is used in a binding below and by
--- certain contrib modules.
-terminal :: String
-terminal = "xterm"
-
 -- | The xmonad key bindings. Add, modify or remove key bindings here.
 --
 -- (The comment formatting character is used when generating the manpage)
@@ -201,13 +165,13 @@ terminal = "xterm"
 keys :: M.Map (KeyMask, KeySym) (X ())
 keys = M.fromList $
     -- launching and killing programs
-    [ ((modMask .|. shiftMask, xK_Return), spawn terminal) -- %! Launch terminal
+    [ ((modMask .|. shiftMask, xK_Return), asks terminal >>= spawn) -- %! Launch terminal
     , ((modMask,               xK_p     ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu
     , ((modMask .|. shiftMask, xK_p     ), spawn "gmrun") -- %! Launch gmrun
     , ((modMask .|. shiftMask, xK_c     ), kill) -- %! Close the focused window
 
     , ((modMask,               xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms
-    , ((modMask .|. shiftMask, xK_space ), setLayout layoutHook) -- %!  Reset the layouts on the current workspace to default
+    , ((modMask .|. shiftMask, xK_space ), setLayout $ layoutHook defaultConfig) -- %!  Reset the layouts on the current workspace to default
 
     , ((modMask,               xK_n     ), refresh) -- %! Resize viewed windows to the correct size
 
@@ -234,7 +198,7 @@ keys = M.fromList $
     , ((modMask              , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
 
     -- toggle the status bar gap
-    , ((modMask              , xK_b     ), modifyGap (\i n -> let x = (defaultGaps ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap
+    , ((modMask              , xK_b     ), modifyGap (\i n -> let x = (defaultGaps defaultConfig ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap
 
     -- quit, or restart
     , ((modMask .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit xmonad
@@ -274,9 +238,32 @@ mouseBindings = M.fromList $
 
 -- % Extension-provided definitions
 
+defaultConfig :: XMonadConfig Select
+defaultConfig = XMonadConfig { borderWidth = 1 -- Width of the window border in pixels.
+                             , EventLoop.workspaces = workspaces
+                             , defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
+                             -- | The top level layout switcher. Most users will not need to modify this binding.
+                             --
+                             -- By default, we simply switch between the layouts listed in `layouts'
+                             -- above, but you may program your own selection behaviour here. Layout
+                             -- transformers, for example, would be hooked in here.
+                             --       
+                             , layoutHook = Select layouts
+                             , defaultTerminal = "xterm" -- The preferred terminal program.
+                             , normalBorderColor = "#dddddd" -- Border color for unfocused windows.
+                             , focusedBorderColor = "#ff0000" -- Border color for focused windows.
+                             , EventLoop.keys = Main.keys
+                             , EventLoop.mouseBindings = Main.mouseBindings
+                             -- | Perform an arbitrary action on each internal state change or X event.
+                             -- Examples include:
+                             --      * do nothing
+                             --      * log the state to stdout
+                             --
+                             -- See the 'DynamicLog' extension for examples.
+                             , logHook = return ()
+                             }
 
 -- % The main function
 
 main :: IO ()
-main = makeMain normalBorderColor focusedBorderColor layoutHook workspaces
+main = makeMain defaultConfig
-                defaultGaps keys mouseBindings borderWidth logHook

Main.hs-boot

@@ -1,11 +1,7 @@
 module Main where
-import Graphics.X11.Xlib.Types (Dimension)
 import Graphics.X11.Xlib (KeyMask,Window)
 import XMonad
-borderWidth :: Dimension
 numlockMask :: KeyMask
 workspaces :: [WorkspaceId]
-logHook     :: X ()
 manageHook :: Window -> String -> String -> String -> X (WindowSet -> WindowSet)
 serialisedLayouts :: [Layout Window]
-terminal :: String

Operations.hs

@@ -37,7 +37,7 @@ import Graphics.X11.Xlib
 import Graphics.X11.Xinerama (getScreenInfo)
 import Graphics.X11.Xlib.Extras
 
-import {-# SOURCE #-} Main (borderWidth,logHook,manageHook,numlockMask,serialisedLayouts)
+import {-# SOURCE #-} Main (manageHook,numlockMask,serialisedLayouts)
 
 -- ---------------------------------------------------------------------
 -- |
@@ -170,7 +170,7 @@ windows f = do
 
     whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc
     setTopFocus
-    userCode logHook
+    asks logHook >>= userCode
     -- io performGC -- really helps, but seems to trigger GC bugs?
 
     -- hide every window that was potentially visible before, but is not
@@ -214,7 +214,8 @@ setInitialProperties :: Window -> X ()
 setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
     setWMState w iconicState
     io $ selectInput d w $ clientMask
-    io $ setWindowBorderWidth d w borderWidth
+    bw <- asks borderWidth
+    io $ setWindowBorderWidth d w bw
     -- we must initially set the color of new windows, to maintain invariants
     -- required by the border setting in 'windows'
     io $ setWindowBorder d w nb
@@ -543,11 +544,11 @@ floatLocation :: Window -> X (ScreenId, W.RationalRect)
 floatLocation w = withDisplay $ \d -> do
     ws <- gets windowset
     wa <- io $ getWindowAttributes d w
+    bw <- fi `fmap` asks borderWidth
 
     -- XXX horrible
     let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.screens ws
         sr = screenRect . W.screenDetail $ sc
-        bw = fi borderWidth
         rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
                             ((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
                             (fi (wa_width  wa + bw*2) % fi (rect_width sr))

XMonad.hs

@@ -50,7 +50,10 @@ data XState = XState
     , dragging     :: !(Maybe (Position -> Position -> X (), X ())) }
 data XConf = XConf
     { display       :: Display      -- ^ the X11 display
+    , logHook       :: !(X ())      -- ^ the loghook function
+    , terminal      :: !String      -- ^ the user's preferred terminal
     , theRoot       :: !Window      -- ^ the root window
+    , borderWidth   :: !Dimension   -- ^ the preferred border width
     , normalBorder  :: !Pixel       -- ^ border color of unfocused windows
     , focusedBorder :: !Pixel     } -- ^ border color of the focused window