From 664b6949c6d3454b75d1b44e746f453947418dcb Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sat, 15 May 2021 18:11:55 +0100 Subject: [PATCH] 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: https://github.com/xmonad/xmonad/pull/294 A couple examples of what this gives us: * [X.H.RescreenHook](https://github.com/xmonad/xmonad-contrib/pull/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 https://github.com/xmonad/xmonad-contrib/pull/463 is more important) * The [X.H.EwmhDesktops refactor](https://github.com/xmonad/xmonad-contrib/pull/399) can possibly be made without breaking the `ewmh`/`ewmhFullscreen` API. And we will finally be able to have composable EWMH hooks. Related: https://github.com/xmonad/xmonad/pull/294 --- CHANGES.md | 7 ++ XMonad/Doc/Extending.hs | 6 ++ XMonad/Util/ExtensibleConf.hs | 124 ++++++++++++++++++++++++++++++++++ tests/ExtensibleConf.hs | 31 +++++++++ tests/Main.hs | 2 + xmonad-contrib.cabal | 3 + 6 files changed, 173 insertions(+) create mode 100644 XMonad/Util/ExtensibleConf.hs create mode 100644 tests/ExtensibleConf.hs diff --git a/CHANGES.md b/CHANGES.md index 8100686ac9..74ff61ae6d 100644 --- a/CHANGES.md +++ b/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. diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs index 05793cc482..31e6b93387 100644 --- a/XMonad/Doc/Extending.hs +++ b/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. diff --git a/XMonad/Util/ExtensibleConf.hs b/XMonad/Util/ExtensibleConf.hs new file mode 100644 index 0000000000..1c36409609 --- /dev/null +++ b/XMonad/Util/ExtensibleConf.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE FlexibleContexts #-} + +-- | +-- Module : XMonad.Util.ExtensibleConf +-- Copyright : (c) 2021 Tomáš Janoušek +-- License : BSD3 +-- Maintainer : Tomáš Janoušek +-- +-- 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 diff --git a/tests/ExtensibleConf.hs b/tests/ExtensibleConf.hs new file mode 100644 index 0000000000..61404b4c2c --- /dev/null +++ b/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) } diff --git a/tests/Main.hs b/tests/Main.hs index 1470f9b8e7..ecc1d9c17c 100644 --- a/tests/Main.hs +++ b/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 diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 77fc630259..fe0bc1c9af 100644 --- a/xmonad-contrib.cabal +++ b/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