X.A.CycleRecentWS: Add property test for unView

Scary looking code better be tested. :-)

(For the record, the test did find an issue that is already fixed in the
previous commit.)

XMonad/Actions/CycleRecentWS.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.CycleRecentWS
@@ -25,7 +27,11 @@ module XMonad.Actions.CycleRecentWS (
                                 toggleRecentWS,
                                 toggleRecentNonEmptyWS,
                                 toggleWindowSets,
-                                recentWS
+                                recentWS,
+
+#ifdef TESTING
+                                unView,
+#endif
 ) where
 
 import XMonad hiding (workspaces)
@@ -128,43 +134,44 @@ cycleWindowSets genOptions mods keyNext keyPrev = do
   cycref :: [a] -> Int -> a
   cycref l i = l !! (i `mod` length l)
 
-  -- | Given an old and a new 'WindowSet', which is __exactly__ one
-  -- 'view' away from the old one, restore the workspace order of the
-  -- former inside of the latter.  This respects any new state that the
-  -- new 'WindowSet' may have accumulated.
-  unView :: WindowSet -> WindowSet -> WindowSet
-  unView origW w
-    | -- The focused screen changed; the old focus is on a visible screen
-      newFocT `elem` visT =
-        w { current = (current origW){ workspace = findFoc (workspace <$> visible w) }
-          , visible = zipWith (\v ws -> v{ workspace = ws }) vis (updateNewFoc visW)
-          }
-    | -- The focused screen didn't change; the old focus is hidden
-      newFocT `elem` hidT =
-        w { current = (current origW){ workspace = findFoc (hidden w) }
-          , hidden  = updateNewFoc hid
-          }
-    | otherwise = w
-   where
-    -- Foci, old and new
-    focT              = tag . workspace . current $ origW
-    (newFoc, newFocT) = id &&& tag $ workspace (current w)
+-- | Given an old and a new 'WindowSet', which is __exactly__ one
+-- 'view' away from the old one, restore the workspace order of the
+-- former inside of the latter.  This respects any new state that the
+-- new 'WindowSet' may have accumulated.
+unView :: forall i l a s sd. Eq i
+       => StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd
+unView origW w
+  | -- The focused screen changed; the old focus is on a visible screen
+    newFocT `elem` visT =
+      w { current = (current origW){ workspace = findFoc (workspace <$> visible w) }
+        , visible = zipWith (\v ws -> v{ workspace = ws }) vis (updateNewFoc visW)
+        }
+  | -- The focused screen didn't change; the old focus is hidden
+    newFocT `elem` hidT =
+      w { current = (current origW){ workspace = findFoc (hidden w) }
+        , hidden  = updateNewFoc hid
+        }
+  | otherwise = w
+ where
+  -- Foci, old and new
+  focT              = tag . workspace . current $ origW
+  (newFoc, newFocT) = id &&& tag $ workspace (current w)
 
-    -- Workspaces in the _original_ windowset
-    (hid, hidT)         = id &&& map tag $ hidden origW
-    (vis, (visW, visT)) = id &&& map workspace &&& map (tag . workspace)
-                        $ visible origW
+  -- Workspaces in the _original_ windowset
+  (hid, hidT)         = id &&& map tag $ hidden origW
+  (vis, (visW, visT)) = id &&& map workspace &&& map (tag . workspace)
+                      $ visible origW
 
-    -- | Given a list of new workspaces that contain the old focus,
-    -- return that workspace.
-    findFoc :: [WindowSpace] -> WindowSpace
-    findFoc ws = fromJust $ find ((== focT) . tag) ws
+  -- | Given a list of new workspaces that contain the old focus,
+  -- return that workspace.
+  findFoc :: [Workspace i l a] -> Workspace i l a
+  findFoc ws = fromJust $ find ((== focT) . tag) ws
 
-    -- | Given a list of old workspaces that contain the new focus,
-    -- update the state of the focus.
-    updateNewFoc :: [WindowSpace] -> [WindowSpace]
-    updateNewFoc ws = before ++ newFoc : after
-     where (before, after) = drop 1 <$> break ((== newFocT) . tag) ws
+  -- | Given a list of old workspaces that contain the new focus,
+  -- update the state of the focus.
+  updateNewFoc :: [Workspace i l a] -> [Workspace i l a]
+  updateNewFoc ws = before ++ newFoc : after
+   where (before, after) = drop 1 <$> break ((== newFocT) . tag) ws
 
 -- | Given some function that generates a list of workspaces from a
 -- given 'WindowSet', switch to the first generated workspace.

tests/CycleRecentWS.hs

@@ -0,0 +1,20 @@
+{-# OPTIONS_GHC -Wall #-}
+module CycleRecentWS where
+
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
+
+import XMonad.Actions.CycleRecentWS (unView)
+import XMonad.StackSet (view)
+
+import Instances
+import Utils (tags)
+
+spec :: Spec
+spec = do
+    prop "prop_unView" $ prop_unView
+
+prop_unView :: T -> Property
+prop_unView ss = conjoin
+    [ counterexample (show t) (unView ss (view t ss) === ss) | t <- tags ss ]

tests/Main.hs

@@ -10,6 +10,7 @@ import qualified RotateSome
 import qualified Selective
 import qualified SwapWorkspaces
 import qualified XPrompt
+import qualified CycleRecentWS
 
 main :: IO ()
 main = hspec $ do
@@ -45,3 +46,4 @@ main = hspec $ do
         prop "prop_skipGetLastWord"  $ XPrompt.prop_skipGetLastWord
     context "NoBorders" $ NoBorders.spec
     context "ExtensibleConf" $ ExtensibleConf.spec
+    context "CycleRecentWS" $ CycleRecentWS.spec

xmonad-contrib.cabal

@@ -373,15 +373,16 @@ library
 test-suite tests
   type:           exitcode-stdio-1.0
   main-is:        Main.hs
-  other-modules:  ManageDocks
+  other-modules:  CycleRecentWS
+                  Instances
+                  ManageDocks
                   NoBorders
                   RotateSome
                   Selective
                   SwapWorkspaces
-                  XPrompt
-                  Instances
                   Utils
                   ExtensibleConf
+                  XMonad.Actions.CycleRecentWS
                   XMonad.Actions.CycleWS
                   XMonad.Actions.FocusNth
                   XMonad.Actions.PhysicalScreens
@@ -409,6 +410,7 @@ test-suite tests
                   XMonad.Util.WorkspaceCompare
                   XMonad.Util.XSelection
                   XMonad.Util.XUtils
+                  XPrompt
   hs-source-dirs: tests, .
   build-depends: base
                , QuickCheck >= 2