diff options
Diffstat (limited to 'src/Rahm')
| -rw-r--r-- | src/Rahm/Desktop/Keys.hs | 2 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Layout.hs (renamed from src/Rahm/Desktop/Layout/Layout.hs) | 2 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Layout/Redescribe.hs | 35 |
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) |