{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module WindowNavigation where
import Test.Hspec
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Functor.Identity
import XMonad
import XMonad.Util.Types (Direction2D(..))
import XMonad.Actions.WindowNavigation (goPure, swapPure, WNState)
import qualified XMonad.StackSet as W
spec :: Spec
spec = do
it "two-window adjacent go right (empty state)" $ do
-- Simplest case - just move the focus once.
-- ┌─────┬──────┐
-- │ 1 ──┼─► 2 │
-- └─────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
runNav R M.empty (mkws 1 [] [2])
`shouldBe` (mkstate 960 640, mkws 2 [1] [])
it "two-window adjacent go right (populated state)" $ do
-- Like the previous test, but this time internal stat is already populated with a position.
-- ┌─────┬──────┐
-- │ 1 ──┼─► 2 │
-- └─────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
runNav R (mkstate 100 100) (mkws 1 [] [2])
`shouldBe` (mkstate 960 100, mkws 2 [1] [])
it "two-window adjacent go right (incorrectly-populated state)" $ do
-- This time we set the position incorrectly, testing if it will be reset to the center of focused window.
-- ┌─────┬──────┐
-- │ 1 ──┼─► 2 │
-- └─────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
runNav R (mkstate 1000 100) (mkws 1 [] [2])
`shouldBe` (mkstate 960 640, mkws 2 [1] [])
it "swap windows" $ do
-- Swap windows around.
-- ┌─────┬──────┐
-- │ 1 ◄─┼─► 2 │
-- └─────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
]
runIdentity (swapPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))
`shouldBe` (mkstate 960 640, mkws 1 [2] [])
it "tall layout, go up" $ do
-- ┌─────┬─────┐
-- │ │ 2 ▲ │
-- │ 1 ├───┼─┤
-- │ │ 3 │ │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 640)
, (3, Rectangle 960 640 960 640)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2, 3], windowRect)
runNav U M.empty (mkws 3 [] [1, 2])
`shouldBe` (mkstate 1440 639, mkws 2 [1, 3] [])
it "tall layout, go down" $ do
-- ┌─────┬─────┐
-- │ │ 2 │
-- │ ├─────┤
-- │ 1 │ 3 │ │
-- │ ├───┼─┤
-- │ │ 4 ▼ │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
runNav D M.empty (mkws 3 [] [1, 2, 4])
`shouldBe` (mkstate 1440 800, mkws 4 [2, 1, 3] [])
it "tall layout, go left" $ do
-- ┌─────┬─────┐
-- │ ◄─┼── 2 │
-- │ ├─────┤
-- │ 1 │ 3 │
-- │ ├─────┤
-- │ │ 4 │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
runNav L M.empty (mkws 2 [] [1, 3, 4])
`shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])
it "tall layout, go left and then right (window 2)" $ do
-- ┌─────┬─────┐
-- │ ◄─┼── 2 │
-- │ ──┼─► │
-- │ ├─────┤
-- │ 1 │ 3 │
-- │ ├─────┤
-- │ │ 4 │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav L M.empty (mkws 2 [] [1, 3, 4])
(st2, ws2) `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 200, mkws 2 [] [1, 3, 4])
it "tall layout, go left and then right (window 3)" $ do
-- ┌─────┬─────┐
-- │ │ 2 │
-- │ ├─────┤
-- │ 1 ◄─┼── 3 │
-- │ ──┼─► │
-- │ ├─────┤
-- │ │ 4 │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav L M.empty (mkws 3 [] [1, 2, 4])
(st2, ws2) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 600, mkws 3 [] [1, 2, 4])
it "tall layout, go left and then right (window 4)" $ do
-- ┌─────┬─────┐
-- │ │ 2 │
-- │ ├─────┤
-- │ 1 │ 3 │
-- │ ├─────┤
-- │ ◄─┼── 4 │
-- │ ──┼─► │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav L M.empty (mkws 4 [] [1, 2, 3])
(st2, ws2) `shouldBe` (mkstate 959 1040, mkws 1 [4] [2, 3])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 1040, mkws 4 [] [1, 2, 3])
it "grid layout, go in a circle" $ do
-- ┌─────┬─────┐
-- │ 1 ──┼─► 2 │
-- │ │ │
-- │ ▲ │ │ │
-- ├─┼───┼───┼─┤
-- │ │ │ ▼ │
-- │ │ │
-- │ 3 ◄─┼── 4 │
-- └─────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 640)
, (2, Rectangle 960 0 960 640)
, (3, Rectangle 0 640 960 640)
, (4, Rectangle 960 640 960 640)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3, 4])
(st2, ws2) `shouldBe` (mkstate 960 320, mkws 2 [1] [3, 4])
let (st3, ws3) = runNav D st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [3, 2, 1] [])
let (st4, ws4) = runNav L st3 ws3
(st4, ws4) `shouldBe` (mkstate 959 640, mkws 3 [2, 1] [4])
let (st5, ws5) = runNav U st4 ws4
(st5, ws5) `shouldBe` (mkstate 959 639, mkws 1 [] [2, 3, 4])
it "ignore window that fully overlaps the current window in parallel direction when pos is outside it" $ do
-- ┌─────┬──────┬──────┐
-- │ ┌───┴──────┴────┐ │
-- │ │ | 4 | │ │
-- │ └───┬──────┬────┘ │
-- │ 1 │ 2 ──┼─► 3 │
-- └─────┴──────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 600 1280)
, (2, Rectangle 600 0 600 1280)
, (3, Rectangle 1200 0 720 1280)
, (4, Rectangle 200 200 1520 400)
]
runIdentity (goPure R (mkstate 900 900, mkws 2 [] [1, 3, 4], S.fromList [1..4], windowRect))
`shouldBe` (mkstate 1200 900, mkws 3 [1,2] [4])
it "go to window that fully overlaps the current window in parallel direction when pos is inside it" $ do
-- ┌─────────────────┐
-- │ ┌──────┐ │
-- │ 1 │ │ │
-- ├─────┤------├────┤
-- │ │ │ │
-- │ 2 │ 4 ──┼─► │
-- │ │ │ │
-- ├─────┤------├────┤
-- │ 3 │ │ │
-- │ └──────┘ │
-- └─────────────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 1920 400)
, (2, Rectangle 0 400 1920 400)
, (3, Rectangle 0 800 1920 480)
, (4, Rectangle 800 200 400 880)
]
runIdentity (goPure R (mkstate 1000 600, mkws 4 [] [1, 2, 3], S.fromList [1..4], windowRect))
`shouldBe` (mkstate 1200 600, mkws 2 [1,4] [3])
it "go from inner window to outer" $ do
-- ┌───────────────┐
-- │ ┌──────┐ │
-- │ 1 ◄─┼── 2 │ │
-- │ └──────┘ │
-- └───────────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 1920 1280)
, (2, Rectangle 600 600 600 600)
]
runIdentity (goPure L (M.empty, mkws 2 [] [1], S.fromList [1, 2], windowRect))
`shouldBe` (mkstate 599 900, mkws 1 [2] [])
it "if there are multiple outer windows, go to the smaller one" $ do
-- ┌────────────────────────┐
-- │ ┌───────────────┐ │
-- │ │ ┌──────┐ │ │
-- │ │ 2 ◄─┼── 3 │ │ 1 │
-- │ │ └──────┘ │ │
-- │ └───────────────┘ │
-- └────────────────────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 1920 1280)
, (2, Rectangle 200 200 1520 880)
, (3, Rectangle 400 400 400 400)
]
runIdentity (goPure L (M.empty, mkws 3 [] [1, 2], S.fromList [1..3], windowRect))
`shouldBe` (mkstate 399 600, mkws 2 [1, 3] [])
it "two tiled and one floating, floating fully inside" $ do
-- ┌───────────────────┬─────┐
-- │ ┌───────┐ │ │
-- │ ──┼─► ──┼─► ──┼─► │
-- │ │ 3 │ 1 │ 2 │
-- │ │ ◄─┼── ◄─┼── │
-- │ └───────┘ │ │
-- └───────────────────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
, (3, Rectangle 400 400 400 400)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3])
(st2, ws2) `shouldBe` (mkstate 400 400, mkws 3 [2, 1] [])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 800 400, mkws 1 [] [2, 3])
let (st4, ws4) = runNav R st3 ws3
(st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1] [3])
let (st5, ws5) = runNav L st4 ws4
(st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [] [2, 3])
let (st6, ws6) = runNav L st5 ws5
(st6, ws6) `shouldBe` (mkstate 799 400, mkws 3 [2, 1] [])
it "two floating windows inside one big tiled one" $ do
-- ┌─────────┐
-- │ │ │
-- │ ┌──┼──┐ │
-- │ │ ▼ │ │
-- │ │ 3 │ │
-- │ └──┼──┘ │
-- │ ▼ │
-- │ 1 │
-- │ ┌──┼──┐ │
-- │ │ ▼ │ │
-- │ │ 4 │ │
-- │ └──┼──┘ │
-- │ ▼ │
-- ├────┼────┤
-- │ ▼ │
-- │ 2 │
-- └─────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 1920 640)
, (2, Rectangle 0 640 1920 640)
, (3, Rectangle 200 200 100 100)
, (4, Rectangle 1000 400 100 100)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav D (mkstate 1000 250) (mkws 1 [] [2, 3, 4])
(st2, ws2) `shouldBe` (mkstate 299 250, mkws 3 [2, 1] [4])
let (st3, ws3) = runNav D st2 ws2
(st3, ws3) `shouldBe` (mkstate 299 300, mkws 1 [] [2, 3, 4])
let (st4, ws4) = runNav D st3 ws3
(st4, ws4) `shouldBe` (mkstate 1000 400, mkws 4 [3, 2, 1] [])
let (st5, ws5) = runNav D st4 ws4
(st5, ws5) `shouldBe` (mkstate 1000 500, mkws 1 [] [2, 3, 4])
let (st6, ws6) = runNav D st5 ws5
(st6, ws6) `shouldBe` (mkstate 1000 640, mkws 2 [1] [3, 4])
it "floating window between two tiled ones" $ do
-- ┌───────┬────────┐
-- │ 1 ┌───┴───┐ 2 │
-- │ ──┼─► 3 ──┼─► │
-- │ └───┬───┘ │
-- └───────┴────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
, (3, Rectangle 860 540 200 200)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3])
(st2, ws2) `shouldBe` (mkstate 860 640, mkws 3 [2, 1] [])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 640, mkws 2 [1] [3])
it "floating window overlapping four tiled ones" $ do
-- ┌───────┬───────┐
-- │ ┌───┴───┐ │
-- │ 1 │ │ 2 │
-- ├───┤ ├───┤
-- │ ──┼─► 5 ──┼─► │
-- │ 3 └───┬───┘ 4 │
-- └───────┴───────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 640)
, (2, Rectangle 960 0 960 640)
, (3, Rectangle 0 640 960 640)
, (4, Rectangle 960 640 960 640)
, (5, Rectangle 760 440 400 400)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)
let (st2, ws2) = runNav R (mkstate 480 640) (mkws 3 [] [1, 2, 4, 5])
(st2, ws2) `shouldBe` (mkstate 760 640, mkws 5 [4, 2, 1, 3] [])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [2, 1, 3] [5])
it "sequential inner floating windows" $ do
-- ┌───────────────────────────────────┬──────┐
-- │ ┌───────┐ │ │
-- │ │ │ ┌───────┐ │ │
-- │ ──┼─► 3 ──┼─► 1 ──┼─► 4 ──┼─► ──┼─► 2 │
-- │ ◄─┼── ◄─┼── ◄─┼── ◄─┼── ◄─┼── │
-- │ └───────┘ │ │ │ │
-- │ └───────┘ │ │
-- └───────────────────────────────────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
, (3, Rectangle 200 200 200 200)
, (4, Rectangle 600 600 200 200)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3, 4])
(st2, ws2) `shouldBe` (mkstate 200 200, mkws 3 [2,1] [4])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 400 200, mkws 1 [] [2, 3, 4])
let (st4, ws4) = runNav R st3 ws3
(st4, ws4) `shouldBe` (mkstate 600 600, mkws 4 [3, 2, 1] [])
let (st5, ws5) = runNav R st4 ws4
(st5, ws5) `shouldBe` (mkstate 800 600, mkws 1 [] [2, 3, 4])
let (st6, ws6) = runNav R st5 ws5
(st6, ws6) `shouldBe` (mkstate 960 600, mkws 2 [1] [3, 4])
let (st7, ws7) = runNav L st6 ws6
(st7, ws7) `shouldBe` (mkstate 959 600, mkws 1 [] [2, 3, 4])
let (st8, ws8) = runNav L st7 ws7
(st8, ws8) `shouldBe` (mkstate 799 600, mkws 4 [3, 2, 1] [])
let (st9, ws9) = runNav L st8 ws8
(st9, ws9) `shouldBe` (mkstate 599 600, mkws 1 [] [2, 3, 4])
let (st10, ws10) = runNav L st9 ws9
(st10, ws10) `shouldBe` (mkstate 399 399, mkws 3 [2, 1] [4])
let (st11, ws11) = runNav L st10 ws10
(st11, ws11) `shouldBe` (mkstate 199 399, mkws 1 [] [2, 3, 4])
it "overlapping inner floating windows" $ do
-- ┌─────────────────────┬──────┐
-- │ ┌─────────┐ │ │
-- │ │ 3 ┌────┴─┐ │ │
-- │ │ ──┼─► ──┼─► 1 ──┼─► 2 │
-- │ │ ◄─┼── ◄─┼── ◄─┼── │
-- │ │ │ 4 │ │ │
-- │ └────┤ │ │ │
-- │ └──────┘ │ │
-- └─────────────────────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
, (3, Rectangle 200 200 400 400)
, (4, Rectangle 300 300 400 400)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
let (st2, ws2) = runNav R M.empty (mkws 3 [] [1, 2, 4])
(st2, ws2) `shouldBe` (mkstate 400 400, mkws 4 [2, 1, 3] [])
let (st3, ws3) = runNav R st2 ws2
(st3, ws3) `shouldBe` (mkstate 700 400, mkws 1 [3] [2, 4])
let (st4, ws4) = runNav R st3 ws3
(st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1, 3] [4])
let (st5, ws5) = runNav L st4 ws4
(st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [3] [2, 4])
let (st6, ws6) = runNav L st5 ws5
(st6, ws6) `shouldBe` (mkstate 699 400, mkws 4 [2, 1, 3] [])
let (st7, ws7) = runNav L st6 ws6
(st7, ws7) `shouldBe` (mkstate 599 400, mkws 3 [] [1, 2, 4])
it "bounce back from the wall to the floating window" $ do
-- ┌────────────────┬─────┐
-- │ 1 ┌──────┐ │ │
-- │ ┌───┼─► 3 │ │ 2 │
-- │ └── │ │ │ │
-- │ └──────┘ │ │
-- └────────────────┴─────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 1280)
, (3, Rectangle 400 400 200 200)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
runNav L (mkstate 100 640) (mkws 1 [] [2, 3])
`shouldBe` (mkstate 400 599, mkws 3 [2, 1] [])
it "jump between screens" $ do
-- ┌─────┬──────┐ ┌────────┐
-- │ │ 2 │ │ 5 │
-- │ ├──────┤ ├────────┤
-- │ 1 │ 3 ──┼──┼─► 6 │
-- │ ├──────┤ └────────┘
-- │ │ 4 │
-- └─────┴──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
, (5, Rectangle 1920 0 1280 384)
, (6, Rectangle 1920 384 1280 384)
]
initWindowSet =
W.StackSet
{ W.current =
W.Screen
{ W.workspace =
W.Workspace
{ W.tag = "A"
, W.layout = Layout NullLayout
, W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }
}
, W.screen = 1
, W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
}
, W.visible =
[ W.Screen
{ W.workspace =
W.Workspace
{ W.tag = "B"
, W.layout = Layout NullLayout
, W.stack = Just $ W.Stack { W.focus = 5, W.up = [], W.down = [6] }
}
, W.screen = 2
, W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }
}
]
, W.hidden = []
, W.floating = M.empty
}
expectedWindowSet =
W.StackSet
{ W.current =
W.Screen
{ W.workspace =
W.Workspace
{ W.tag = "B"
, W.layout = Layout NullLayout
, W.stack = Just $ W.Stack { W.focus = 6, W.up = [5], W.down = [] }
}
, W.screen = 2
, W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }
}
, W.visible =
[ W.Screen
{ W.workspace =
W.Workspace
{ W.tag = "A"
, W.layout = Layout NullLayout
, W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }
}
, W.screen = 1
, W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
}
]
, W.hidden = []
, W.floating = M.empty
}
runIdentity (goPure R (M.empty, initWindowSet, S.fromList [1..6], windowRect))
`shouldBe` (M.fromList [("B", Point 1920 600)], expectedWindowSet)
it "floating window overlapping fully in the orthogonal direction" $ do
-- ┌─────┬──────────────────┐
-- │ │ ┌───────┐ │
-- │ │ 2 │ │ │
-- │ ├──────┤-------├───┤
-- │ 1 │ 3 │ │ 3 │
-- │ ◄─┼── ◄─┼── 5 ◄─┼── │
-- │ ├──────┤-------├───┤
-- │ │ 4 │ │ │
-- │ │ └───────┘ │
-- └─────┴──────────────────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 960 0 960 400)
, (3, Rectangle 960 400 960 400)
, (4, Rectangle 960 800 960 480)
, (5, Rectangle 1360 200 200 800)
]
runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)
let (st2, ws2) = runNav L (mkstate 1800 600) (mkws 3 [] [1, 2, 4, 5])
(st2, ws2) `shouldBe` (mkstate 1559 600, mkws 5 [4, 2, 1, 3] [])
let (st3, ws3) = runNav L st2 ws2
(st3, ws3) `shouldBe` (mkstate 1359 600, mkws 3 [] [1, 2, 4, 5])
let (st4, ws4) = runNav L st3 ws3
(st4, ws4) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4, 5])
it "navigation to free-floating windows on the same screen" $ do
-- ┌──────┐
-- │ │ ┌──────┐
-- │ │ │ │
-- │ ──┼──┼─► 2 │
-- │ │ │ │
-- │ 1 │ └──────┘
-- │ │
-- │ │
-- └──────┘
let windowRect w =
Identity $ M.lookup w $ M.fromList
[ (1, Rectangle 0 0 960 1280)
, (2, Rectangle 1200 400 400 400)
]
runIdentity (goPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))
`shouldBe` (mkstate 1200 640, mkws 2 [1] [])
it "switch between windows in Full layout" $ do
let windowRect w = Identity $ M.lookup w $ M.fromList [(1, Rectangle 0 0 1920 1280)]
runIdentity (goPure D (M.empty, mkws 1 [] [2, 3], S.fromList [1], windowRect))
`shouldBe` (M.empty, mkws 2 [1] [3])
data NullLayout a = NullLayout deriving (Show, Read, Eq)
instance LayoutClass NullLayout a
-- to make WindowSets comparable
instance Eq (Layout w) where
(==) a b = show a == show b
(/=) a b = show a /= show b
-- make a state with a position for a single workspace
mkstate :: Position -> Position -> WNState
mkstate px py = M.fromList [("A", Point px py)]
-- make a single-workspace WindowSet
mkws :: Window -> [Window] -> [Window] -> WindowSet
mkws focusedWindow upWindows downWindows = W.StackSet
{ W.current = W.Screen
{ W.workspace = W.Workspace
{ W.tag = "A"
, W.layout = Layout NullLayout
, W.stack = Just $ W.Stack { W.focus = focusedWindow, W.up = upWindows, W.down = downWindows }
}
, W.screen = 1
, W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
}
, W.visible = []
, W.hidden = []
, W.floating = M.empty
}