Move Rahm.Desktop.Layout.Layout to Rahm.Desktop.Layout

3 files changed, 37 insertions, 2 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index c8d9092..e780fbf 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -25,7 +25,7 @@ import Data.Char
 import Data.List hiding ((!!))
 import Data.List.Safe ((!!))
 import Data.Map (Map)
-import Rahm.Desktop.Layout.Layout
+import Rahm.Desktop.Layout
 import Rahm.Desktop.Marking
 import Rahm.Desktop.PromptConfig
 import System.IO
diff --git a/src/Rahm/Desktop/Layout/Layout.hs b/src/Rahm/Desktop/Layout.hs
index 2719bea..6c9ac5a 100644
--- a/src/Rahm/Desktop/Layout/Layout.hs
+++ b/src/Rahm/Desktop/Layout.hs
@@ -1,4 +1,4 @@
-module Rahm.Desktop.Layout.Layout where
+module Rahm.Desktop.Layout where
 
 import GHC.TypeLits
 
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)