xmonad-contrib-0.16.999: Community-maintained extensions extensions for xmonad
Copyright(c) 2021 Tomáš Janoušek <tomi@nomi.cz>
LicenseBSD3
MaintainerTomáš Janoušek <tomi@nomi.cz>
Safe HaskellNone
LanguageHaskell98

XMonad.Util.ExtensibleConf

Description

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

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 (MyConf [i]) $ \c -> c{ logHook = logHook c <> lh }
  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.

add Source #

Arguments

:: (Semigroup a, Typeable a) 
=> a

configuration to add

-> XConfig l 
-> XConfig l 

Config-time: Add (append) a piece of custom configuration to an XConfig using the Semigroup instance of the configuration type.

once Source #

Arguments

:: forall a l. (Semigroup a, Typeable a) 
=> (XConfig l -> XConfig l)

XConfig modification done only once

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

onceM Source #

Arguments

:: forall a l m. (Applicative m, Semigroup a, Typeable a) 
=> (XConfig l -> m (XConfig l))

XConfig modification done only once

-> a

configuration to add

-> XConfig l 
-> m (XConfig l) 

Config-time: Applicative (monadic) variant of once, useful if the XConfig modification needs to do some IO (e.g. create an IORef).

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.

modifyDef Source #

Arguments

:: forall a l. (Default a, Typeable a) 
=> (a -> a)

modification of configuration

-> XConfig l 
-> XConfig l 

Config-time: Modify a configuration value in XConfig, initializing it to its Default value first if absent. This is an alternative to add for when a Semigroup instance is unavailable or unsuitable.

Note that this must not be used together with any variant of once!

modifyDefM Source #

Arguments

:: forall a l m. (Applicative m, Default a, Typeable a) 
=> (a -> m a)

modification of configuration

-> XConfig l 
-> m (XConfig l) 

Config-time: Applicative (monadic) variant of modifyDef, useful if the configuration value modification needs to do some IO (e.g. create an IORef).

Note that this must not be used together with any variant of once!

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.

alter :: forall a l. Typeable a => (Maybe a -> Maybe a) -> XConfig l -> XConfig l Source #

Config-time: Alter a configuration value, or absence thereof.

alterF :: forall a l f. (Typeable a, Functor f) => (Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l) Source #

Config-time: Functor variant of alter, useful if the configuration modifications needs to do some IO.