Use X.U.ExtensibleState instead of IORefs

Ignore-this: e0e80e31e51dfe76f2b2ed597892cbba

This patch changes SpawnOn, DynamicHooks and UrgencyHooks to
use X.U.ExtensibleState instead of IORefs. This simplifies the
usage of those modules thus also breaking current configs.

darcs-hash:20091106115601-7f603-4e2ce344aca377c5c4409b139ad35ca4b1311185.gz

4 files changed, 76 insertions, 102 deletions

diff --git a/XMonad/Actions/SpawnOn.hs b/XMonad/Actions/SpawnOn.hs
index e2734de..bdec270 100644
--- a/XMonad/Actions/SpawnOn.hs
+++ b/XMonad/Actions/SpawnOn.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.SpawnOn
@@ -18,7 +19,6 @@ module XMonad.Actions.SpawnOn (
     -- * Usage
     -- $usage
     Spawner,
-    mkSpawner,
     manageSpawn,
     spawnHere,
     spawnOn,
@@ -28,7 +28,6 @@ module XMonad.Actions.SpawnOn (
 ) where
 
 import Data.List (isInfixOf)
-import Data.IORef
 import System.Posix.Types (ProcessID)
 
 import XMonad
@@ -37,6 +36,7 @@ import qualified XMonad.StackSet as W
 import XMonad.Hooks.ManageHelpers
 import XMonad.Prompt
 import XMonad.Prompt.Shell
+import XMonad.Util.ExtensibleState
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -44,17 +44,16 @@ import XMonad.Prompt.Shell
 -- >    import XMonad.Actions.SpawnOn
 --
 -- >    main = do
--- >      sp <- mkSpawner
 -- >      xmonad defaultConfig {
 -- >         ...
--- >         manageHook = manageSpawn sp <+> manageHook defaultConfig
+-- >         manageHook = manageSpawn <+> manageHook defaultConfig
 -- >         ...
 -- >      }
 --
 -- To ensure that application appears on a workspace it was launched at, add keybindings like:
 --
--- >  , ((mod1Mask,xK_o), spawnHere sp "urxvt")
--- >  , ((mod1Mask,xK_s), shellPromptHere sp defaultXPConfig)
+-- >  , ((mod1Mask,xK_o), spawnHere "urxvt")
+-- >  , ((mod1Mask,xK_s), shellPromptHere defaultXPConfig)
 --
 -- The module can also be used to apply other manage hooks to the window of
 -- the spawned application(e.g. float or resize it).
@@ -62,26 +61,29 @@ import XMonad.Prompt.Shell
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
-newtype Spawner = Spawner {pidsRef :: IORef [(ProcessID, ManageHook)]}
+newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeable
+
+instance ExtensionClass Spawner where
+    initialValue = Spawner []
 
 maxPids :: Int
 maxPids = 5
 
--- | Create 'Spawner' which then has to be passed to other functions.
-mkSpawner :: (Functor m, MonadIO m) => m Spawner
-mkSpawner = io . fmap Spawner $ newIORef []
+-- | Get the current Spawner or create one if it doesn't exist.
+modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
+modifySpawner f = putState . Spawner . f . pidsRef =<< getState
 
 -- | Provides a manage hook to react on process spawned with
 -- 'spawnOn', 'spawnHere' etc.
-manageSpawn :: Spawner -> ManageHook
-manageSpawn sp = do
-    pids <- io . readIORef $ pidsRef sp
+manageSpawn :: ManageHook
+manageSpawn = do
+    Spawner pids <- liftX getState
     mp <- pid
     case flip lookup pids =<< mp of
-        Nothing -> doF id
+        Nothing -> idHook
         Just mh  -> do
             whenJust mp $ \p ->
-                io . modifyIORef (pidsRef sp) $ filter ((/= p) . fst)
+                liftX . modifySpawner $ filter ((/= p) . fst)
             mh
 
 mkPrompt :: (String -> X ()) -> XPConfig -> X ()
@@ -91,32 +93,31 @@ mkPrompt cb c = do
 
 -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
 -- application on current workspace.
-shellPromptHere :: Spawner -> XPConfig -> X ()
-shellPromptHere sp = mkPrompt (spawnHere sp)
+shellPromptHere :: XPConfig -> X ()
+shellPromptHere = mkPrompt spawnHere
 
 -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
 -- application on given workspace.
-shellPromptOn :: Spawner -> WorkspaceId -> XPConfig -> X ()
-shellPromptOn sp ws = mkPrompt (spawnOn sp ws)
+shellPromptOn :: WorkspaceId -> XPConfig -> X ()
+shellPromptOn ws = mkPrompt (spawnOn ws)
 
 -- | Replacement for 'spawn' which launches
 -- application on current workspace.
-spawnHere :: Spawner -> String -> X ()
-spawnHere sp cmd = withWindowSet $ \ws -> spawnOn sp (W.currentTag ws) cmd
+spawnHere :: String -> X ()
+spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd
 
 -- | Replacement for 'spawn' which launches
 -- application on given workspace.
-spawnOn :: Spawner -> WorkspaceId -> String -> X ()
-spawnOn sp ws cmd = spawnAndDo sp (doShift ws) cmd
+spawnOn :: WorkspaceId -> String -> X ()
+spawnOn ws cmd = spawnAndDo (doShift ws) cmd
 
 -- | Spawn an application and apply the manage hook when it opens.
-spawnAndDo :: Spawner -> ManageHook -> String -> X ()
-spawnAndDo sp mh cmd = do
+spawnAndDo :: ManageHook -> String -> X ()
+spawnAndDo mh cmd = do
     p <- spawnPID $ mangle cmd
-    io $ modifyIORef (pidsRef sp) (take maxPids . ((p,mh) :))
+    modifySpawner $ (take maxPids . ((p,mh) :))
  where
     -- TODO this is silly, search for a better solution
     mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs
               | otherwise = "exec " ++ xs
     metaChars = "&|;"
-
diff --git a/XMonad/Config/Sjanssen.hs b/XMonad/Config/Sjanssen.hs
index ba7d11b..be5a72b 100644
--- a/XMonad/Config/Sjanssen.hs
+++ b/XMonad/Config/Sjanssen.hs
@@ -21,7 +21,7 @@ import XMonad.Layout.TwoPane
 import qualified Data.Map as M
 
 sjanssenConfig = do
-    sp <- mkSpawner :: IO Spawner
+    sp <- mkSpawner
     return . ewmh $ defaultConfig
         { terminal = "exec urxvt"
         , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
@@ -30,13 +30,12 @@ sjanssenConfig = do
                 , ((modm, button2), (\w -> focus w >> windows W.swapMaster))
                 , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]
         , keys = \c -> mykeys sp c `M.union` keys defaultConfig c
-        , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog
         , layoutHook  = modifiers layouts
         , manageHook  = composeAll [className =? x --> doShift w
                                     | (x, w) <- [ ("Firefox", "web")
                                                 , ("Ktorrent", "7")
                                                 , ("Amarokapp", "7")]]
-                        <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn sp
+                        <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn
                         <+> (isFullscreen --> doFullFloat)
         }
  where
@@ -44,9 +43,9 @@ sjanssenConfig = do
     layouts   = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme
     modifiers = avoidStruts . smartBorders
 
-    mykeys sp (XConfig {modMask = modm}) = M.fromList $
-        [((modm,               xK_p     ), shellPromptHere sp myPromptConfig)
-        ,((modm .|. shiftMask, xK_Return), spawnHere sp =<< asks (terminal . config))
+    mykeys (XConfig {modMask = modm}) = M.fromList $
+        [((modm,               xK_p     ), shellPromptHere myPromptConfig)
+        ,((modm .|. shiftMask, xK_Return), spawnHere =<< asks (terminal . config))
         ,((modm .|. shiftMask, xK_c     ), kill1)
         ,((modm .|. shiftMask .|. controlMask, xK_c     ), kill)
         ,((modm .|. shiftMask, xK_0     ), windows $ copyToAll)
diff --git a/XMonad/Hooks/DynamicHooks.hs b/XMonad/Hooks/DynamicHooks.hs
index f4751d9..9d4d776 100644
--- a/XMonad/Hooks/DynamicHooks.hs
+++ b/XMonad/Hooks/DynamicHooks.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.DynamicHooks
@@ -15,20 +16,18 @@
 module XMonad.Hooks.DynamicHooks (
   -- * Usage
   -- $usage
-  initDynamicHooks
-  ,dynamicMasterHook
+  dynamicMasterHook
   ,addDynamicHook
   ,updateDynamicHook
   ,oneShotHook
   ) where
 
 import XMonad
-import System.IO
+import XMonad.Util.ExtensibleState
 
 import Data.List
 import Data.Maybe (listToMaybe)
 import Data.Monoid
-import Data.IORef
 
 -- $usage
 -- Provides two new kinds of 'ManageHooks' that can be defined at runtime.
@@ -40,68 +39,46 @@ import Data.IORef
 -- Note that you will lose all dynamically defined 'ManageHook's when you @mod+q@!
 -- If you want them to last, you should create them as normal in your @xmonad.hs@.
 --
--- First, you must execute 'initDynamicHooks' from 'main' in your @xmonad.hs@:
+-- To use this module, add 'dynamicMasterHook' to your 'manageHook':
 --
--- > dynHooksRef <- initDynamicHooks
+-- > xmonad { manageHook = myManageHook <+> dynamicMasterHook }
 --
--- and then pass this value to the other functions in this module.
+-- You can then use the supplied functions in your keybindings:
 --
--- You also need to add the base 'ManageHook':
---
--- > xmonad { manageHook = myManageHook <+> dynamicMasterHook dynHooksRef }
---
--- You must include this @dynHooksRef@ value when using the functions in this
--- module:
---
--- > xmonad { keys = myKeys `Data.Map.union` Data.Map.fromList
--- >                   [((modm, xK_i), oneShotHook dynHooksRef
--- >                    "FFlaunchHook" (className =? "firefox") (doShift "3")
--- >                    >> spawn "firefox")
--- >                   ,((modm, xK_u), addDynamicHook dynHooksRef
--- >                     (className =? "example" --> doFloat))
--- >                   ,((modm, xK_y), updatePermanentHook dynHooksRef
--- >                     (const idHook))) ]  -- resets the permanent hook.
+-- > ((modMask,xK_a), oneShotHook (className =? "example") doFloat)
 --
 
 data DynamicHooks = DynamicHooks
     { transients :: [(Query Bool, ManageHook)]
     , permanent  :: ManageHook }
+                    deriving Typeable
 
+instance ExtensionClass DynamicHooks where
+    initialValue = DynamicHooks [] idHook
 
--- | Creates the 'IORef' that stores the dynamically created 'ManageHook's.
-initDynamicHooks :: IO (IORef DynamicHooks)
-initDynamicHooks = newIORef (DynamicHooks { transients = [],
-                                            permanent = idHook })
-
-
--- this hook is always executed, and the IORef's contents checked.
+-- this hook is always executed, and the contents of the stored hooks checked.
 -- note that transient hooks are run second, therefore taking precedence
 -- over permanent ones on matters such as which workspace to shift to.
 -- doFloat and doIgnore are idempotent.
 -- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'.
-dynamicMasterHook :: IORef DynamicHooks -> ManageHook
-dynamicMasterHook ref = return True -->
-                  (ask >>= \w -> liftX (do
-  dh <- io $ readIORef ref
+dynamicMasterHook :: ManageHook
+dynamicMasterHook = (ask >>= \w -> liftX (do
+  dh <- getState
   (Endo f)  <- runQuery (permanent dh) w
   ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh)
   let (ts',nts) = partition fst ts
   gs <- mapM (flip runQuery w . snd . snd) ts'
   let (Endo g) = maybe (Endo id) id $ listToMaybe gs
-  io $ writeIORef ref $ dh { transients = map snd nts }
+  putState $ dh { transients = map snd nts }
   return $ Endo $ f . g
                                        ))
-
 -- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'.
-addDynamicHook :: IORef DynamicHooks -> ManageHook -> X ()
-addDynamicHook ref m = updateDynamicHook ref (<+> m)
-
+addDynamicHook :: ManageHook -> X ()
+addDynamicHook m = updateDynamicHook (<+> m)
 
 -- | Modifies the permanent 'ManageHook' with an arbitrary function.
-updateDynamicHook :: IORef DynamicHooks -> (ManageHook -> ManageHook) -> X ()
-updateDynamicHook ref f =
-    io $ modifyIORef ref $ \dh -> dh { permanent = f (permanent dh) }
-
+updateDynamicHook :: (ManageHook -> ManageHook) -> X ()
+updateDynamicHook f = modifyState $ \dh -> dh { permanent = f (permanent dh) }
 
 -- | Creates a one-shot 'ManageHook'. Note that you have to specify the two
 -- parts of the 'ManageHook' separately. Where you would usually write:
@@ -112,11 +89,5 @@ updateDynamicHook ref f =
 --
 -- > oneShotHook dynHooksRef (className =? "example) doFloat
 --
-oneShotHook :: IORef DynamicHooks -> Query Bool -> ManageHook -> X ()
-oneShotHook ref q a =
-  io $ modifyIORef ref
-         $ \dh -> dh { transients = (q,a):(transients dh) }
-
-
-
-
+oneShotHook :: Query Bool -> ManageHook -> X ()
+oneShotHook q a = modifyState $ \dh -> dh { transients = (q,a):(transients dh) }
diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs
index 7faacc4..c69cecf 100644
--- a/XMonad/Hooks/UrgencyHook.hs
+++ b/XMonad/Hooks/UrgencyHook.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}
+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards, DeriveDataTypeable,
+  FlexibleInstances #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -71,17 +72,16 @@ import XMonad
 import qualified XMonad.StackSet as W
 
 import XMonad.Util.Dzen (dzenWithArgs, seconds)
+import XMonad.Util.ExtensibleState
 import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
 
 import Control.Applicative ((<$>))
 import Control.Monad (when)
 import Data.Bits (testBit)
-import Data.IORef
 import Data.List (delete)
 import Data.Maybe (listToMaybe, maybeToList)
 import qualified Data.Set as S
-import Foreign (unsafePerformIO)
 
 -- $usage
 --
@@ -213,6 +213,15 @@ withUrgencyHookC hook urgConf conf = conf {
         logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf
     }
 
+data Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable)
+
+onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents
+onUrgents f = Urgents . f . fromUrgents
+
+instance ExtensionClass Urgents where
+    initialValue = Urgents []
+    extensionType = PersistentExtension
+
 -- | Global configuration, applied to all types of 'UrgencyHook'. See
 -- 'urgencyConfig' for the defaults.
 data UrgencyConfig = UrgencyConfig
@@ -262,25 +271,18 @@ focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMayb
 clearUrgents :: X ()
 clearUrgents = adjustUrgents (const []) >> adjustReminders (const [])
 
--- | Stores the global set of all urgent windows, across workspaces. Not exported -- use
--- 'readUrgents' or 'withUrgents' instead.
-{-# NOINLINE urgents #-}
-urgents :: IORef [Window]
-urgents = unsafePerformIO (newIORef [])
--- (Hey, I don't like it any more than you do.)
-
 -- | X action that returns a list of currently urgent windows. You might use
 -- it, or 'withUrgents', in your custom logHook, to display the workspaces that
 -- contain urgent windows.
 readUrgents :: X [Window]
-readUrgents = io $ readIORef urgents
+readUrgents = fromUrgents <$> getState
 
 -- | An HOF version of 'readUrgents', for those who prefer that sort of thing.
 withUrgents :: ([Window] -> X a) -> X a
 withUrgents f = readUrgents >>= f
 
 adjustUrgents :: ([Window] -> [Window]) -> X ()
-adjustUrgents f = io $ modifyIORef urgents f
+adjustUrgents f = modifyState $ onUrgents f
 
 type Interval = Rational
 
@@ -290,18 +292,19 @@ data Reminder = Reminder { timer     :: TimerId
                          , window    :: Window
                          , interval  :: Interval
                          , remaining :: Maybe Int
-                         } deriving Eq
+                         } deriving (Show,Read,Eq,Typeable)
+
+instance ExtensionClass [Reminder] where
+    initialValue = []
+    extensionType = PersistentExtension
 
 -- | Stores the list of urgency reminders.
-{-# NOINLINE reminders #-}
-reminders :: IORef [Reminder]
-reminders = unsafePerformIO (newIORef [])
 
 readReminders :: X [Reminder]
-readReminders = io $ readIORef reminders
+readReminders = getState
 
 adjustReminders :: ([Reminder] -> [Reminder]) -> X ()
-adjustReminders f = io $ modifyIORef reminders f
+adjustReminders f = modifyState f
 
 clearUrgency :: Window -> X ()
 clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)
@@ -332,7 +335,7 @@ handleEvent wuh event =
                   callUrgencyHook wuh w
                 else
                   clearUrgency w
-              userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified
+              userCodeDef () =<< asks (logHook . config)
       DestroyWindowEvent {ev_window = w} ->
           clearUrgency w
       _ ->