{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module XMonad.Util.ExtensibleConf (
with,
add,
once,
onceM,
withDef,
modifyDef,
modifyDefM,
ask,
lookup,
alter,
alterF,
) where
import Prelude hiding (lookup)
import XMonad hiding (ask, modify, trace)
import XMonad.Prelude ((<|>), (<&>), fromMaybe)
import Data.Typeable
import qualified Data.Map as M
ask :: (MonadReader XConf m, Typeable a) => m (Maybe a)
ask :: forall (m :: * -> *) a.
(MonadReader XConf m, Typeable a) =>
m (Maybe a)
ask = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall a (l :: * -> *). Typeable a => XConfig l -> Maybe a
lookup forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config
lookup :: forall a l. Typeable a => XConfig l -> Maybe a
lookup :: forall a (l :: * -> *). Typeable a => XConfig l -> Maybe a
lookup XConfig l
c = forall a. Typeable a => ConfExtension -> Maybe a
fromConfExt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @a) forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` forall (l :: * -> *). XConfig l -> Map TypeRep ConfExtension
extensibleConf XConfig l
c
alter :: forall a l. Typeable a => (Maybe a -> Maybe a) -> XConfig l -> XConfig l
alter :: forall a (l :: * -> *).
Typeable a =>
(Maybe a -> Maybe a) -> XConfig l -> XConfig l
alter Maybe a -> Maybe a
f = forall {l :: * -> *}.
(Map TypeRep ConfExtension -> Map TypeRep ConfExtension)
-> XConfig l -> XConfig l
mapEC forall a b. (a -> b) -> a -> b
$ forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (forall a.
Typeable a =>
(Maybe a -> Maybe a) -> Maybe ConfExtension -> Maybe ConfExtension
mapConfExt Maybe a -> Maybe a
f) (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @a))
where
mapEC :: (Map TypeRep ConfExtension -> Map TypeRep ConfExtension)
-> XConfig l -> XConfig l
mapEC Map TypeRep ConfExtension -> Map TypeRep ConfExtension
g XConfig l
c = XConfig l
c{ extensibleConf :: Map TypeRep ConfExtension
extensibleConf = Map TypeRep ConfExtension -> Map TypeRep ConfExtension
g (forall (l :: * -> *). XConfig l -> Map TypeRep ConfExtension
extensibleConf XConfig l
c) }
alterF :: forall a l f. (Typeable a, Functor f)
=> (Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l)
alterF :: forall a (l :: * -> *) (f :: * -> *).
(Typeable a, Functor f) =>
(Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l)
alterF Maybe a -> f (Maybe a)
f = forall {f :: * -> *} {l :: * -> *}.
Functor f =>
(Map TypeRep ConfExtension -> f (Map TypeRep ConfExtension))
-> XConfig l -> f (XConfig l)
mapEC forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF (forall a (f :: * -> *).
(Typeable a, Functor f) =>
(Maybe a -> f (Maybe a))
-> Maybe ConfExtension -> f (Maybe ConfExtension)
mapConfExtF Maybe a -> f (Maybe a)
f) (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @a))
where
mapEC :: (Map TypeRep ConfExtension -> f (Map TypeRep ConfExtension))
-> XConfig l -> f (XConfig l)
mapEC Map TypeRep ConfExtension -> f (Map TypeRep ConfExtension)
g XConfig l
c = Map TypeRep ConfExtension -> f (Map TypeRep ConfExtension)
g (forall (l :: * -> *). XConfig l -> Map TypeRep ConfExtension
extensibleConf XConfig l
c) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Map TypeRep ConfExtension
ec -> XConfig l
c{ extensibleConf :: Map TypeRep ConfExtension
extensibleConf = Map TypeRep ConfExtension
ec }
fromConfExt :: Typeable a => ConfExtension -> Maybe a
fromConfExt :: forall a. Typeable a => ConfExtension -> Maybe a
fromConfExt (ConfExtension a
val) = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
val
mapConfExt :: Typeable a
=> (Maybe a -> Maybe a) -> Maybe ConfExtension -> Maybe ConfExtension
mapConfExt :: forall a.
Typeable a =>
(Maybe a -> Maybe a) -> Maybe ConfExtension -> Maybe ConfExtension
mapConfExt Maybe a -> Maybe a
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Typeable a => a -> ConfExtension
ConfExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Maybe a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Typeable a => ConfExtension -> Maybe a
fromConfExt)
mapConfExtF :: (Typeable a, Functor f)
=> (Maybe a -> f (Maybe a)) -> Maybe ConfExtension -> f (Maybe ConfExtension)
mapConfExtF :: forall a (f :: * -> *).
(Typeable a, Functor f) =>
(Maybe a -> f (Maybe a))
-> Maybe ConfExtension -> f (Maybe ConfExtension)
mapConfExtF Maybe a -> f (Maybe a)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Typeable a => a -> ConfExtension
ConfExtension) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> f (Maybe a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Typeable a => ConfExtension -> Maybe a
fromConfExt)
with :: (MonadReader XConf m, Typeable a, Monoid b) => (a -> m b) -> m b
with :: forall (m :: * -> *) a b.
(MonadReader XConf m, Typeable a, Monoid b) =>
(a -> m b) -> m b
with a -> m b
a = forall (m :: * -> *) a.
(MonadReader XConf m, Typeable a) =>
m (Maybe a)
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) a -> m b
a
add :: (Semigroup a, Typeable a)
=> a
-> XConfig l -> XConfig l
add :: forall a (l :: * -> *).
(Semigroup a, Typeable a) =>
a -> XConfig l -> XConfig l
add a
x = forall a (l :: * -> *).
Typeable a =>
(Maybe a -> Maybe a) -> XConfig l -> XConfig l
alter (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just a
x)
once :: forall a l. (Semigroup a, Typeable a)
=> (XConfig l -> XConfig l)
-> a
-> XConfig l -> XConfig l
once :: forall a (l :: * -> *).
(Semigroup a, Typeable a) =>
(XConfig l -> XConfig l) -> a -> XConfig l -> XConfig l
once XConfig l -> XConfig l
f a
x XConfig l
c = forall b a. b -> (a -> b) -> Maybe a -> b
maybe XConfig l -> XConfig l
f (forall a b. a -> b -> a
const forall a. a -> a
id) (forall a (l :: * -> *). Typeable a => XConfig l -> Maybe a
lookup @a XConfig l
c) forall a b. (a -> b) -> a -> b
$ forall a (l :: * -> *).
(Semigroup a, Typeable a) =>
a -> XConfig l -> XConfig l
add a
x XConfig l
c
onceM :: forall a l m. (Applicative m, Semigroup a, Typeable a)
=> (XConfig l -> m (XConfig l))
-> a
-> XConfig l -> m (XConfig l)
onceM :: forall a (l :: * -> *) (m :: * -> *).
(Applicative m, Semigroup a, Typeable a) =>
(XConfig l -> m (XConfig l)) -> a -> XConfig l -> m (XConfig l)
onceM XConfig l -> m (XConfig l)
f a
x XConfig l
c = forall b a. b -> (a -> b) -> Maybe a -> b
maybe XConfig l -> m (XConfig l)
f (forall a b. a -> b -> a
const forall (f :: * -> *) a. Applicative f => a -> f a
pure) (forall a (l :: * -> *). Typeable a => XConfig l -> Maybe a
lookup @a XConfig l
c) forall a b. (a -> b) -> a -> b
$ forall a (l :: * -> *).
(Semigroup a, Typeable a) =>
a -> XConfig l -> XConfig l
add a
x XConfig l
c
withDef :: (MonadReader XConf m, Typeable a, Default a) => (a -> m b) -> m b
withDef :: forall (m :: * -> *) a b.
(MonadReader XConf m, Typeable a, Default a) =>
(a -> m b) -> m b
withDef a -> m b
a = forall (m :: * -> *) a.
(MonadReader XConf m, Typeable a) =>
m (Maybe a)
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def
modifyDef :: forall a l. (Default a, Typeable a)
=> (a -> a)
-> XConfig l -> XConfig l
modifyDef :: forall a (l :: * -> *).
(Default a, Typeable a) =>
(a -> a) -> XConfig l -> XConfig l
modifyDef a -> a
f = forall a (l :: * -> *).
Typeable a =>
(Maybe a -> Maybe a) -> XConfig l -> XConfig l
alter ((a -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just forall a. Default a => a
def))
modifyDefM :: forall a l m. (Applicative m, Default a, Typeable a)
=> (a -> m a)
-> XConfig l -> m (XConfig l)
modifyDefM :: forall a (l :: * -> *) (m :: * -> *).
(Applicative m, Default a, Typeable a) =>
(a -> m a) -> XConfig l -> m (XConfig l)
modifyDefM a -> m a
f = forall a (l :: * -> *) (f :: * -> *).
(Typeable a, Functor f) =>
(Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l)
alterF (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just forall a. Default a => a
def))