From 1fbaaa7ce69ed6320693c389bf670fd3cf20cdd1 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 12 Apr 2022 01:05:48 -0600 Subject: Move Rahm.Desktop.Layout.Layout to Rahm.Desktop.Layout --- src/Rahm/Desktop/Layout/Redescribe.hs | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 src/Rahm/Desktop/Layout/Redescribe.hs (limited to 'src/Rahm/Desktop/Layout/Redescribe.hs') diff --git a/src/Rahm/Desktop/Layout/Redescribe.hs b/src/Rahm/Desktop/Layout/Redescribe.hs new file mode 100644 index 0000000..c5c7472 --- /dev/null +++ b/src/Rahm/Desktop/Layout/Redescribe.hs @@ -0,0 +1,35 @@ + +-- Module to enable redescribing layouts. Unlike LayoutModifiers though, this +-- class is aware of the underlying type as it may need to access some internals +-- to generate the new description. +module Rahm.Desktop.Layout.Redescribe where + +import XMonad + +import qualified XMonad.StackSet as W +import Data.Typeable (Typeable) + +-- Type-class to modify the description of a layout. +class Describer m l where + + -- Returns the new description from the given description modifier, the layout + -- and the existing description. + newDescription :: m -> l a -> String -> String + +-- With a DescriptionModifier, +data Redescribe m l a = Redescribe m (l a) + deriving (Show, Read) + +-- Delegates to the underlying Layout, except for the description +instance (Typeable m, Show m, Describer m l, LayoutClass l a) => + LayoutClass (Redescribe m l) a where + + runLayout (W.Workspace t (Redescribe m l) a) rect = do + (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect + return (rects, fmap (Redescribe m) maybeNewLayout) + + handleMessage (Redescribe m l) a = do + maybeNewLayout <- handleMessage l a + return (Redescribe m <$> maybeNewLayout) + + description (Redescribe m l) = newDescription m l (description l) -- cgit