src/Rahm/Desktop/Layout/Hole.hs


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

{-# LANGUAGE UndecidableInstances, DeriveAnyClass #-}

-- Delegates to a lower layout, but leaves a hole where the next window will go.
module Rahm.Desktop.Layout.Hole (hole, toggleHole) where

import qualified XMonad.StackSet as W
import XMonad
import Data.Maybe (mapMaybe)

import Rahm.Desktop.Windows

data Hole (l :: * -> *) (a :: *) = Hole Bool (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 False

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, Eq a, Num a) => LayoutClass (Hole l) a where
  runLayout (W.Workspace t (Hole enabled l) a) rect = do
    (rects, maybeNewLayout) <- runLayout (app (-1) $ W.Workspace t l a) rect
    return (filter ((/=(-1)) . fst) rects, fmap (Hole enabled) maybeNewLayout)
    where
      app x w | not enabled = w
      app x (W.Workspace t l s) =
        case s of
          Nothing -> 
            W.Workspace t l (Just $ W.Stack x [] [])
          Just (W.Stack h c e) ->
            W.Workspace t l (Just $ W.Stack h c (e ++ [x]))
  
  handleMessage h (fromMessage -> Just (ManageHole f)) =
    return $ Just $ f h
  handleMessage (Hole e l) a = do
    maybeNewLayout <- handleMessage l a
    return (Hole e <$> maybeNewLayout)