X.U.ExtensibleConf: New helper module for extensible config

It's often difficult to make contrib modules work together. When one
depends on a functionality of another, it is often necessary to expose
lots of low-level functions and hooks and have the user combine these
into a complex configuration that works. This is error-prone, and
arguably a bad UX in general.

This commit presents a simple solution to that problem inspired by
"extensible state": extensible config. 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
other use cases I haven't thought of yet.

This requires changes to xmonad core: xmonad/xmonad#294

A couple examples of what this gives us:

* [X.H.RescreenHook](xmonad#460)
  can be made safe to apply multiple times, making it composable and
  usable in other contrib modules like X.H.StatusBar

* `withSB` from X.H.StatusBar can also be made safe to apply multiple
  times, and we can even provide an API [similar to what we had
  before](https://hackage.haskell.org/package/xmonad-contrib-0.16/docs/XMonad-Hooks-DynamicLog.html#v:statusBar)
  if we want (probably not, consistency with the new dynamic status bars
  of xmonad#463 is more important)

* The [X.H.EwmhDesktops refactor](xmonad#399)
  can possibly be made without breaking the `ewmh`/`ewmhFullscreen` API.
  And we will finally be able to have composable EWMH hooks.

Related: xmonad/xmonad#294

CHANGES.md

@@ -231,6 +231,13 @@
     additional capability to schedule/deadline a task, or use the
     primary selection as the contents of the note.
 
+  * `XMonad.Util.ExtensibleConf`
+
+    Extensible and composable configuration for contrib modules. 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.
+
 ### Bug Fixes and Minor Changes
 
   * Add support for GHC 9.0.1.

XMonad/Doc/Extending.hs

@@ -1171,6 +1171,12 @@ A non complete list with a brief description:
     Configure key bindings easily, including a
     parser for writing key bindings in "M-C-x" style.
 
+* "XMonad.Util.ExtensibleConf":
+    Extensible and composable configuration for contrib modules. Allows
+    contrib modules to store custom configuration values inside
+    'XMonad.Core.XConfig'. This lets them create custom hooks, ensure they
+    hook into xmonad core only once, and possibly more.
+
 * "XMonad.Util.ExtensibleState":
     Module for storing custom mutable state in xmonad.
 

XMonad/Util/ExtensibleConf.hs

@@ -0,0 +1,124 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+-- |
+-- Module      :  XMonad.Util.ExtensibleConf
+-- Copyright   :  (c) 2021 Tomáš Janoušek <[email protected]>
+-- License     :  BSD3
+-- Maintainer  :  Tomáš Janoušek <[email protected]>
+--
+-- 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.
+--
+
+module XMonad.Util.ExtensibleConf (
+    -- * Usage
+    -- $usage
+
+    -- * High-level idioms
+    with,
+    add,
+    once,
+    onceM,
+
+    -- * Low-level primitivies
+    ask,
+    lookup,
+    alter,
+    ) where
+
+import Prelude hiding (lookup)
+import XMonad hiding (ask)
+
+import Data.Typeable
+import qualified Data.Map as M
+
+
+-- ---------------------------------------------------------------------
+-- $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'.
+
+
+-- ---------------------------------------------------------------------
+-- Low-level primitivies
+
+-- | Run-time: Retrieve a configuration value of the requested type.
+ask :: (MonadReader XConf m, Typeable a) => m (Maybe a)
+ask = asks $ lookup . config
+
+-- | Config-time: Retrieve a configuration value of the requested type.
+lookup :: Typeable a => XConfig l -> Maybe a
+lookup c = let x = fromConfExt =<< typeRep x `M.lookup` extensibleConf c in x
+
+-- | Config-time: Alter a configuration value, or absence thereof.
+alter :: Typeable a => (Maybe a -> Maybe a) -> XConfig l -> XConfig l
+alter f c = c{ extensibleConf = M.alter f' t (extensibleConf c) }
+  where
+    f' :: Maybe ConfExtension -> Maybe ConfExtension
+    f' = fmap ConfExtension . f . (>>= fromConfExt)
+    t = typeRep (f undefined)
+
+fromConfExt :: Typeable a => ConfExtension -> Maybe a
+fromConfExt (ConfExtension val) = cast val
+
+
+-- ---------------------------------------------------------------------
+-- High-level idioms
+
+-- | Run-time: Run a monadic action with the value of the custom
+-- configuration, if set.
+with :: (MonadReader XConf m, Typeable a, Monoid b) => (a -> m b) -> m b
+with a = ask >>= maybe (pure mempty) a
+
+-- | Config-time: Add (append) a piece of custom configuration to an 'XConfig'
+-- using the 'Semigroup' instance of the configuration type.
+add :: (Semigroup a, Typeable a)
+    => a -- ^ configuration to add
+    -> XConfig l -> XConfig l
+add x = alter (<> Just x)
+
+-- | 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.
+once :: (Semigroup a, Typeable a)
+     => a -- ^ configuration to add
+     -> (XConfig l -> XConfig l) -- ^ 'XConfig' modification done only once
+     -> XConfig l -> XConfig l
+once x f c = add x $ maybe f (const id) (lookup c `asTypeOf` Just x) c
+
+-- | Config-time: Applicative (monadic) variant of 'once', useful if the
+-- 'XConfig' modification needs to do some 'IO' (e.g. create an
+-- 'Data.IORef.IORef').
+onceM :: (Applicative m, Semigroup a, Typeable a)
+      => a -- ^ configuration to add
+      -> (XConfig l -> m (XConfig l)) -- ^ 'XConfig' modification done only once
+      -> XConfig l -> m (XConfig l)
+onceM x f c = add x <$> maybe f (const pure) (lookup c `asTypeOf` Just x) c

tests/ExtensibleConf.hs

@@ -0,0 +1,31 @@
+{-# OPTIONS_GHC -Wall #-}
+module ExtensibleConf where
+
+import Test.Hspec
+
+import XMonad
+import qualified XMonad.Util.ExtensibleConf as XC
+
+spec :: Spec
+spec = do
+    specify "lookup" $
+        XC.lookup def `shouldBe` (Nothing :: Maybe ())
+    specify "lookup . add" $
+        XC.lookup (XC.add "a" def) `shouldBe` Just "a"
+    specify "lookup . add . add" $
+        XC.lookup (XC.add "b" (XC.add "a" def)) `shouldBe` Just "ab"
+    specify "lookup @String . add @String . add @[Int]" $
+        XC.lookup (XC.add "a" (XC.add [1 :: Int] def)) `shouldBe` Just "a"
+    specify "lookup @[Int] . add @String . add @[Int]" $
+        XC.lookup (XC.add "a" (XC.add [1 :: Int] def)) `shouldBe` Just [1 :: Int]
+    specify "lookup @() . add @String . add @[Int]" $
+        XC.lookup (XC.add "a" (XC.add [1 :: Int] def)) `shouldBe` (Nothing :: Maybe ())
+
+    specify "once" $
+        borderWidth (XC.once "a" incBorderWidth def) `shouldBe` succ (borderWidth def)
+    specify "once . once" $
+        borderWidth (XC.once "b" incBorderWidth (XC.once "a" incBorderWidth def))
+            `shouldBe` succ (borderWidth def)
+
+incBorderWidth :: XConfig l -> XConfig l
+incBorderWidth c = c{ borderWidth = succ (borderWidth c) }

tests/Main.hs

@@ -3,6 +3,7 @@ module Main where
 import Test.Hspec
 import Test.Hspec.QuickCheck
 
+import qualified ExtensibleConf
 import qualified ManageDocks
 import qualified NoBorders
 import qualified RotateSome
@@ -43,3 +44,4 @@ main = hspec $ do
         prop "prop_spliInSubListsAt" $ XPrompt.prop_spliInSubListsAt
         prop "prop_skipGetLastWord"  $ XPrompt.prop_skipGetLastWord
     context "NoBorders" $ NoBorders.spec
+    context "ExtensibleConf" $ ExtensibleConf.spec

xmonad-contrib.cabal

@@ -331,6 +331,7 @@ library
                         XMonad.Util.Dzen
                         XMonad.Util.EZConfig
                         XMonad.Util.ExclusiveScratchpads
+                        XMonad.Util.ExtensibleConf
                         XMonad.Util.ExtensibleState
                         XMonad.Util.Font
                         XMonad.Util.Hacks
@@ -378,6 +379,7 @@ test-suite tests
                   XPrompt
                   Instances
                   Utils
+                  ExtensibleConf
                   XMonad.Actions.CycleWS
                   XMonad.Actions.FocusNth
                   XMonad.Actions.PhysicalScreens
@@ -392,6 +394,7 @@ test-suite tests
                   XMonad.Prelude
                   XMonad.Prompt
                   XMonad.Prompt.Shell
+                  XMonad.Util.ExtensibleConf
                   XMonad.Util.ExtensibleState
                   XMonad.Util.Font
                   XMonad.Util.Image