From 9db74715f20c4c9d74a4060267d793ef2c7f43f1 Mon Sep 17 00:00:00 2001
From: slotThe <soliditsallgood@mailbox.org>
Date: Wed, 2 Jun 2021 08:04:46 +0200
Subject: [PATCH] X.Layout: Simplify JumpToLayout implementation

The `choose` combinator is very general; much more so than the
combination of `switch`, `swap`, and `passOnM`.

We can thus replace most of the implementation with calls to `choose`
and properly put everything related to `JumpToLayout` under one guard.
Plus, we don't need to define any extra functions that would have to be
tested in some way.

Co-authored-by: Tomas Janousek <tomi@nomi.cz>
---
 src/XMonad/Layout.hs | 44 +++++++++-----------------------------------
 1 file changed, 9 insertions(+), 35 deletions(-)

diff --git a/src/XMonad/Layout.hs b/src/XMonad/Layout.hs
index 3f9465d..0977aa0 100644
--- a/src/XMonad/Layout.hs
+++ b/src/XMonad/Layout.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable, LambdaCase #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable, LambdaCase, MultiWayIf #-}
 
 -- --------------------------------------------------------------------------
 -- |
@@ -30,7 +30,7 @@ import Graphics.X11 (Rectangle(..))
 import qualified XMonad.StackSet as W
 import Control.Arrow ((***), second)
 import Control.Monad
-import Data.Maybe (fromMaybe, isNothing)
+import Data.Maybe (fromMaybe)
 
 ------------------------------------------------------------------------
 
@@ -177,11 +177,6 @@ data Choose l r a = Choose CLR (l a) (r a) deriving (Read, Show)
 -- | Choose the current sub-layout (left or right) in 'Choose'.
 data CLR = CL | CR deriving (Read, Show, Eq)
 
--- | Switch how to choose the layout around.
-switch :: Choose l r a -> Choose l r a
-switch (Choose CL l r) = Choose CR l r
-switch (Choose CR l r) = Choose CL l r
-
 data NextNoWrap = NextNoWrap deriving (Eq, Show)
 instance Message NextNoWrap
 
@@ -190,18 +185,6 @@ instance Message NextNoWrap
 handle :: (LayoutClass l a, Message m) => l a -> m -> X (Maybe (l a))
 handle l m = handleMessage l (SomeMessage m)
 
--- | Swap the two sub-layouts.
-swap :: (LayoutClass l a, LayoutClass r a) => Choose l r a -> X (Choose l r a)
-swap c = switch . fromMaybe c <$> passOnM (SomeMessage Hide) c
-
--- | Try to pass on 'SomeMessage' to a sub-layout.
-passOnM
-    :: (LayoutClass l a, LayoutClass r a)
-    => SomeMessage -> Choose l r a -> X (Maybe (Choose l r a))
-passOnM m = \case
-    Choose CL l r -> fmap (flip (Choose CL) r) <$> handleMessage l m
-    Choose CR l r -> fmap (Choose CR l)        <$> handleMessage r m
-
 -- | A smart constructor that takes some potential modifications, returns a
 -- new structure if any fields have changed, and performs any necessary cleanup
 -- on newly non-visible layouts.
@@ -247,22 +230,13 @@ instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
     handleMessage c@(Choose d l r) m | Just ReleaseResources <- fromMessage m =
         join $ liftM2 (choose c d) (handle l ReleaseResources) (handle r ReleaseResources)
 
-    handleMessage c@(Choose CL _ r) m
-        | Just (JumpToLayout desc) <- fromMessage m
-        , desc == description r
-        = Just <$> swap c
-
-    handleMessage c@(Choose CR l _) m
-        | Just (JumpToLayout desc) <- fromMessage m
-        , desc == description l
-        = Just <$> swap c
-
-    handleMessage c m
-        | Just JumpToLayout{} <- fromMessage m
-        = do m' <- passOnM m c
-             if isNothing m'
-                 then traverse (swap . switch) =<< passOnM m (switch c)
-                 else return m'
+    handleMessage c@(Choose d l r) m | Just (JumpToLayout desc) <- fromMessage m = do
+        ml <- handleMessage l m
+        mr <- handleMessage r m
+        let md | desc == description (fromMaybe l ml) = CL
+               | desc == description (fromMaybe r mr) = CR
+               | otherwise = d
+        choose c md ml mr
 
     handleMessage c@(Choose d l r) m = do
         ml' <- case d of