Copyright | (c) 2021 Tomáš Janoušek <tomi@nomi.cz> |
---|---|
License | BSD3 |
Maintainer | Tomáš Janoušek <tomi@nomi.cz> |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Extensible and composable configuration for contrib modules.
This is the configuration counterpart of XMonad.Util.ExtensibleState. It
allows contrib modules to store custom configuration values inside
XConfig
. This lets them create custom hooks, ensure they hook into xmonad
core only once, and possibly more.
Synopsis
- with :: (MonadReader XConf m, Typeable a, Monoid b) => (a -> m b) -> m b
- add :: (Semigroup a, Typeable a) => a -> XConfig l -> XConfig l
- once :: forall a l. (Semigroup a, Typeable a) => (XConfig l -> XConfig l) -> a -> XConfig l -> XConfig l
- onceM :: forall a l m. (Applicative m, Semigroup a, Typeable a) => (XConfig l -> m (XConfig l)) -> a -> XConfig l -> m (XConfig l)
- withDef :: (MonadReader XConf m, Typeable a, Default a) => (a -> m b) -> m b
- modifyDef :: forall a l. (Default a, Typeable a) => (a -> a) -> XConfig l -> XConfig l
- modifyDefM :: forall a l m. (Applicative m, Default a, Typeable a) => (a -> m a) -> XConfig l -> m (XConfig l)
- ask :: (MonadReader XConf m, Typeable a) => m (Maybe a)
- lookup :: forall a l. Typeable a => XConfig l -> Maybe a
- alter :: forall a l. Typeable a => (Maybe a -> Maybe a) -> XConfig l -> XConfig l
- alterF :: forall a l f. (Typeable a, Functor f) => (Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l)
Usage
To utilize this feature in a contrib module, create a data type for the configuration, then use the helper functions provided here to implement a user-friendly composable interface for your contrib module.
Example:
import qualified XMonad.Util.ExtensibleConf as XC {-# LANGUAGE GeneralizedNewtypeDeriving #-} newtype MyConf = MyConf{ fromMyConf :: [Int] } deriving Semigroup customLogger :: Int -> XConfig l -> XConfig l customLogger i = XC.once (\c -> c{ logHook = logHook c <> lh }) (MyConf [i]) where lh :: X () lh = XC.with $ io . print . fromMyConf
The above defines an xmonad configuration combinator that can be applied any number of times like so:
main = xmonad $ … . customLogger 1 . ewmh . customLogger 2 . … $ def{…}
and will always result in just one print
invocation in logHook
.
High-level idioms based on Semigroup
with :: (MonadReader XConf m, Typeable a, Monoid b) => (a -> m b) -> m b Source #
Run-time: Run a monadic action with the value of the custom configuration, if set.
:: forall a l. (Semigroup a, Typeable a) | |
=> (XConfig l -> XConfig l) |
|
-> a | configuration to add |
-> XConfig l | |
-> XConfig l |
Config-time: add
a piece of custom configuration, and if it's the first
piece of this type, also modify the XConfig
using the provided function.
This can be used to implement a composable interface for modules that must only hook into xmonad core once.
(The piece of custom configuration is the last argument as it's expected to come from the user.)
High-level idioms based on Default
withDef :: (MonadReader XConf m, Typeable a, Default a) => (a -> m b) -> m b Source #
Run-time: Run a monadic action with the value of the custom
configuration, or the Default
value thereof, if absent.
:: forall a l m. (Applicative m, Default a, Typeable a) | |
=> (a -> m a) | modification of configuration |
-> XConfig l | |
-> m (XConfig l) |
Low-level primitivies
ask :: (MonadReader XConf m, Typeable a) => m (Maybe a) Source #
Run-time: Retrieve a configuration value of the requested type.
lookup :: forall a l. Typeable a => XConfig l -> Maybe a Source #
Config-time: Retrieve a configuration value of the requested type.