From e8c2239f6fe58b4a9bacd3bfed984841bb860a27 Mon Sep 17 00:00:00 2001
From: Daniel Schoepe <daniel.schoepe@gmail.com>
Date: Mon, 16 Nov 2009 18:10:13 +0100
Subject: Changed interface of X.U.ExtensibleState

Ignore-this: 9a830f9341e461628974890bab0bd65b

Changed the interface of X.U.ExtensibleState to resemble that of
Control.Monad.State and modified the modules that use it accordingly.

darcs-hash:20091116171013-7f603-0631dc163d78785b123bc10164ee3295add28b60.gz
---
 XMonad/Actions/SpawnOn.hs          |  6 +++---
 XMonad/Actions/TopicSpace.hs       |  7 +++----
 XMonad/Hooks/DynamicHooks.hs       | 10 ++++-----
 XMonad/Hooks/FloatNext.hs          | 16 +++++++-------
 XMonad/Hooks/PositionStoreHooks.hs |  2 --
 XMonad/Hooks/UrgencyHook.hs        | 10 ++++-----
 XMonad/Util/ExtensibleState.hs     | 43 +++++++++++++++++++++-----------------
 XMonad/Util/PositionStore.hs       |  8 +++----
 XMonad/Util/SpawnOnce.hs           |  6 +++---
 9 files changed, 54 insertions(+), 54 deletions(-)

diff --git a/XMonad/Actions/SpawnOn.hs b/XMonad/Actions/SpawnOn.hs
index bdec270..d7500b2 100644
--- a/XMonad/Actions/SpawnOn.hs
+++ b/XMonad/Actions/SpawnOn.hs
@@ -36,7 +36,7 @@ import qualified XMonad.StackSet as W
 import XMonad.Hooks.ManageHelpers
 import XMonad.Prompt
 import XMonad.Prompt.Shell
-import XMonad.Util.ExtensibleState
+import qualified XMonad.Util.ExtensibleState as XS
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -71,13 +71,13 @@ maxPids = 5
 
 -- | 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
+modifySpawner f = XS.modify (Spawner . f . pidsRef)
 
 -- | Provides a manage hook to react on process spawned with
 -- 'spawnOn', 'spawnHere' etc.
 manageSpawn :: ManageHook
 manageSpawn = do
-    Spawner pids <- liftX getState
+    Spawner pids <- liftX XS.get
     mp <- pid
     case flip lookup pids =<< mp of
         Nothing -> idHook
diff --git a/XMonad/Actions/TopicSpace.hs b/XMonad/Actions/TopicSpace.hs
index 78b4e73..de0fb3c 100644
--- a/XMonad/Actions/TopicSpace.hs
+++ b/XMonad/Actions/TopicSpace.hs
@@ -45,7 +45,6 @@ import Data.Maybe (fromMaybe, isNothing, listToMaybe)
 import Data.Ord
 import qualified Data.Map as M
 import Control.Monad ((=<<),liftM2,when,unless,replicateM_)
-import Control.Applicative ((<$>))
 import System.IO
 
 import XMonad.Operations
@@ -59,7 +58,7 @@ import XMonad.Hooks.DynamicLog (PP(..))
 import qualified XMonad.Hooks.DynamicLog as DL
 
 import XMonad.Util.Run (spawnPipe)
-import XMonad.Util.ExtensibleState
+import qualified XMonad.Util.ExtensibleState as XS
 
 -- $overview
 -- This module allows to organize your workspaces on a precise topic basis.  So
@@ -222,14 +221,14 @@ instance ExtensionClass PrevTopics where
 
 -- | Returns the list of last focused workspaces the empty list otherwise.
 getLastFocusedTopics :: X [String]
-getLastFocusedTopics = getPrevTopics <$> getState
+getLastFocusedTopics = XS.gets getPrevTopics
 
 -- | Given a 'TopicConfig', the last focused topic, and a predicate that will
 -- select topics that one want to keep, this function will set the property
 -- of last focused topics.
 setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
 setLastFocusedTopic tg w predicate =
-  modifyState $ PrevTopics
+  XS.modify $ PrevTopics
     . take (maxTopicHistory tg) . nub . (w:) . filter predicate
     . getPrevTopics
 
diff --git a/XMonad/Hooks/DynamicHooks.hs b/XMonad/Hooks/DynamicHooks.hs
index 9d4d776..a2a0b7e 100644
--- a/XMonad/Hooks/DynamicHooks.hs
+++ b/XMonad/Hooks/DynamicHooks.hs
@@ -23,7 +23,7 @@ module XMonad.Hooks.DynamicHooks (
   ) where
 
 import XMonad
-import XMonad.Util.ExtensibleState
+import qualified XMonad.Util.ExtensibleState as XS
 
 import Data.List
 import Data.Maybe (listToMaybe)
@@ -63,13 +63,13 @@ instance ExtensionClass DynamicHooks where
 -- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'.
 dynamicMasterHook :: ManageHook
 dynamicMasterHook = (ask >>= \w -> liftX (do
-  dh <- getState
+  dh <- XS.get
   (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
-  putState $ dh { transients = map snd nts }
+  XS.put $ dh { transients = map snd nts }
   return $ Endo $ f . g
                                        ))
 -- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'.
@@ -78,7 +78,7 @@ addDynamicHook m = updateDynamicHook (<+> m)
 
 -- | Modifies the permanent 'ManageHook' with an arbitrary function.
 updateDynamicHook :: (ManageHook -> ManageHook) -> X ()
-updateDynamicHook f = modifyState $ \dh -> dh { permanent = f (permanent dh) }
+updateDynamicHook f = XS.modify $ \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:
@@ -90,4 +90,4 @@ updateDynamicHook f = modifyState $ \dh -> dh { permanent = f (permanent dh) }
 -- > oneShotHook dynHooksRef (className =? "example) doFloat
 --
 oneShotHook :: Query Bool -> ManageHook -> X ()
-oneShotHook q a = modifyState $ \dh -> dh { transients = (q,a):(transients dh) }
+oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):(transients dh) }
diff --git a/XMonad/Hooks/FloatNext.hs b/XMonad/Hooks/FloatNext.hs
index 1d7fa86..7a555ea 100644
--- a/XMonad/Hooks/FloatNext.hs
+++ b/XMonad/Hooks/FloatNext.hs
@@ -39,7 +39,7 @@ module XMonad.Hooks.FloatNext ( -- * Usage
 import Prelude hiding (all)
 
 import XMonad
-import XMonad.Util.ExtensibleState
+import qualified XMonad.Util.ExtensibleState as XS
 
 import Control.Monad (join,guard)
 import Control.Applicative ((<$>))
@@ -48,13 +48,13 @@ import Control.Arrow (first, second)
 {- Helper functions -}
 
 _set :: ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
-_set f b = modifyState' (f $ const b)
+_set f b = modify' (f $ const b)
 
 _toggle :: ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
-_toggle f = modifyState' (f not)
+_toggle f = modify' (f not)
 
 _get :: ((Bool, Bool) -> a) -> X a
-_get f = f . getFloatMode <$> getState
+_get f = XS.gets (f . getFloatMode)
 
 _pp :: ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)
 _pp f s st = (\b -> guard b >> Just (st s)) <$> _get f
@@ -66,8 +66,8 @@ data FloatMode = FloatMode { getFloatMode :: (Bool,Bool) } deriving (Typeable)
 instance ExtensionClass FloatMode where
     initialValue = FloatMode (False,False)
 
-modifyState' :: ((Bool,Bool) -> (Bool,Bool)) -> X ()
-modifyState' f = modifyState (FloatMode . f . getFloatMode)
+modify' :: ((Bool,Bool) -> (Bool,Bool)) -> X ()
+modify' f = XS.modify (FloatMode . f . getFloatMode)
 
 -- $usage
 -- This module provides actions (that can be set as keybindings)
@@ -95,8 +95,8 @@ modifyState' f = modifyState (FloatMode . f . getFloatMode)
 -- | This 'ManageHook' will selectively float windows as set
 -- by 'floatNext' and 'floatAllNew'.
 floatNextHook :: ManageHook
-floatNextHook = do (next, all) <- liftX $ getFloatMode <$> getState
-                   liftX $ putState $ FloatMode (False, all)
+floatNextHook = do (next, all) <- liftX $ XS.gets getFloatMode
+                   liftX $ XS.put $ FloatMode (False, all)
                    if next || all then doFloat else idHook
 
 -- | @floatNext True@ arranges for the next spawned window to be
diff --git a/XMonad/Hooks/PositionStoreHooks.hs b/XMonad/Hooks/PositionStoreHooks.hs
index 92ad0ae..60fb448 100644
--- a/XMonad/Hooks/PositionStoreHooks.hs
+++ b/XMonad/Hooks/PositionStoreHooks.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE PatternSignatures #-}
-
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.PositionStoreHooks
diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs
index 6a150c8..7dcdf18 100644
--- a/XMonad/Hooks/UrgencyHook.hs
+++ b/XMonad/Hooks/UrgencyHook.hs
@@ -72,7 +72,7 @@ import XMonad
 import qualified XMonad.StackSet as W
 
 import XMonad.Util.Dzen (dzenWithArgs, seconds)
-import XMonad.Util.ExtensibleState
+import qualified XMonad.Util.ExtensibleState as XS
 import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
 
@@ -275,14 +275,14 @@ clearUrgents = adjustUrgents (const []) >> adjustReminders (const [])
 -- it, or 'withUrgents', in your custom logHook, to display the workspaces that
 -- contain urgent windows.
 readUrgents :: X [Window]
-readUrgents = fromUrgents <$> getState
+readUrgents = XS.gets fromUrgents
 
 -- | 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 = modifyState $ onUrgents f
+adjustUrgents = XS.modify . onUrgents
 
 type Interval = Rational
 
@@ -301,10 +301,10 @@ instance ExtensionClass [Reminder] where
 -- | Stores the list of urgency reminders.
 
 readReminders :: X [Reminder]
-readReminders = getState
+readReminders = XS.get
 
 adjustReminders :: ([Reminder] -> [Reminder]) -> X ()
-adjustReminders f = modifyState f
+adjustReminders = XS.modify
 
 clearUrgency :: Window -> X ()
 clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)
diff --git a/XMonad/Util/ExtensibleState.hs b/XMonad/Util/ExtensibleState.hs
index 2c4db86..0ac05d6 100644
--- a/XMonad/Util/ExtensibleState.hs
+++ b/XMonad/Util/ExtensibleState.hs
@@ -15,16 +15,17 @@
 module XMonad.Util.ExtensibleState (
                               -- * Usage
                               -- $usage
-                              putState
-                              , modifyState
-                              , removeState
-                              , getState
+                              put
+                              , modify
+                              , remove
+                              , get
+                              , gets
                               ) where
 
 import Data.Typeable (typeOf,Typeable,cast)
 import qualified Data.Map as M
 import XMonad.Core
-import Control.Monad.State
+import qualified Control.Monad.State as State
 
 -- ---------------------------------------------------------------------
 -- $usage
@@ -34,21 +35,22 @@ import Control.Monad.State
 -- the functions from this module for storing your data:
 --
 -- > {-# LANGUAGE DeriveDataTypeable #-}
+-- > import qualified XMonad.Util.ExtensibleState as XS
 -- >
 -- > data ListStorage = ListStorage [Integer] deriving Typeable
 -- > instance ExtensionClass ListStorage where
 -- >   initialValue = ListStorage []
 -- >
--- > .. putState (ListStorage [23,42])
+-- > .. XS.put (ListStorage [23,42])
 --
 -- To retrieve the stored data call:
 --
--- > .. getState
+-- > .. XS.get
 --
 -- If the type can't be infered from the usage of the retrieved data, you
 -- might need to add an explicit type signature:
 --
--- > .. getState :: X ListStorage
+-- > .. XS.get :: X ListStorage
 --
 -- To make your data persistent between restarts, the data type needs to be
 -- an instance of Read and Show and the instance declaration has to be changed:
@@ -71,26 +73,26 @@ import Control.Monad.State
 modifyStateExts :: (M.Map String (Either String StateExtension)
                    -> M.Map String (Either String StateExtension))
                 -> X ()
-modifyStateExts f = modify $ \st -> st { extensibleState = f (extensibleState st) }
+modifyStateExts f = State.modify $ \st -> st { extensibleState = f (extensibleState st) }
 
 -- | Apply a function to a stored value of the matching type or the initial value if there
 -- is none.
-modifyState :: ExtensionClass a => (a -> a) -> X ()
-modifyState f = putState . f =<< getState
+modify :: ExtensionClass a => (a -> a) -> X ()
+modify f = put . f =<< get
 
 -- | Add a value to the extensible state field. A previously stored value with the same
 -- type will be overwritten. (More precisely: A value whose string representation of its type
 -- is equal to the new one's)
-putState :: ExtensionClass a => a -> X ()
-putState v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v
+put :: ExtensionClass a => a -> X ()
+put v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v
 
 -- | Try to retrieve a value of the requested type, return an initial value if there is no such value.
-getState :: ExtensionClass a => X a
-getState = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables
+get :: ExtensionClass a => X a
+get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables
   where toValue val = maybe initialValue id $ cast val
         getState' :: ExtensionClass a => a -> X a
         getState' k = do
-          v <- gets $ M.lookup (show . typeOf $ k) . extensibleState
+          v <- State.gets $ M.lookup (show . typeOf $ k) . extensibleState
           case v of
             Just (Right (StateExtension val)) -> return $ toValue val
             Just (Right (PersistentExtension val)) -> return $ toValue val
@@ -98,7 +100,7 @@ getState = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables
                                 PersistentExtension x -> do
                                   let val = maybe initialValue id $
                                             cast =<< safeRead str `asTypeOf` (Just x)
-                                  putState (val `asTypeOf` k)
+                                  put (val `asTypeOf` k)
                                   return val
                                 _ -> return $ initialValue
             _ -> return $ initialValue
@@ -106,6 +108,9 @@ getState = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables
                          [(x,"")] -> Just x
                          _ -> Nothing
 
+gets :: ExtensionClass a => (a -> b) -> X b
+gets = flip fmap get
+
 -- | Remove the value from the extensible state field that has the same type as the supplied argument
-removeState :: ExtensionClass a => a -> X ()
-removeState wit = modifyStateExts $ M.delete (show . typeOf $ wit)
+remove :: ExtensionClass a => a -> X ()
+remove wit = modifyStateExts $ M.delete (show . typeOf $ wit)
diff --git a/XMonad/Util/PositionStore.hs b/XMonad/Util/PositionStore.hs
index 4844039..830f068 100644
--- a/XMonad/Util/PositionStore.hs
+++ b/XMonad/Util/PositionStore.hs
@@ -26,7 +26,7 @@ module XMonad.Util.PositionStore (
     ) where
 
 import XMonad
-import XMonad.Util.ExtensibleState
+import qualified XMonad.Util.ExtensibleState as XS
 import Graphics.X11.Xlib
 import Graphics.X11.Types
 import Data.Typeable
@@ -46,12 +46,10 @@ instance ExtensionClass PositionStore where
   extensionType = PersistentExtension
 
 getPosStore :: X (PositionStore)
-getPosStore = getState
+getPosStore = XS.get
 
 modifyPosStore :: (PositionStore -> PositionStore) -> X ()
-modifyPosStore f = do
-    posStore <- getState
-    putState (f posStore)
+modifyPosStore = XS.modify
 
 posStoreInsert :: PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore
 posStoreInsert (PS posStoreMap) w (Rectangle x y wh ht) (Rectangle srX srY srWh srHt) =
diff --git a/XMonad/Util/SpawnOnce.hs b/XMonad/Util/SpawnOnce.hs
index fc05222..f958c18 100644
--- a/XMonad/Util/SpawnOnce.hs
+++ b/XMonad/Util/SpawnOnce.hs
@@ -19,7 +19,7 @@ module XMonad.Util.SpawnOnce (spawnOnce) where
 
 import XMonad
 import Data.Set as Set
-import XMonad.Util.ExtensibleState
+import qualified XMonad.Util.ExtensibleState as XS
 import Control.Monad
 
 data SpawnOnce = SpawnOnce { unspawnOnce :: (Set String) }
@@ -33,7 +33,7 @@ instance ExtensionClass SpawnOnce where
 -- command is executed.  Subsequent invocations for a command do nothing.
 spawnOnce :: String -> X ()
 spawnOnce xs = do
-    b <- fmap (Set.member xs . unspawnOnce) getState
+    b <- XS.gets (Set.member xs . unspawnOnce)
     when (not b) $ do
         spawn xs
-        modifyState (SpawnOnce . Set.insert xs . unspawnOnce)
+        XS.modify (SpawnOnce . Set.insert xs . unspawnOnce)
-- 
cgit v1.2.3