vanadium/xmonad: refactor

nix/configurations/vanadium/home/xmonad/lib/XMonad/Layout/Reflect/Message.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module XMonad.Layout.Reflect.Message where
+
+import XMonad (
+  Resize (Expand, Shrink),
+  SomeMessage (SomeMessage),
+  fromMessage,
+ )
+
+import XMonad.Layout.LayoutModifier (
+  LayoutModifier (handleMess, handleMessOrMaybeModifyIt),
+  ModifiedLayout (ModifiedLayout),
+ )
+
+data ReflectMsg a = ReflectMsg deriving (Show, Read)
+
+reflectMsg :: l a -> ModifiedLayout ReflectMsg l a
+reflectMsg = ModifiedLayout ReflectMsg
+
+instance LayoutModifier ReflectMsg a where
+  handleMessOrMaybeModifyIt m mess
+    | Just Shrink <- fromMessage mess = return . Just . Right $ SomeMessage Expand
+    | Just Expand <- fromMessage mess = return . Just . Right $ SomeMessage Shrink
+    -- Handle the rest by passing it on
+    | otherwise = do
+        mm <- handleMess m mess
+        return (Left <$> mm)

nix/configurations/vanadium/home/xmonad/lib/XMonad/Layout/ResizableTile/FixDescription.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+module XMonad.Layout.ResizableTile.FixDescription
+  ( RTFixDescription(..)
+  ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Layout.ResizableTile
+
+newtype RTFixDescription a = RTFixDescription { unwrapRT :: ResizableTall a }
+    deriving (Read, Show)
+
+instance LayoutClass RTFixDescription a where
+  runLayout (W.Workspace t l s) =
+    let ws' = W.Workspace t (unwrapRT l) s
+    in fmap (fmap (fmap RTFixDescription))
+       . runLayout ws'
+
+  handleMessage (RTFixDescription l) m =
+    fmap (fmap RTFixDescription)
+    $ handleMessage l m
+
+  description (RTFixDescription l) =
+    description l <> " " <> show (_nmaster l)