DynamicBars-use-ExtensibleState

Hooks.DynamicBars was previously using an MVar and the unsafePerformIO hack (
http://www.haskell.org/haskellwiki/Top_level_mutable_state ) to store bar
state. Since ExtensibleState exists to solve these sorts of problems, I've
switched the file over to use unsafePerformIO instead.

Some functions' types had to be changed to allow access to XState, but the
public API is unchanged.

XMonad/Hooks/DynamicBars.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.DynamicBars
@@ -24,7 +25,6 @@ module XMonad.Hooks.DynamicBars (
 
 import Prelude
 
-import Control.Concurrent.MVar
 import Control.Monad
 import Control.Monad.Trans (lift)
 import Control.Monad.Writer (WriterT, execWriterT, tell)
@@ -39,11 +39,11 @@ import Graphics.X11.Xlib.Extras
 import Graphics.X11.Xrandr
 
 import System.IO
-import System.IO.Unsafe
 
 import XMonad
 import qualified XMonad.StackSet as W
 import XMonad.Hooks.DynamicLog
+import qualified XMonad.Util.ExtensibleState as XS
 
 -- $usage
 -- Provides a few helper functions to manage per-screen status bars while
@@ -67,37 +67,36 @@ import XMonad.Hooks.DynamicLog
 data DynStatusBarInfo = DynStatusBarInfo
   { dsbInfoScreens :: [ScreenId]
   , dsbInfoHandles :: [Handle]
-  }
+  } deriving (Typeable)
+
+instance ExtensionClass DynStatusBarInfo where
+  initialValue = DynStatusBarInfo [] []
 
 type DynamicStatusBar = ScreenId -> IO Handle
 type DynamicStatusBarCleanup = IO ()
 
--- Global state
-statusBarInfo :: MVar DynStatusBarInfo
-statusBarInfo = unsafePerformIO $ newMVar (DynStatusBarInfo [] [])
-
 dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
-dynStatusBarStartup sb cleanup = liftIO $ do
+dynStatusBarStartup sb cleanup = do
-  dpy <- openDisplay ""
+  liftIO $ do
-  xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask
+      dpy <- openDisplay ""
-  closeDisplay dpy
+      xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask
+      closeDisplay dpy
   updateStatusBars sb cleanup
 
 dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All
-dynStatusBarEventHook sb cleanup (RRScreenChangeNotifyEvent {}) = liftIO (updateStatusBars sb cleanup) >> return (All True)
+dynStatusBarEventHook sb cleanup (RRScreenChangeNotifyEvent {}) = updateStatusBars sb cleanup >> return (All True)
 dynStatusBarEventHook _  _       _                              = return (All True)
 
-updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> IO ()
+updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
-updateStatusBars sb cleanup = liftIO $ do
+updateStatusBars sb cleanup = do
-  dsbInfo <- takeMVar statusBarInfo
+  dsbInfo <- XS.get
   screens <- getScreens
-  if (screens /= (dsbInfoScreens dsbInfo))
+  when (screens /= dsbInfoScreens dsbInfo) $ do
-    then do
+      newHandles <- liftIO $ do
-      mapM hClose (dsbInfoHandles dsbInfo)
+          hClose `mapM_` dsbInfoHandles dsbInfo
-      cleanup
+          cleanup
-      newHandles <- mapM sb screens
+          mapM sb screens
-      putMVar statusBarInfo (DynStatusBarInfo screens newHandles)
+      XS.put $ DynStatusBarInfo screens newHandles
-    else putMVar statusBarInfo dsbInfo
 
 -----------------------------------------------------------------------------
 -- The following code is from adamvo's xmonad.hs file.
@@ -107,7 +106,7 @@ multiPP :: PP -- ^ The PP to use if the screen is focused
         -> PP -- ^ The PP to use otherwise
         -> X ()
 multiPP focusPP unfocusPP = do
-  dsbInfo <- liftIO $ readMVar statusBarInfo
+  dsbInfo <- XS.get
   multiPP' dynamicLogString focusPP unfocusPP (dsbInfoHandles dsbInfo)
 
 multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
@@ -125,8 +124,8 @@ multiPP' dynlStr focusPP unfocusPP handles = do
     =<< mapM screenWorkspace (zipWith const [0 .. ] handles)
   return ()
 
-getScreens :: IO [ScreenId]
+getScreens :: MonadIO m => m [ScreenId]
-getScreens = do
+getScreens = liftIO $ do
   screens <- do
     dpy <- openDisplay ""
     rects <- getScreenInfo dpy