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

2 files changed, 65 insertions, 79 deletions

diff --git a/XMonad/Layout/LayoutCombinators.hs b/XMonad/Layout/LayoutCombinators.hs
index d21af6d..67c09b0 100644
--- a/XMonad/Layout/LayoutCombinators.hs
+++ b/XMonad/Layout/LayoutCombinators.hs
@@ -41,12 +41,9 @@ module XMonad.Layout.LayoutCombinators
       -- $nc
     , (|||)
     , JumpToLayout(JumpToLayout)
-    , LayoutCombinator (..)
-    , CombinedLayout (..)
-    , ComboChooser (..)
     ) where
 
-import Data.Maybe ( fromMaybe, isJust, isNothing )
+import Data.Maybe ( isJust, isNothing )
 
 import XMonad hiding ((|||))
 import XMonad.Layout.Combo
@@ -220,65 +217,3 @@ passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m
 
 when' :: Monad m => (a -> Bool) -> m a -> m a -> m a
 when' f a b = do a1 <- a; if f a1 then b else return a1
-
-
-data ComboChooser = DoFirst | DoSecond | DoBoth deriving ( Eq, Show )
-
-class (Read (lc a), Show (lc a)) => LayoutCombinator lc a where
-    chooser :: lc a -> X ComboChooser
-    chooser lc = return $ pureChooser lc 
-    pureChooser :: lc a -> ComboChooser
-    pureChooser _ =  DoFirst
-    combineResult :: lc a -> [(a,Rectangle)] -> [(a,Rectangle)] -> [(a,Rectangle)]
-    combineResult _ wrs1 wrs2 = wrs1 ++ wrs2
-    comboHandleMess :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> SomeMessage -> X (lc a)
-    comboHandleMess lc l1 l2 m = return $ pureComboHandleMess lc l1 l2 m
-    pureComboHandleMess :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> SomeMessage -> lc a
-    pureComboHandleMess lc _ _ _ = lc
-    sendToOther :: (LayoutClass l a) => lc a -> l a -> SomeMessage
-    sendToOther _ _ = SomeMessage Hide
-    comboDescription :: lc a -> String
-    comboDescription _ = "Combine"
-    combineDescription :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> String
-    combineDescription lc l1 l2 = comboDescription lc <> description l1 <> description l2
-        where "" <> x = x
-              x  <> y = x ++ " " ++ y
-
-data CombinedLayout lc l1 l2 a = CombinedLayout (lc a) (l1 a) (l2 a) deriving ( Show,  Read )
-
-instance (LayoutClass l1 a, LayoutClass l2 a, LayoutCombinator lc a) => LayoutClass (CombinedLayout lc l1 l2) a where
-    doLayout (CombinedLayout lc l1 l2) r s = do
-        choose <- chooser lc
-        case choose of
-          DoSecond -> do (wrs, nl2)  <- doLayout l2 r s
-                         return (wrs, Just $ CombinedLayout lc l1 (fromMaybe l2 nl2))
-          DoBoth   -> do (wrs1, nl1) <- doLayout l1 r s
-                         (wrs2, nl2) <- doLayout l2 r s
-                         return (combineResult lc wrs1 wrs2  , Just $ CombinedLayout lc (fromMaybe l1 nl1) (fromMaybe l2 nl2))
-          _        -> do (wrs, nl1)  <- doLayout l1 r s
-                         return (wrs, Just $ CombinedLayout lc (fromMaybe l1 nl1) l2)
-    emptyLayout (CombinedLayout lc l1 l2) r = do 
-        choose <- chooser lc
-        case choose of
-          DoSecond -> do (wrs, nl2)  <- emptyLayout l2 r
-                         return (wrs, Just $ CombinedLayout lc l1 (fromMaybe l2 nl2))
-          DoBoth   -> do (wrs1, nl1) <- emptyLayout l1 r
-                         (wrs2, nl2) <- emptyLayout l2 r
-                         return (combineResult lc wrs1 wrs2  , Just $ CombinedLayout lc (fromMaybe l1 nl1) (fromMaybe l2 nl2))
-          _        -> do (wrs, nl1)  <- emptyLayout l1 r
-                         return (wrs, Just $ CombinedLayout lc (fromMaybe l1 nl1) l2)
-    handleMessage (CombinedLayout lc l1 l2) m = do
-      nc     <- comboHandleMess lc l1 l2 m
-      choose <- chooser nc
-      case choose of
-        DoFirst ->  do nl1 <- handleMessage l1 m
-                       nl2 <- handleMessage l2 (sendToOther nc l2)
-                       return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2)
-        DoSecond -> do nl1 <- handleMessage l1 (sendToOther nc l1)
-                       nl2 <- handleMessage l2 m
-                       return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2)
-        DoBoth ->   do nl1 <- handleMessage l1 m
-                       nl2 <- handleMessage l2 m
-                       return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2)
-
-    description (CombinedLayout lc l1 l2) = combineDescription lc l1 l2
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