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
|
{-# 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,
)
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, 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, win) : existing
)
wid
m
)
l
removeHoleForWindow :: Window -> ManageHole
removeHoleForWindow win = ManageHole $ \(Hole m l) ->
Hole
( Map.mapMaybe
(Just . filter ((/= 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 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 && win `notElem` integrated ->
((idx + 1, tpos, fakeid - 1), w : fakeid : ret)
_ -> ((idx + 1, pos, fakeid), w : ret)
)
((0, positions, -1), [])
integrated
app _ w = w
sortIt = sortOn (\(TilePosition _ p, _) -> p)
addr integrated ((idx, pos, fakeid), ret) =
case pos of
((TilePosition _ n, win) : _) | n == idx && win `notElem` integrated -> 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)
|
