DynamicBars-use-ExtensibleState

Ignore-this: afacba51af2be8ede65b9bcf9b002a7

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.

darcs-hash:20130618074755-1e6bb-2fd1caa6f26c1c75c83bf0ef9e03a8f6c9225896.gz

1 files changed, 24 insertions, 25 deletions

diff --git a/XMonad/Hooks/DynamicBars.hs b/XMonad/Hooks/DynamicBars.hs
index 993aec5..aea0124 100644
--- a/XMonad/Hooks/DynamicBars.hs
+++ b/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
-  dpy <- openDisplay ""
-  xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask
-  closeDisplay dpy
+dynStatusBarStartup sb cleanup = do
+  liftIO $ do
+      dpy <- openDisplay ""
+      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 sb cleanup = liftIO $ do
-  dsbInfo <- takeMVar statusBarInfo
+updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
+updateStatusBars sb cleanup = do
+  dsbInfo <- XS.get
   screens <- getScreens
-  if (screens /= (dsbInfoScreens dsbInfo))
-    then do
-      mapM hClose (dsbInfoHandles dsbInfo)
-      cleanup
-      newHandles <- mapM sb screens
-      putMVar statusBarInfo (DynStatusBarInfo screens newHandles)
-    else putMVar statusBarInfo dsbInfo
+  when (screens /= dsbInfoScreens dsbInfo) $ do
+      newHandles <- liftIO $ do
+          hClose `mapM_` dsbInfoHandles dsbInfo
+          cleanup
+          mapM sb screens
+      XS.put $ DynStatusBarInfo screens newHandles
 
 -----------------------------------------------------------------------------
 -- 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 = do
+getScreens :: MonadIO m => m [ScreenId]
+getScreens = liftIO $ do
   screens <- do
     dpy <- openDisplay ""
     rects <- getScreenInfo dpy