From 2c91ea1621563b504dc4cc43f210dc96a2c62cdf Mon Sep 17 00:00:00 2001
From: Keith <wygulmage@users.noreply.github.com>
Date: Wed, 27 Jan 2021 19:55:01 -0500
Subject: [PATCH] Add Foldable, Functor, and Traversable instances for Stack

`Functor` is provided by DeriveFunctor.
`Foldable` uses `integrate` (`Stack`'s `toList`).
`Traversable` uses the `Reverse` Applicative to traverse the `up` list in
reverse order.
---
 src/XMonad/StackSet.hs | 16 +++++++++++++++-
 xmonad.cabal           |  1 +
 2 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/src/XMonad/StackSet.hs b/src/XMonad/StackSet.hs
index c99509c..7fe0d1a 100644
--- a/src/XMonad/StackSet.hs
+++ b/src/XMonad/StackSet.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -52,6 +53,8 @@ module XMonad.StackSet (
     ) where
 
 import Prelude hiding (filter)
+import Control.Applicative.Backwards (Backwards (Backwards, forwards))
+import Data.Foldable (foldr, toList)
 import Data.Maybe   (listToMaybe,isJust,fromMaybe)
 import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
 import Data.List ( (\\) )
@@ -175,8 +178,19 @@ data RationalRect = RationalRect !Rational !Rational !Rational !Rational
 data Stack a = Stack { focus  :: !a        -- focused thing in this set
                      , up     :: [a]       -- clowns to the left
                      , down   :: [a] }     -- jokers to the right
-    deriving (Show, Read, Eq)
+    deriving (Show, Read, Eq, Functor)
 
+instance Foldable Stack where
+    toList = integrate
+    foldr f z = foldr f z . toList
+
+instance Traversable Stack where
+    traverse f s =
+        flip Stack
+            -- 'Backwards' applies the Applicative in reverse order.
+            <$> forwards (traverse (Backwards . f) (up s))
+            <*> f (focus s)
+            <*> traverse f (down s)
 
 -- | this function indicates to catch that an error is expected
 abort :: String -> a
diff --git a/xmonad.cabal b/xmonad.cabal
index dba5e5e..478589d 100644
--- a/xmonad.cabal
+++ b/xmonad.cabal
@@ -81,6 +81,7 @@ library
                  , mtl
                  , process
                  , setlocale
+                 , transformers          >= 0.3
                  , unix
                  , utf8-string           >= 0.3 && < 1.1
   ghc-options:     -funbox-strict-fields -Wall -fno-warn-unused-do-bind