XMonad dzen loghook that respawns dzen when screen size changes

xmonad-dzen.hs

{-# LANGUAGE FlexibleContexts #-}
import XMonad

import Control.Monad.Reader (asks)
import Control.Concurrent.MVar (MVar, newMVar, modifyMVar)
import XMonad.Actions.GridSelect (goToSelected, defaultGSConfig)
import XMonad.Util.EZConfig (additionalKeys)
import XMonad.Hooks.DynamicLog (PP(..), dzenPP, dynamicLogWithPP)
import XMonad.Util.Run (spawnPipe)
import System.IO (Handle, IOMode(WriteMode), hPutStrLn, hClose, openFile)
import XMonad.Hooks.ManageDocks (AvoidStruts, avoidStruts, manageDocks)
import XMonad.Layout.LayoutModifier (ModifiedLayout)
import Graphics.X11.Xinerama (getScreenInfo)
import Data.Maybe (listToMaybe)

myModMask = mod1Mask

-- | Create a config modifier that adds a dzen log hook
-- the loghook will detect screen resolution changes and respawn dzen to fit
newLogHook  :: LayoutClass l Window 
            => IO (XConfig l -> XConfig (ModifiedLayout AvoidStruts l))
newLogHook = do
  dummyHandle <- openFile "/dev/null" WriteMode
  ppMVar <- newMVar (dzenPP, dummyHandle, 0)
  return $ logHookConfigMod (checkAndOutput ppMVar)
  where
    createPP :: IO (PP, Handle)
    createPP = do
      let fg      = "'#a8a3f7'" -- n.b quoting
          bg      = "'#3f3c6d'"
          flags   = "-e 'onstart=lower' -w 0 -ta l -fg " ++ fg ++ " -bg " ++ bg
      h <- spawnPipe ("dzen2 " ++ flags)
      let pp = dzenPP { ppOutput = hPutStrLn h }
      return (pp, h)

    checkAndOutput :: MVar (PP, Handle, Int) -> X ()
    checkAndOutput ppMVar = do
      disp <- asks display
      xineramaInfo <- liftIO $ getScreenInfo disp
      let width = maybe 0 rect_width (listToMaybe xineramaInfo)
      let newWidth = fromIntegral width
      pp <- liftIO $ modifyMVar ppMVar $ \old@(oldPP, oldHandle, oldWidth) -> do
        if oldWidth /= newWidth
          then do
            hClose oldHandle
            (newPP, newHandle) <- createPP
            let new = (newPP, newHandle, newWidth)
            return (new, newPP)
          else return (old, oldPP)
      dynamicLogWithPP pp

    logHookConfigMod  :: LayoutClass l Window
                      => X () -> XConfig l 
                      -> XConfig (ModifiedLayout AvoidStruts l)
    logHookConfigMod newLogHook conf = conf
        { layoutHook = avoidStruts (layoutHook conf)
        , logHook = newLogHook
        , manageHook = manageHook conf <+> manageDocks
        }


main = do
  logHookConfigMod <- newLogHook
  xmonad $ logHookConfigMod $ defaultConfig
    { terminal = "urxvt"
    , modMask = myModMask
    }
    `additionalKeys`
    [ ((myModMask, xK_p), spawn "dmenu_run")
    , ((myModMask, xK_o), goToSelected defaultGSConfig)
    ]