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
134
135
136
|
{-# 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 Trace "Hole:"
forM_ (Map.toList mp) $ \(wid, poses) ->
logs Trace " wid[%s] - [%s]" wid $
intercalate
","
( map (\(TilePosition _ n, w) -> show w ++ "@" ++ show n) poses
)
-- toggleHole :: ManageHole
-- toggleHole = ManageHole $ \(Hole e l) -> Hole (not e) l
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 integrated = W.integrate s
in W.Workspace t l $
W.differentiateWithFocus (W.focus s) $
reverse $
addr integrated $
foldl
( \((idx, pos, fakeid), ret) w ->
case pos of
((TilePosition _ n, win) : tpos)
| n == idx && maybe True (`notElem` integrated) win ->
((idx + 1, tpos, fakeid - 1), w : fakeid : ret)
_ -> ((idx + 1, pos, fakeid), w : ret)
)
((0, positions, 10000000), [])
integrated
app _ w = w
sortIt = sortOn (\(TilePosition _ p, _) -> p)
addr integrated ((idx, pos, fakeid), ret) =
case pos of
((TilePosition _ n, win) : _) | n == idx && maybe True (`notElem` integrated) win -> fakeid : ret
_ -> ret
handleMessage h (fromMessage -> Just (ManageHole f)) =
return $ Just $ f h
handleMessage (Hole e l) a = do
maybeNewLayout <- handleMessage l a
return (Hole e <$> maybeNewLayout)
|
