{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternGuards #-}
module XMonad.Util.ExtensibleState (
put
, modify
, modify'
, modifyM
, modifyM'
, remove
, get
, gets
, modified
, modifiedM
) where
import Data.Typeable (typeOf,cast)
import qualified Data.Map as M
import XMonad.Core
import XMonad.Util.PureX
import qualified Control.Monad.State as State
import XMonad.Prelude (fromMaybe)
modifyStateExts
:: XLike m
=> (M.Map String (Either String StateExtension)
-> M.Map String (Either String StateExtension))
-> m ()
modifyStateExts :: forall (m :: * -> *).
XLike m =>
(Map String (Either String StateExtension)
-> Map String (Either String StateExtension))
-> m ()
modifyStateExts Map String (Either String StateExtension)
-> Map String (Either String StateExtension)
f = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify forall a b. (a -> b) -> a -> b
$ \XState
st -> XState
st { extensibleState :: Map String (Either String StateExtension)
extensibleState = Map String (Either String StateExtension)
-> Map String (Either String StateExtension)
f (XState -> Map String (Either String StateExtension)
extensibleState XState
st) }
modify :: (ExtensionClass a, XLike m) => (a -> a) -> m ()
modify :: forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
modify = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> m a) -> m ()
modifyM forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
modifyM :: (ExtensionClass a, XLike m) => (a -> m a) -> m ()
modifyM :: forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> m a) -> m ()
modifyM a -> m a
f = forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
put forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m a
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
get
modify' :: (ExtensionClass a, XLike m) => (a -> a) -> m ()
modify' :: forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
modify' = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> m a) -> m ()
modifyM' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
modifyM' :: (ExtensionClass a, XLike m) => (a -> m a) -> m ()
modifyM' :: forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> m a) -> m ()
modifyM' a -> m a
f = (forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
put forall a b. (a -> b) -> a -> b
$!) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m a
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
get
put :: (ExtensionClass a, XLike m) => a -> m ()
put :: forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
put a
v = forall (m :: * -> *).
XLike m =>
(Map String (Either String StateExtension)
-> Map String (Either String StateExtension))
-> m ()
modifyStateExts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> TypeRep
typeOf forall a b. (a -> b) -> a -> b
$ a
v) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ExtensionClass a => a -> StateExtension
extensionType forall a b. (a -> b) -> a -> b
$ a
v
get :: (ExtensionClass a, XLike m) => m a
get :: forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
get = forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m a
getState' forall a. HasCallStack => a
undefined
where toValue :: a -> a
toValue a
val = forall a. a -> Maybe a -> a
fromMaybe forall a. ExtensionClass a => a
initialValue forall a b. (a -> b) -> a -> b
$ forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
val
getState' :: (ExtensionClass a, XLike m) => a -> m a
getState' :: forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m a
getState' a
k = do
Maybe (Either String StateExtension)
v <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> TypeRep
typeOf forall a b. (a -> b) -> a -> b
$ a
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> Map String (Either String StateExtension)
extensibleState
case Maybe (Either String StateExtension)
v of
Just (Right (StateExtension a
val)) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (ExtensionClass a, Typeable a) => a -> a
toValue a
val
Just (Right (PersistentExtension a
val)) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (ExtensionClass a, Typeable a) => a -> a
toValue a
val
Just (Left String
str) | PersistentExtension a
x <- forall a. ExtensionClass a => a -> StateExtension
extensionType a
k -> do
let val :: a
val = forall a. a -> Maybe a -> a
fromMaybe forall a. ExtensionClass a => a
initialValue forall a b. (a -> b) -> a -> b
$ forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {a}. Read a => String -> Maybe a
safeRead String
str forall a. a -> a -> a
`asTypeOf` forall a. a -> Maybe a
Just a
x
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
put (a
val forall a. a -> a -> a
`asTypeOf` a
k)
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
Maybe (Either String StateExtension)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. ExtensionClass a => a
initialValue
safeRead :: String -> Maybe a
safeRead String
str = case forall a. Read a => ReadS a
reads String
str of
[(a
x,String
"")] -> forall a. a -> Maybe a
Just a
x
[(a, String)]
_ -> forall a. Maybe a
Nothing
gets :: (ExtensionClass a, XLike m) => (a -> b) -> m b
gets :: forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
gets = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
get
remove :: (ExtensionClass a, XLike m) => a -> m ()
remove :: forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
remove a
wit = forall (m :: * -> *).
XLike m =>
(Map String (Either String StateExtension)
-> Map String (Either String StateExtension))
-> m ()
modifyStateExts forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
M.delete (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> TypeRep
typeOf forall a b. (a -> b) -> a -> b
$ a
wit)
modified :: (ExtensionClass a, Eq a, XLike m) => (a -> a) -> m Bool
modified :: forall a (m :: * -> *).
(ExtensionClass a, Eq a, XLike m) =>
(a -> a) -> m Bool
modified = forall a (m :: * -> *).
(ExtensionClass a, Eq a, XLike m) =>
(a -> m a) -> m Bool
modifiedM forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
modifiedM :: (ExtensionClass a, Eq a, XLike m) => (a -> m a) -> m Bool
modifiedM :: forall a (m :: * -> *).
(ExtensionClass a, Eq a, XLike m) =>
(a -> m a) -> m Bool
modifiedM a -> m a
f = do
a
v <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
get
a -> m a
f a
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
a
v' | a
v' forall a. Eq a => a -> a -> Bool
== a
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Bool
otherwise -> forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
put a
v' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True