diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs index 3f83a950..4c0a8522 100644 --- a/XMonad/Actions/CycleRecentWS.hs +++ b/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. diff --git a/tests/CycleRecentWS.hs b/tests/CycleRecentWS.hs new file mode 100644 index 00000000..b7bd39dd --- /dev/null +++ b/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 ] diff --git a/tests/Main.hs b/tests/Main.hs index ecc1d9c1..c2ef02d0 100644 --- a/tests/Main.hs +++ b/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 diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index e60951ea..8a4bb557 100644 --- a/xmonad-contrib.cabal +++ b/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