From e8c2239f6fe58b4a9bacd3bfed984841bb860a27 Mon Sep 17 00:00:00 2001 From: Daniel Schoepe 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/Util/ExtensibleState.hs | 43 +++++++++++++++++++++++------------------- XMonad/Util/PositionStore.hs | 8 +++----- XMonad/Util/SpawnOnce.hs | 6 +++--- 3 files changed, 30 insertions(+), 27 deletions(-) (limited to 'XMonad/Util') 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