mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
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.)
This commit is contained in:
parent
3db9167da4
commit
24786c6d04
@ -1,4 +1,6 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.CycleRecentWS
|
-- Module : XMonad.Actions.CycleRecentWS
|
||||||
@ -25,7 +27,11 @@ module XMonad.Actions.CycleRecentWS (
|
|||||||
toggleRecentWS,
|
toggleRecentWS,
|
||||||
toggleRecentNonEmptyWS,
|
toggleRecentNonEmptyWS,
|
||||||
toggleWindowSets,
|
toggleWindowSets,
|
||||||
recentWS
|
recentWS,
|
||||||
|
|
||||||
|
#ifdef TESTING
|
||||||
|
unView,
|
||||||
|
#endif
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad hiding (workspaces)
|
import XMonad hiding (workspaces)
|
||||||
@ -132,7 +138,8 @@ cycleWindowSets genOptions mods keyNext keyPrev = do
|
|||||||
-- 'view' away from the old one, restore the workspace order of the
|
-- 'view' away from the old one, restore the workspace order of the
|
||||||
-- former inside of the latter. This respects any new state that the
|
-- former inside of the latter. This respects any new state that the
|
||||||
-- new 'WindowSet' may have accumulated.
|
-- new 'WindowSet' may have accumulated.
|
||||||
unView :: WindowSet -> WindowSet -> WindowSet
|
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
|
unView origW w
|
||||||
| -- The focused screen changed; the old focus is on a visible screen
|
| -- The focused screen changed; the old focus is on a visible screen
|
||||||
newFocT `elem` visT =
|
newFocT `elem` visT =
|
||||||
@ -157,12 +164,12 @@ cycleWindowSets genOptions mods keyNext keyPrev = do
|
|||||||
|
|
||||||
-- | Given a list of new workspaces that contain the old focus,
|
-- | Given a list of new workspaces that contain the old focus,
|
||||||
-- return that workspace.
|
-- return that workspace.
|
||||||
findFoc :: [WindowSpace] -> WindowSpace
|
findFoc :: [Workspace i l a] -> Workspace i l a
|
||||||
findFoc ws = fromJust $ find ((== focT) . tag) ws
|
findFoc ws = fromJust $ find ((== focT) . tag) ws
|
||||||
|
|
||||||
-- | Given a list of old workspaces that contain the new focus,
|
-- | Given a list of old workspaces that contain the new focus,
|
||||||
-- update the state of the focus.
|
-- update the state of the focus.
|
||||||
updateNewFoc :: [WindowSpace] -> [WindowSpace]
|
updateNewFoc :: [Workspace i l a] -> [Workspace i l a]
|
||||||
updateNewFoc ws = before ++ newFoc : after
|
updateNewFoc ws = before ++ newFoc : after
|
||||||
where (before, after) = drop 1 <$> break ((== newFocT) . tag) ws
|
where (before, after) = drop 1 <$> break ((== newFocT) . tag) ws
|
||||||
|
|
||||||
|
20
tests/CycleRecentWS.hs
Normal file
20
tests/CycleRecentWS.hs
Normal file
@ -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 ]
|
@ -10,6 +10,7 @@ import qualified RotateSome
|
|||||||
import qualified Selective
|
import qualified Selective
|
||||||
import qualified SwapWorkspaces
|
import qualified SwapWorkspaces
|
||||||
import qualified XPrompt
|
import qualified XPrompt
|
||||||
|
import qualified CycleRecentWS
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = hspec $ do
|
main = hspec $ do
|
||||||
@ -45,3 +46,4 @@ main = hspec $ do
|
|||||||
prop "prop_skipGetLastWord" $ XPrompt.prop_skipGetLastWord
|
prop "prop_skipGetLastWord" $ XPrompt.prop_skipGetLastWord
|
||||||
context "NoBorders" $ NoBorders.spec
|
context "NoBorders" $ NoBorders.spec
|
||||||
context "ExtensibleConf" $ ExtensibleConf.spec
|
context "ExtensibleConf" $ ExtensibleConf.spec
|
||||||
|
context "CycleRecentWS" $ CycleRecentWS.spec
|
||||||
|
@ -373,15 +373,16 @@ library
|
|||||||
test-suite tests
|
test-suite tests
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
other-modules: ManageDocks
|
other-modules: CycleRecentWS
|
||||||
|
Instances
|
||||||
|
ManageDocks
|
||||||
NoBorders
|
NoBorders
|
||||||
RotateSome
|
RotateSome
|
||||||
Selective
|
Selective
|
||||||
SwapWorkspaces
|
SwapWorkspaces
|
||||||
XPrompt
|
|
||||||
Instances
|
|
||||||
Utils
|
Utils
|
||||||
ExtensibleConf
|
ExtensibleConf
|
||||||
|
XMonad.Actions.CycleRecentWS
|
||||||
XMonad.Actions.CycleWS
|
XMonad.Actions.CycleWS
|
||||||
XMonad.Actions.FocusNth
|
XMonad.Actions.FocusNth
|
||||||
XMonad.Actions.PhysicalScreens
|
XMonad.Actions.PhysicalScreens
|
||||||
@ -409,6 +410,7 @@ test-suite tests
|
|||||||
XMonad.Util.WorkspaceCompare
|
XMonad.Util.WorkspaceCompare
|
||||||
XMonad.Util.XSelection
|
XMonad.Util.XSelection
|
||||||
XMonad.Util.XUtils
|
XMonad.Util.XUtils
|
||||||
|
XPrompt
|
||||||
hs-source-dirs: tests, .
|
hs-source-dirs: tests, .
|
||||||
build-depends: base
|
build-depends: base
|
||||||
, QuickCheck >= 2
|
, QuickCheck >= 2
|
||||||
|
Loading…
x
Reference in New Issue
Block a user