New module: X.L.ConditionalLayout

CHANGES.md

@@ -81,7 +81,14 @@
 
 ### New Modules
 
+  * `XMonad.Layout.ConditionalLayout`
+
+	- Provide conditional variants of `ModifiedLayout` and `Choose`,
+      so that modifications (specific layouts) are only applied when
+      a particular condition is met.
+
   * `XMonad.Layout.CenterMainFluid`
+
     - A three column layout with main column in the center and two stack
       column surrounding it. Master window will be on center column and
       spaces on the sides are reserved.

XMonad/Layout/ConditionalLayout.hs

@@ -0,0 +1,175 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{- |
+   Module       : XMonad.Layout.ConditionalLayout
+   Description  : Conditionally apply layout and layout modifiers.
+   Copyright    : (c) Ivan Malison   <IvanMalison@gmail.com>,
+                      Tomas Janousek <tomi@nomi.cz>
+   License      : BSD
+   Maintainer   : Tony Zorman <soliditsallgood@mailbox.org>
+
+   This module provides conditional variants of 'ModifiedLayout' and 'Choose',
+   so that modifications (specific layouts) are only applied when a particular
+   condition is met.
+-}
+module XMonad.Layout.ConditionalLayout (
+  -- * Usage
+  -- $usage
+
+  -- * Combinators
+  condChoose,
+  conditional,
+
+  -- * Building Conditions
+  ModifierCondition (shouldApply),
+  CondChoose, -- opaque
+
+  -- * Utility functions
+  getWorkspace,
+  getWorkspaceWindows,
+  getScreen,
+) where
+
+import XMonad hiding (hide)
+import XMonad.Layout.LayoutModifier
+import XMonad.Prelude
+import XMonad.StackSet (Workspace)
+import qualified XMonad.StackSet as W
+
+{- $usage
+
+You can use this module by importing it in your @xmonad.hs@
+
+> import XMonad.Layout.ConditionalLayout
+
+and writing an appropriate condition. Then, when 'conditional' is used,
+a layout modifier will be applied whenever the condition is true.
+Alternatively, 'condChoose' can decide which of two given layouts is to
+be applied.
+
+Defining a condition works by creating a new type, and making it an
+instance of 'ModifierCondition'. For example, the following condition
+checks whether there are a maximum of two windows on the current
+workspace:
+
+> import Data.List
+>
+> import XMonad
+> import XMonad.Layout.ConditionalLayout
+> import qualified XMonad.StackSet as W
+>
+> data IfMax2 = IfMax2 deriving (Read, Show)
+>
+> instance ModifierCondition IfMax2 where
+>   shouldApply _ wsId = do
+>     wsWins <- getWorkspaceWindows wsId
+>     pure $ Just 2 >= (length <$> ws)
+
+the @IfMax2@ type can now be used with the provided combinators. To
+apply tabs, one would write
+
+> import XMonad.Layout.Tabbed
+>
+> main :: IO ()
+> main = xmonad $ def
+>   { terminal   = "urxvt"
+>   , layoutHook = conditional IfMax2 (addTabsAlways shrinkText def) $ layoutHook def
+>   }
+
+alternatively, to conditionally switch between two layouts:
+
+>                  -- Full for workspaces with more than 2 windows, Tall otherwise.
+>   , layoutHook = condChoose IfMax2 (Tall 1 (3/100) (1/2)) Full $ layoutHook def
+-}
+
+-- | Conditionally apply a layout modifier.
+--
+-- > conditional MyCond myModifier myLayout
+conditional :: ModifierCondition c => c -> (l a -> l' a) -> l a -> CondChoose c l' l a
+conditional c ml l = CondChoose True c (Choose CL (ml l) l)
+
+-- | Conditionally choose between two layouts.
+--
+-- > condChoose MyCond myLayoutTrue myLayoutFalse
+condChoose :: c -> l a -> r a -> CondChoose c l r a
+condChoose c = CondChoose True c .: Choose CL
+
+-- 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
+-- 'CondModifiedLayout', 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 type classes.
+
+-- | A 'ModifierCondition' is a condition run in 'X' that takes a 'WorkspaceId'
+-- as a parameter.
+class (Read c, Show c) => ModifierCondition c where
+  shouldApply :: c -> WorkspaceId -> X Bool
+
+-- | 'ModifiedLayout' extended with a condition and its last evaluation result
+-- (for methods that can't evaluate it).
+data CondModifiedLayout c m l a = CondModifiedLayout !Bool !c !(ModifiedLayout m l a)
+  deriving (Read, Show)
+
+-- | 'Choose' extended with a condition.
+data CondChoose c l r a = CondChoose !Bool !c !(Choose l r a)
+  deriving (Read, Show)
+
+instance (ModifierCondition c, LayoutClass l a, LayoutClass r a, Typeable c)
+  => LayoutClass (CondChoose c l r) a
+ where
+  runLayout :: (ModifierCondition c, LayoutClass l a, LayoutClass r a, Typeable c)
+           => Workspace WorkspaceId (CondChoose c l r a) a
+           -> Rectangle
+           -> X ([(a, Rectangle)], Maybe (CondChoose c l r a))
+  runLayout (W.Workspace i cl@(CondChoose b c _) ms) rect = do
+    a <- shouldApply c i
+    cl' <- if a == b then pure Nothing else Just . switch <$> hide cl
+    fmap (<|> cl') <$> run (fromMaybe cl cl')
+   where
+    switch :: CondChoose c l r a -> CondChoose c l r a
+    switch (CondChoose b' c' ch') = CondChoose (not b') c' ch'
+
+    run :: CondChoose c l r a -> X ([(a, Rectangle)], Maybe (CondChoose c l r a))
+    run (CondChoose preferLeft c' (Choose _ l r)) =
+      fmap (fmap (CondChoose preferLeft c'))
+        <$> runLayout (W.Workspace i (Choose (decideSide preferLeft) l r) ms) rect
+
+  handleMessage :: CondChoose c l r a -> SomeMessage -> X (Maybe (CondChoose c l r a))
+  handleMessage (CondChoose a c ch@(Choose _ l r)) m
+    | Just ReleaseResources <- fromMessage m =
+        fmap (CondChoose a c) <$> handleMessage ch m
+    | Just NextLayout <- fromMessage m =
+        fmap (CondChoose a c) <$> handleMessage ch m
+    | otherwise =
+        fmap (CondChoose a c) <$> handleMessage (Choose (decideSide a) l r) m
+
+  description :: CondChoose c l r a -> String
+  description (CondChoose a _ (Choose _ l r))
+    | a         = description l
+    | otherwise = description r
+
+------------------------------------------------------------------------
+-- Util
+
+decideSide :: Bool -> CLR
+decideSide = \case
+  True  -> CL
+  False -> CR
+
+hide :: LayoutClass l a => l a -> X (l a)
+hide x = fromMaybe x <$> handleMessage x (SomeMessage Hide)
+
+getWorkspace :: WorkspaceId -> X (Maybe WindowSpace)
+getWorkspace wsId = gets $ find ((wsId ==) . W.tag) . W.workspaces . windowset
+
+getWorkspaceWindows :: WorkspaceId -> X (Maybe [Window])
+getWorkspaceWindows wsId = fmap (W.integrate' . W.stack) <$> getWorkspace wsId
+
+getScreen :: WorkspaceId -> X (Maybe WindowScreen)
+getScreen wsId =
+  find (\s -> wsId == W.tag (W.workspace s)) <$> gets (W.screens . windowset)

XMonad/Layout/IfMax.hs

@@ -1,3 +1,9 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.IfMax
@@ -15,8 +21,6 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, PatternGuards #-}
-
 module XMonad.Layout.IfMax
     ( -- * Usage
       -- $usage
@@ -29,6 +33,7 @@ import qualified Data.List as L
 import qualified Data.Map  as M
 
 import XMonad
+import XMonad.Layout.ConditionalLayout
 import XMonad.Prelude
 import qualified XMonad.StackSet as W
 
@@ -42,14 +47,15 @@ import qualified XMonad.StackSet as W
 --
 -- Then add layouts to your layoutHook:
 --
--- > myLayoutHook = IfMax 2 Full (Tall ...) ||| ...
+-- > myLayoutHook = ifMax 2 Full (Tall ...) ||| ...
 --
 -- In this example, if there are 1 or 2 windows, Full layout will be used;
 -- otherwise, Tall layout will be used.
 --
 
 data IfMax l1 l2 w = IfMax Int (l1 w) (l2 w)
   deriving (Read, Show)
+{-# DEPRECATED IfMax  "Use ifMax instead." #-}
 
 instance (LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (IfMax l1 l2) Window where
 
@@ -85,10 +91,18 @@ instance (LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (IfMax l1
   description (IfMax n l1 l2) = "If number of windows is <= " ++ show n ++ ", then " ++
                                 description l1 ++ ", else " ++ description l2
 
+newtype IfMaxN = IfMaxN Int deriving (Read, Show)
+
+instance ModifierCondition IfMaxN where
+    shouldApply :: IfMaxN -> WorkspaceId -> X Bool
+    shouldApply (IfMaxN n) wsId = do
+        ws <- fmap length <$> getWorkspaceWindows wsId
+        pure $ Just n >= ws
+
 -- | Layout itself
 ifMax :: (LayoutClass l1 w, LayoutClass l2 w)
       => Int            -- ^ Maximum number of windows for the first layout
       -> l1 w           -- ^ First layout
       -> l2 w           -- ^ Second layout
-      -> IfMax l1 l2 w
-ifMax = IfMax
+      -> CondChoose IfMaxN l1 l2 w
+ifMax n = condChoose (IfMaxN n)

XMonad/Layout/PerScreen.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -24,9 +26,9 @@ module XMonad.Layout.PerScreen
     ) where
 
 import XMonad
-import qualified XMonad.StackSet as W
-
+import XMonad.Layout.ConditionalLayout
 import XMonad.Prelude (fromMaybe)
+import qualified XMonad.StackSet as W
 
 -- $usage
 -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
@@ -41,13 +43,23 @@ import XMonad.Prelude (fromMaybe)
 -- ifWider can also be used inside other layout combinators.
 
 ifWider :: (LayoutClass l1 a, LayoutClass l2 a)
-               => Dimension   -- ^ target screen width
-               -> l1 a        -- ^ layout to use when the screen is wide enough
-               -> l2 a        -- ^ layout to use otherwise
-               -> PerScreen l1 l2 a
-ifWider w = PerScreen w False
+        => Dimension   -- ^ target screen width
+        -> l1 a        -- ^ layout to use when the screen is wide enough
+        -> l2 a        -- ^ layout to use otherwise
+        -> CondChoose PerScreenCond l1 l2 a
+ifWider w = condChoose (PerScreenCond w)
+
+newtype PerScreenCond = PerScreenCond Dimension
+    deriving (Read, Show)
+
+instance ModifierCondition PerScreenCond where
+    shouldApply :: PerScreenCond -> WorkspaceId -> X Bool
+    shouldApply (PerScreenCond w) wsId = do
+        r <- fmap (rect_width . screenRect . W.screenDetail) <$> getScreen wsId
+        pure $ r > Just w
 
 data PerScreen l1 l2 a = PerScreen Dimension Bool (l1 a) (l2 a) deriving (Read, Show)
+{-# DEPRECATED PerScreen  "ifWider now uses X.L.ConditionalLayout internally." #-}
 
 -- | Construct new PerScreen values with possibly modified layouts.
 mkNewPerScreenT :: PerScreen l1 l2 a -> Maybe (l1 a) ->

XMonad/Layout/PerWorkspace.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -24,9 +26,9 @@ module XMonad.Layout.PerWorkspace
     ) where
 
 import XMonad
-import qualified XMonad.StackSet as W
-
+import XMonad.Layout.ConditionalLayout
 import XMonad.Prelude (fromMaybe)
+import qualified XMonad.StackSet as W
 
 -- $usage
 -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
@@ -52,14 +54,21 @@ import XMonad.Prelude (fromMaybe)
 --
 -- > layoutHook = A ||| B ||| onWorkspace "foo" D C
 
+newtype PerWorkspaceCond = PerWorkspaceCond [WorkspaceId]
+    deriving (Read, Show)
+
+instance ModifierCondition PerWorkspaceCond where
+    shouldApply :: PerWorkspaceCond -> WorkspaceId -> X Bool
+    shouldApply (PerWorkspaceCond ws) wsId = pure $ wsId `elem` ws
+
 -- | Specify one layout to use on a particular workspace, and another
 --   to use on all others.  The second layout can be another call to
 --   'onWorkspace', and so on.
 onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a)
                => WorkspaceId -- ^ the tag of the workspace to match
                -> l1 a        -- ^ layout to use on the matched workspace
                -> l2 a        -- ^ layout to use everywhere else
-               -> PerWorkspace l1 l2 a
+               -> CondChoose PerWorkspaceCond l1 l2 a
 onWorkspace wsId = onWorkspaces [wsId]
 
 -- | Specify one layout to use on a particular set of workspaces, and
@@ -68,7 +77,7 @@ onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a)
                 => [WorkspaceId]  -- ^ tags of workspaces to match
                 -> l1 a           -- ^ layout to use on matched workspaces
                 -> l2 a           -- ^ layout to use everywhere else
-                -> PerWorkspace l1 l2 a
+                -> CondChoose PerWorkspaceCond l1 l2 a
 onWorkspaces wsIds = modWorkspaces wsIds . const
 
 -- | Specify a layout modifier to apply to a particular workspace; layouts
@@ -77,18 +86,18 @@ modWorkspace :: (LayoutClass l1 a, LayoutClass l2 a)
              => WorkspaceId    -- ^ tag of the workspace to match
              -> (l2 a -> l1 a)  -- ^ the modifier to apply on the matching workspace
              -> l2 a           -- ^ the base layout
-             -> PerWorkspace l1 l2 a
+             -> CondChoose PerWorkspaceCond l1 l2 a
 modWorkspace wsId = modWorkspaces [wsId]
 
 -- | Specify a layout modifier to apply to a particular set of
 --   workspaces; layouts on all other workspaces will remain
 --   unmodified.
 modWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a)
-              => [WorkspaceId] -- ^ tags of the workspaces to match
+              => [WorkspaceId]  -- ^ tags of the workspaces to match
               -> (l2 a -> l1 a) -- ^ the modifier to apply on the matching workspaces
-              -> l2 a          -- ^ the base layout
-              -> PerWorkspace l1 l2 a
-modWorkspaces wsIds f l = PerWorkspace wsIds False (f l) l
+              -> l2 a           -- ^ the base layout
+              -> CondChoose PerWorkspaceCond l1 l2 a
+modWorkspaces wsIds = conditional (PerWorkspaceCond wsIds)
 
 -- | Structure for representing a workspace-specific layout along with
 -- a layout for all other workspaces. We store the tags of workspaces
@@ -99,6 +108,7 @@ data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId]
                                          (l1 a)
                                          (l2 a)
     deriving (Read, Show)
+{-# DEPRECATED PerWorkspace "X.L.PerWorkspace now uses X.L.ConditionalLayout." #-}
 
 instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerWorkspace l1 l2) a where
     runLayout (W.Workspace i p@(PerWorkspace wsIds _ lt lf) ms) r

xmonad-contrib.cabal

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