From f490ced673ffc0fa1f581bc78feae226ae1d3086 Mon Sep 17 00:00:00 2001
From: Mikkel Christiansen <mikkel@rheosystems.com>
Date: Fri, 23 Sep 2016 10:03:46 +0200
Subject: [PATCH] Fix failing tests on GHC 8 and reduce warnings.

Fix test failures on GHC 8 for `abort` and `new_abort` caused by `error`
appending the stack trace to the error message (since base
4.9.0.0)[1]. This fixes #36.

An alternative is to use `errorWithoutStackTrace` (new in base 4.9.0.0),
but this then requires use of CPP for backwards compatibility.

Remove type constraints prompting GHC to warn about redundant
constraints.

Tested with 7.6.3, 7.8.4, 7.10.3, 8.0.1 (all on NixOS).

[1] https://hackage.haskell.org/package/base-4.9.0.0/docs/GHC-Stack.html
---
 src/XMonad/Layout.hs        |  2 +-
 src/XMonad/StackSet.hs      |  6 +++---
 tests/Properties/Failure.hs | 24 ++++++++++++++----------
 xmonad.cabal                |  3 ++-
 4 files changed, 20 insertions(+), 15 deletions(-)

diff --git a/src/XMonad/Layout.hs b/src/XMonad/Layout.hs
index 8eff488..9c01a69 100644
--- a/src/XMonad/Layout.hs
+++ b/src/XMonad/Layout.hs
@@ -137,7 +137,7 @@ data ChangeLayout = FirstLayout | NextLayout deriving (Eq, Show, Typeable)
 instance Message ChangeLayout
 
 -- | The layout choice combinator
-(|||) :: (LayoutClass l a, LayoutClass r a) => l a -> r a -> Choose l r a
+(|||) :: l a -> r a -> Choose l r a
 (|||) = Choose L
 infixr 5 |||
 
diff --git a/src/XMonad/StackSet.hs b/src/XMonad/StackSet.hs
index a7e9f6b..d117b4a 100644
--- a/src/XMonad/StackSet.hs
+++ b/src/XMonad/StackSet.hs
@@ -477,12 +477,12 @@ insertUp a s = if member a s then s else insert
 --
 --   * otherwise, delete doesn't affect the master.
 --
-delete :: (Ord a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
+delete :: (Ord a) => a -> StackSet i l a s sd -> StackSet i l a s sd
 delete w = sink w . delete' w
 
 -- | Only temporarily remove the window from the stack, thereby not destroying special
 -- information saved in the 'Stackset'
-delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
+delete' :: (Eq a) => a -> StackSet i l a s sd -> StackSet i l a s sd
 delete' w s = s { current = removeFromScreen        (current s)
                 , visible = map removeFromScreen    (visible s)
                 , hidden  = map removeFromWorkspace (hidden  s) }
@@ -547,7 +547,7 @@ shift n s = maybe s (\w -> shiftWin n w s) (peek s)
 -- focused element on that workspace.
 -- The actual focused workspace doesn't change. If the window is not
 -- found in the stackSet, the original stackSet is returned.
-shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
+shiftWin :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
 shiftWin n w s = case findTag w s of
                     Just from | n `tagMember` s && n /= from -> go from s
                     _                                        -> s
diff --git a/tests/Properties/Failure.hs b/tests/Properties/Failure.hs
index fc7a359..a46d723 100644
--- a/tests/Properties/Failure.hs
+++ b/tests/Properties/Failure.hs
@@ -4,23 +4,27 @@ import XMonad.StackSet hiding (filter)
 
 import qualified Control.Exception.Extensible as C
 import System.IO.Unsafe
+import Data.List (isPrefixOf)
 
 -- ---------------------------------------------------------------------
--- testing for failure
-
--- and help out hpc
-prop_abort x = unsafePerformIO $ C.catch (abort "fail")
-                                         (\(C.SomeException e) -> return $  show e == "xmonad: StackSet: fail" )
+-- testing for failure and help out hpc
+--
+-- Since base 4.9.0.0 `error` appends a stack trace. The tests below
+-- use `isPrefixOf` to only test equality on the error message.
+--
+prop_abort :: Int -> Bool
+prop_abort _ = unsafePerformIO $ C.catch (abort "fail") check
    where
-     _ = x :: Int
+     check (C.SomeException e) =
+       return $ "xmonad: StackSet: fail" `isPrefixOf` show e
 
 -- new should fail with an abort
-prop_new_abort x = unsafePerformIO $ C.catch f
-                                         (\(C.SomeException e) -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" )
+prop_new_abort :: Int -> Bool
+prop_new_abort _ = unsafePerformIO $ C.catch f check
    where
      f = new undefined{-layout-} [] [] `seq` return False
-
-     _ = x :: Int
+     check (C.SomeException e) =
+       return $ "xmonad: StackSet: non-positive argument to StackSet.new" `isPrefixOf` show e
 
 -- TODO: Fix this?
 -- prop_view_should_fail = view {- with some bogus data -}
diff --git a/xmonad.cabal b/xmonad.cabal
index c5385a3..fcabdfe 100644
--- a/xmonad.cabal
+++ b/xmonad.cabal
@@ -31,7 +31,8 @@ build-type:         Simple
 tested-with:
                     GHC==7.6.3,
                     GHC==7.8.4,
-                    GHC==7.10.2
+                    GHC==7.10.3,
+                    GHC==8.0.1
 
 data-files:         man/xmonad.hs, man/xmonad.1, man/xmonad.1.html