aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/XMobarLog/PendingBuffer.hs
blob: 67ae6a320cdf5b2246537915070016b2befa00fa (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
module Rahm.Desktop.XMobarLog.PendingBuffer
  ( addStringToPendingBuffer,
    setPendingBuffer,
    clearPendingBuffer,
    getPendingBuffer,
    pushPendingBuffer,
    pushAddPendingBuffer,
  )
where

import Rahm.Desktop.Common
import Data.Default (Default (..))
import XMonad (X)
import qualified XMonad as X
  ( ExtensionClass (initialValue),
    MonadReader (ask),
    XConf (config),
    XConfig (logHook),
  )
import qualified XMonad.Util.ExtensibleState as XS
  ( get,
    modify,
    put,
  )

-- The pending buffer keeps track of pending characters. This is useful for when
-- inputing Wml language constructs. Helps to keep the user from being too lost
-- wheen it comes to keeping track of keystrokes.

newtype PendingBuffer = PendingBuffer {unPendingBuffer :: [Char]}

instance Default PendingBuffer where
  def = PendingBuffer []

instance X.ExtensionClass PendingBuffer where
  initialValue = def

addStringToPendingBuffer :: [Char] -> X ()
addStringToPendingBuffer str = do
  XS.modify $ \(PendingBuffer cs) ->
    PendingBuffer (cs ++ str)

  X.logHook . X.config =<< X.ask

setPendingBuffer :: [Char] -> X ()
setPendingBuffer cs = do
  XS.put $ PendingBuffer cs
  X.logHook . X.config =<< X.ask

clearPendingBuffer :: X ()
clearPendingBuffer = do
  XS.put (def :: PendingBuffer)
  X.logHook . X.config =<< X.ask

getPendingBuffer :: X [Char]
getPendingBuffer = unPendingBuffer <$> XS.get

pushPendingBuffer :: (Xish x) => String -> x a -> x a
pushPendingBuffer newPendingBuffer fn = do
  saved <- liftFromX getPendingBuffer
  liftFromX $ setPendingBuffer newPendingBuffer
  fn <* liftFromX (setPendingBuffer saved)

pushAddPendingBuffer :: (Xish x) => String -> x a -> x a
pushAddPendingBuffer toAdd fn = do
  saved <- liftFromX getPendingBuffer
  liftFromX $ setPendingBuffer (saved ++ toAdd)
  fn <* liftFromX (setPendingBuffer saved)