twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-15 20:23:55 -07:00
Code Issues Packages Projects Releases Wiki Activity

Changed interface of X.U.ExtensibleState

Browse Source 
Changed the interface of X.U.ExtensibleState to resemble that of
Control.Monad.State and modified the modules that use it accordingly.
This commit is contained in:
Daniel Schoepe
2009-11-16 17:10:13 +00:00
parent b881934a02
commit 30a78d51e3
9 changed files with 54 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
XMonad/Util/ExtensibleState.hs
View File

@@ -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)