1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- Delegates to a lower layout, but leaves a hole where the next window will go.
module Rahm.Desktop.Layout.Hole
( hole,
addHoleForWindow,
removeHoleForWindow,
resetHole,
addHole,
)
where
import Control.Monad (forM_)
import Data.List (intercalate, sortOn)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Rahm.Desktop.Logger (LogLevel (Debug, Trace), logs)
import Rahm.Desktop.StackSet (TilePosition (TilePosition))
import qualified Rahm.Desktop.StackSet as W
import XMonad
( LayoutClass (handleMessage, runLayout),
Message,
Window,
WorkspaceId,
X,
fromMessage,
)
data Hole (l :: * -> *) (a :: *)
= Hole (Map WorkspaceId [(W.TilePosition WorkspaceId, Maybe Window)]) (l a)
deriving instance (Show (l a)) => Show (Hole l a)
deriving instance (Read (l a)) => Read (Hole l a)
hole :: l a -> Hole l a
hole = Hole mempty
resetHole :: ManageHole
resetHole = ManageHole $ \(Hole _ l) -> Hole mempty l
addHoleForWindow :: W.TilePosition WorkspaceId -> Window -> ManageHole
addHoleForWindow p@(W.TilePosition wid _) win = ManageHole $ \(Hole m l) ->
Hole
( Map.alter
( \(fromMaybe [] -> existing) ->
Just $ (p, Just win) : existing
)
wid
m
)
l
addHole :: W.TilePosition WorkspaceId -> ManageHole
addHole p@(W.TilePosition wid _) = ManageHole $ \(Hole m l) ->
Hole
( Map.alter
( \(fromMaybe [] -> existing) ->
Just $ (p, Nothing) : existing
)
wid
m
)
l
removeHoleForWindow :: Window -> ManageHole
removeHoleForWindow win = ManageHole $ \(Hole m l) ->
Hole
( Map.mapMaybe
(Just . filter ((/= Just win) . snd))
m
)
l
dbgHole :: Hole l a -> X ()
dbgHole (Hole mp _) = do
logs Debug "Hole:"
forM_ (Map.toList mp) $ \(wid, poses) ->
logs Debug " wid[%s] - [%s]" wid $
intercalate
","
( map (\(TilePosition _ n, w) -> show w ++ "@" ++ show n) poses
)
maxWindow :: Window
maxWindow = maxBound
data ManageHole where
ManageHole :: (forall l a. Hole l a -> Hole l a) -> ManageHole
deriving (Message)
instance (LayoutClass l a, a ~ Window) => LayoutClass (Hole l) a where
runLayout (W.Workspace t h@(Hole holes l) a) rect = do
dbgHole h
(rects, maybeNewLayout) <- runLayout (app holes $ W.Workspace t l a) rect
return (filter ((> 0) . fst) rects, fmap (Hole holes) maybeNewLayout)
where
app ::
(Ord i1) =>
Map i1 [(TilePosition i, Maybe Window)] ->
W.Workspace i1 l1 Window ->
W.Workspace i1 l1 Window
app mp (W.Workspace t l (Just s))
| Just positions <- sortIt <$> Map.lookup t mp =
let positionToFakes =
zipWith
(\(TilePosition _ n, _) fid -> (n, fid))
positions
[maxWindow, maxWindow - 1 ..]
integrated = W.integrate s
in W.Workspace t l $
W.differentiateWithFocus (W.focus s) $
inflateWithFakes 0 integrated positionToFakes
app _ w = w
inflateWithFakes :: Int -> [Window] -> [(Int, Window)] -> [Window]
inflateWithFakes idx wins ((n,fake):fakes) | idx == n =
fake : inflateWithFakes (idx + 1) wins fakes
inflateWithFakes idx (w:wins) fakes =
w : inflateWithFakes (idx + 1) wins fakes
inflateWithFakes _ wins [] = wins
inflateWithFakes _ [] fakes = map snd fakes
sortIt = sortOn (\(TilePosition _ p, _) -> p)
handleMessage h (fromMessage -> Just (ManageHole f)) =
return $ Just $ f h
handleMessage (Hole e l) a = do
maybeNewLayout <- handleMessage l a
return (Hole e <$> maybeNewLayout)
|
