X.L.ConditionalLayoutModifier: Init

CHANGES.md

@@ -134,6 +134,12 @@
 
     Layout modifier for user provided per-window aspect ratios.
 
+  * `XMonad.Layout.ConditionModifier`
+
+	This module provides a LayoutModifier that modifies an existing
+    LayoutModifier so that its modifications are only applied when a particular
+    condition is met.
+
   * `XMonad.Hooks.TaffybarPagerHints`
 
     Add a module that exports information about XMonads internal state that is

XMonad/Layout/ConditionalLayout.hs

@@ -0,0 +1,103 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Layout.ConditionalLayout
+-- Copyright    : (c) Ivan Malison <[email protected]>
+-- License      : BSD
+--
+-- Maintainer   : none
+-- Stability    : unstable
+-- Portability  : portable
+--
+-- This module provides a LayoutModifier combinator that modifies an existing
+-- ModifiedLayout so that its modifications are only applied when a particular
+-- condition is met.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.ConditionalLayout where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import qualified XMonad.StackSet as W
+
+-- | A 'ModifierCondition' is a condition run in 'X' that takes a 'WorkspaceId'
+-- as a parameter. The reason that this must exist as a type class and a simple
+-- function will not suffice is that 'ModifierCondition's are used as parameters
+-- to 'ConditionalLayoutModifier', which must implement 'Read' and 'Show' in
+-- order to also implement 'LayoutModifier'. By defining a new type for
+-- condition, we sidestep the issue that functions can not implement these
+-- typeclasses.
+class (Read c, Show c) => ModifierCondition c where
+  shouldApply :: c -> WorkspaceId -> X Bool
+
+-- | 'ConditionalLayoutModifier' takes a condition implemented as a
+-- 'ModifierCondition' together with a 'LayoutModifier' and builds a new
+-- 'LayoutModifier' that is exactly like the provided 'LayoutModifier', except
+-- that it is only applied when the provided condition evalutes to True.
+data ConditionalLayoutModifier m c a = (Read (m a), Show (m a), ModifierCondition c) =>
+  ConditionalLayoutModifier c (m a)
+
+deriving instance (Read (m a), Show (m a), ModifierCondition c) =>
+         Show (ConditionalLayoutModifier m c a)
+deriving instance (Read (m a), Show (m a), ModifierCondition c) =>
+         Read (ConditionalLayoutModifier m c a)
+
+data NoOpModifier a = NoOpModifier deriving (Read, Show)
+
+instance LayoutModifier NoOpModifier a
+
+instance (ModifierCondition c, LayoutModifier m Window) =>
+  LayoutModifier (ConditionalLayoutModifier m c) Window where
+
+  modifyLayout (ConditionalLayoutModifier condition originalModifier) w r = do
+    applyModifier <- shouldApply condition $ W.tag w
+    if applyModifier
+      then modifyLayout originalModifier w r
+      else modifyLayout NoOpModifier w r
+
+  modifyLayoutWithUpdate (ConditionalLayoutModifier condition originalModifier) w r = do
+    applyModifier <- shouldApply condition $ W.tag w
+    if applyModifier
+      then do
+        (res, updatedModifier) <- modifyLayoutWithUpdate originalModifier w r
+        let updatedModifiedModifier =
+              ConditionalLayoutModifier condition <$> updatedModifier
+        return (res, updatedModifiedModifier)
+      else (, Nothing) . fst <$> modifyLayoutWithUpdate NoOpModifier w r
+
+  -- This function is not allowed to have any effect on layout, so we always
+  -- pass the message along to the original modifier to ensure that it is
+  -- allowed to update its internal state appropriately. This is particularly
+  -- important for messages like 'Hide' or 'ReleaseResources'.
+  handleMessOrMaybeModifyIt
+    (ConditionalLayoutModifier condition originalModifier) mess = do
+      result <- handleMessOrMaybeModifyIt originalModifier mess
+      return $ case result of
+                 Nothing -> Nothing
+                 Just (Left updated) ->
+                   Just $ Left $
+                        ConditionalLayoutModifier condition updated
+                 Just (Right message) -> Just $ Right message
+
+  redoLayoutWithWorkspace (ConditionalLayoutModifier condition originalModifier)
+                       w r ms wrs = do
+    applyModifier <- shouldApply condition $ W.tag w
+    if applyModifier
+      then do
+        (res, updatedModifier) <- redoLayout originalModifier r ms wrs
+        let updatedModifiedModifier =
+              ConditionalLayoutModifier condition <$> updatedModifier
+        return (res, updatedModifiedModifier)
+      else (, Nothing) . fst <$> redoLayout NoOpModifier r ms wrs
+
+  modifyDescription (ConditionalLayoutModifier _ originalModifier) l =
+    modifyDescription originalModifier l
+
+

XMonad/Layout/LayoutModifier.hs

@@ -188,11 +188,27 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
     redoLayout :: m a               -- ^ the layout modifier
                -> Rectangle         -- ^ screen rectangle
                -> Maybe (Stack a)   -- ^ current window stack
-               -> [(a, Rectangle)]  -- ^ (window,rectangle) pairs returned
+               -> [(a, Rectangle)]  -- ^ (window, rectangle) pairs returned
                                     -- by the underlying layout
                -> X ([(a, Rectangle)], Maybe (m a))
     redoLayout m r ms wrs = do hook m; return $ pureModifier m r ms wrs
 
+    -- | 'redoLayoutWithWorkspace' is exactly like 'redoLayout', execept
+    -- that the original workspace is also provided as an argument
+    redoLayoutWithWorkspace :: m a
+                            -- ^ the layout modifier
+                            -> Workspace WorkspaceId (ModifiedLayout m l a) a
+                            -- ^ The original workspace that is being laid out
+                            -> Rectangle
+                            -- ^ screen rectangle
+                            -> Maybe (Stack a)
+                            -- ^ current window stack
+                            -> [(a, Rectangle)]
+                            -- ^ (window, rectangle) pairs returned by the
+                            -- underlying layout
+                            -> X ([(a, Rectangle)], Maybe (m a))
+    redoLayoutWithWorkspace m _ = redoLayout m
+
     -- | 'pureModifier' allows you to intercept a call to 'runLayout'
     --   /after/ it is called on the underlying layout, in order to
     --   modify the list of window\/rectangle pairings it has returned,
@@ -251,9 +267,9 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
 -- | The 'LayoutClass' instance for a 'ModifiedLayout' defines the
 --   semantics of a 'LayoutModifier' applied to an underlying layout.
 instance (LayoutModifier m a, LayoutClass l a, Typeable m) => LayoutClass (ModifiedLayout m l) a where
-    runLayout (Workspace i (ModifiedLayout m l) ms) r =
+    runLayout w@(Workspace i (ModifiedLayout m l) ms) r =
         do ((ws, ml'),mm')  <- modifyLayoutWithUpdate m (Workspace i l ms) r
-           (ws', mm'') <- redoLayout (fromMaybe m mm') r ms ws
+           (ws', mm'') <- redoLayoutWithWorkspace (fromMaybe m mm') w r ms ws
            let ml'' = case mm'' `mplus` mm' of
                         Just m' -> Just $ ModifiedLayout m' $ fromMaybe l ml'
                         Nothing -> ModifiedLayout m <$> ml'

xmonad-contrib.cabal

@@ -213,6 +213,7 @@ library
                         XMonad.Layout.Column
                         XMonad.Layout.Combo
                         XMonad.Layout.ComboP
+                        XMonad.Layout.ConditionalLayout
                         XMonad.Layout.Cross
                         XMonad.Layout.Decoration
                         XMonad.Layout.DecorationAddons