aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Hooks/WindowChange.hs
blob: b96749578a04cf3df7a88c5349700148c19cfeb7 (plain) (blame)
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
module Rahm.Desktop.Hooks.WindowChange where

import Control.Monad (when)
import Control.Monad.State (gets)
import Data.Default (Default (..))
import Rahm.Desktop.Common
  ( getCurrentScreen,
    getCurrentWorkspace,
  )
import qualified Rahm.Desktop.StackSet as W (peek)
import XMonad
  ( ExtensionClass (..),
    ScreenDetail,
    ScreenId,
    StateExtension (PersistentExtension),
    Window,
    WindowSet,
    WorkspaceId,
    X,
    XConfig (logHook),
    windowset,
    withWindowSet,
  )
import XMonad.StackSet
import qualified XMonad.Util.ExtensibleState as XS (get, put)

type WindowStack = StackSet WorkspaceId () Window ScreenId ScreenDetail

-- Type of hook. Takes the last WindowStack and the new WindowStack
newtype StackChangeHook = StackChangeHook (WindowStack -> WindowStack -> X ())

instance Semigroup StackChangeHook where
  (StackChangeHook f1) <> (StackChangeHook f2) = StackChangeHook $ \o n -> do
    f1 o n
    n' <- gets (mapLayout (const ()) . windowset)
    f2 o n'

instance Monoid StackChangeHook where
  mempty = StackChangeHook $ \_ _ -> return ()

newtype LastState = LastState (Maybe WindowStack)
  deriving (Read, Show)

instance Default LastState where
  def = LastState def

instance ExtensionClass LastState where
  initialValue = def
  extensionType = PersistentExtension

-- Creates a log hook from the function provided.
--
-- The first argument to the function is the old window, the second argument in
-- the new window.
--
-- If the first window is Nothing, this is the first time XMonad started.
withStackChangeHook :: StackChangeHook -> XConfig l -> XConfig l
withStackChangeHook (StackChangeHook fn) config =
  config
    { logHook = do
        logHook config

        current <- gets (mapLayout (const ()) . windowset)
        LastState last <- XS.get
        XS.put (LastState $ Just current)

        when (Just current /= last) $
          mapM_ (`fn` current) last
    }