Remove LayoutCombinator class and revert PerWorkspace to its Maybe Bool state

As I said in order to have a CombinedLayout type instace of
LayoutClass and a class for easily writing pure and impure combinators
to be feeded to the CombinedLayout together with the layouts to be
conbined, there's seems to be the need to change the type of the
LayoutClass.description method from l a -> String to l a -> X String.

Without that "ugly" change - loosing the purity of the description
(please note the *every* methods of that class unless description
operates in the X monad) - I'm plainly unable to write something
really useful and maintainable. If someone can point me in the right
direction I would really really appreciate.

Since, in the meantime, PerWorkspace, which has its users, is broken
and I broke it, I'm reverting it to it supposedly more beautiful
PerWorkspac [WorkspaceId] (Maybe Bool) (l1 a) (l2 a) type.

darcs-hash:20080131063929-32816-8e37919b38c70675a90e492f0c29674061ba3968.gz

1 files changed, 64 insertions, 13 deletions

diff --git a/XMonad/Layout/PerWorkspace.hs b/XMonad/Layout/PerWorkspace.hs
index b734819..bc51a96 100644
--- a/XMonad/Layout/PerWorkspace.hs
+++ b/XMonad/Layout/PerWorkspace.hs
@@ -31,7 +31,8 @@ module XMonad.Layout.PerWorkspace (
 import XMonad
 import qualified XMonad.StackSet as W
 
-import XMonad.Layout.LayoutCombinators
+import Data.Maybe (fromMaybe)
+
 -- $usage
 -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
 --
@@ -58,19 +59,21 @@ import XMonad.Layout.LayoutCombinators
 -- | 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 :: WorkspaceId  -- ^ tags of workspaces to match
-                -> (l1 a)         -- ^ layout to use on matched workspaces
-                -> (l2 a)         -- ^ layout to use everywhere else
-                -> CombinedLayout PerWorkspace l1 l2 a
-onWorkspace wsId = CombinedLayout (PerWorkspace [wsId])
+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
+onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2
 
 -- | Specify one layout to use on a particular set of workspaces, and
 --   another to use on all other workspaces.
-onWorkspaces :: [WorkspaceId]  -- ^ tags of workspaces to match
+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
-                -> CombinedLayout PerWorkspace l1 l2 a
-onWorkspaces wsIds = CombinedLayout (PerWorkspace wsIds)
+                -> PerWorkspace l1 l2 a
+onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2
 
 -- | Structure for representing a workspace-specific layout along with
 --   a layout for all other workspaces.  We store the tags of workspaces
@@ -80,12 +83,60 @@ onWorkspaces wsIds = CombinedLayout (PerWorkspace wsIds)
 --   to be able to correctly implement the 'description' method of
 --   LayoutClass, since a call to description is not able to query the
 --   WM state to find out which workspace it was called in.
-data PerWorkspace a = PerWorkspace [WorkspaceId] deriving (Read, Show)
+data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId]
+                                         (Maybe Bool)
+                                         (l1 a)
+                                         (l2 a)
+    deriving (Read, Show)
+
+instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where
 
-instance LayoutCombinator PerWorkspace a where
-    chooser (PerWorkspace wsIds) = do
+    -- do layout with l1, then return a modified PerWorkspace caching
+    --   the fact that we're in the matched workspace.
+    doLayout p@(PerWorkspace _ (Just True) lt _) r s = do
+        (wrs, mlt') <- doLayout lt r s
+        return (wrs, Just $ mkNewPerWorkspaceT p mlt')
+
+    -- do layout with l1, then return a modified PerWorkspace caching
+    --   the fact that we're not in the matched workspace.
+    doLayout p@(PerWorkspace _ (Just False) _ lf) r s = do
+        (wrs, mlf') <- doLayout lf r s
+        return (wrs, Just $ mkNewPerWorkspaceF p mlf')
+
+    -- figure out which layout to use based on the current workspace.
+    doLayout (PerWorkspace wsIds Nothing l1 l2) r s = do
         t <- getCurrentTag
-        return $ if t `elem` wsIds then DoFirst else DoSecond
+        doLayout (PerWorkspace wsIds (Just $ t `elem` wsIds) l1 l2) r s
+
+    -- handle messages; same drill as doLayout.
+    handleMessage p@(PerWorkspace _ (Just True) lt _) m = do
+        mlt' <- handleMessage lt m
+        return . Just $ mkNewPerWorkspaceT p mlt'
+
+    handleMessage p@(PerWorkspace _ (Just False) _ lf) m = do
+        mlf' <- handleMessage lf m
+        return . Just $ mkNewPerWorkspaceF p mlf'
+
+    handleMessage (PerWorkspace _ Nothing _ _) _ = return Nothing
+
+    description (PerWorkspace _ (Just True ) l1 _) = description l1
+    description (PerWorkspace _ (Just False) _ l2) = description l2
+
+    -- description's result is not in the X monad, so we have to wait
+    -- until a doLayout for the information about which workspace
+    -- we're in to get cached.
+    description _ = "PerWorkspace"
+
+-- | Construct new PerWorkspace values with possibly modified layouts.
+mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) ->
+                      PerWorkspace l1 l2 a
+mkNewPerWorkspaceT (PerWorkspace wsIds b lt lf) mlt' =
+    (\lt' -> PerWorkspace wsIds b lt' lf) $ fromMaybe lt mlt'
+
+mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) ->
+                      PerWorkspace l1 l2 a
+mkNewPerWorkspaceF (PerWorkspace wsIds b lt lf) mlf' =
+    (\lf' -> PerWorkspace wsIds b lt lf') $ fromMaybe lf mlf'
 
 -- | Get the tag of the currently active workspace.  Note that this
 --   is only guaranteed to be the same workspace for which doLayout