[xmonad] darcs patch: DynamicBars-use-ExtensibleState

[adam vogt]

Applied, thanks.

On Tue, Jun 18, 2013 at 3:50 AM,  <gopsychonauts at gmail.com> wrote:
> 1 patch for repository http://code.haskell.org/XMonadContrib:
>
> Tue Jun 18 17:47:55 EST 2013  gopsychonauts at gmail.com
>   * 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.
>
>
>
>
> [DynamicBars-use-ExtensibleState
> gopsychonauts at gmail.com**20130618074755
>  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.
>
> ] {
> hunk ./XMonad/Hooks/DynamicBars.hs 1
> +{-# LANGUAGE DeriveDataTypeable #-}
>  -----------------------------------------------------------------------------
>  -- |
>  -- Module      :  XMonad.Hooks.DynamicBars
> hunk ./XMonad/Hooks/DynamicBars.hs 28
>
>  import Prelude
>
> -import Control.Concurrent.MVar
>  import Control.Monad
>  import Control.Monad.Trans (lift)
>  import Control.Monad.Writer (WriterT, execWriterT, tell)
> hunk ./XMonad/Hooks/DynamicBars.hs 42
>  import Graphics.X11.Xrandr
>
>  import System.IO
> -import System.IO.Unsafe
>
>  import XMonad
>  import qualified XMonad.StackSet as W
> hunk ./XMonad/Hooks/DynamicBars.hs 46
>  import XMonad.Hooks.DynamicLog
> +import qualified XMonad.Util.ExtensibleState as XS
>
>  -- $usage
>  -- Provides a few helper functions to manage per-screen status bars while
> hunk ./XMonad/Hooks/DynamicBars.hs 70
>  data DynStatusBarInfo = DynStatusBarInfo
>    { dsbInfoScreens :: [ScreenId]
>    , dsbInfoHandles :: [Handle]
> -  }
> +  } deriving (Typeable)
> +
> +instance ExtensionClass DynStatusBarInfo where
> +  initialValue = DynStatusBarInfo [] []
>
>  type DynamicStatusBar = ScreenId -> IO Handle
>  type DynamicStatusBarCleanup = IO ()
> hunk ./XMonad/Hooks/DynamicBars.hs 78
>
> --- Global state
> -statusBarInfo :: MVar DynStatusBarInfo
> -statusBarInfo = unsafePerformIO $ newMVar (DynStatusBarInfo [] [])
> -
>  dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
> hunk ./XMonad/Hooks/DynamicBars.hs 79
> -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
> hunk ./XMonad/Hooks/DynamicBars.hs 87
> -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)
>
> hunk ./XMonad/Hooks/DynamicBars.hs 90
> -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
> hunk ./XMonad/Hooks/DynamicBars.hs 94
> -  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.
> hunk ./XMonad/Hooks/DynamicBars.hs 109
>          -> 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 ()
> hunk ./XMonad/Hooks/DynamicBars.hs 127
>      =<< 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
> }
>
>
> _______________________________________________
> xmonad mailing list
> xmonad at haskell.org
> http://www.haskell.org/mailman/listinfo/xmonad
>