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
|
-- Module for the KeyFeed monad.
--
-- The KeyFeed Monad abstracts control flow over a stream of key presses in RDE.
module Rahm.Desktop.Keys.KeyFeed where
import Control.Monad (void, when)
import Control.Monad.State (MonadTrans (lift), StateT, evalStateT, modify')
import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT))
import Data.List.Safe (head, last)
import Rahm.Desktop.Common (Xish (..))
import Rahm.Desktop.Submap (mapNextStringWithKeysym)
import Rahm.Desktop.XMobarLog.PendingBuffer (addStringToPendingBuffer, pushAddPendingBuffer, pushPendingBuffer)
import XMonad
import Prelude hiding (head, last)
-- A key is a mask and a keysym. The string is the string returned from
-- XLookupString.
type Key = (KeyMask, KeySym, String)
-- A list of keys
type KeyString = [Key]
-- List of actions which return a key.
type KeyStream = [MaybeT X Key]
newtype KeyFeed a = KeyFeed (StateT KeyStream (MaybeT X) a)
deriving (Functor, Applicative, Monad)
instance Xish KeyFeed where
liftFromX = liftXToFeed
-- Executes a KeyFeed, returning a MaybeT of the result
runKeyFeed :: KeyFeed a -> MaybeT X a
runKeyFeed = runKeyFeedWithStartingKeys []
-- Executes a KeyFeed, evaluating down to an X (Maybe a)
runKeyFeedX :: KeyFeed a -> X (Maybe a)
runKeyFeedX = runMaybeT . runKeyFeed
-- Exceutes a KeyFeed. Does not evaluate the results.
execKeyFeed :: KeyFeed a -> X ()
execKeyFeed = void . runMaybeT . runKeyFeed
-- Executes a KeyFeed, evaluating the keystring first, then evaluating actual
-- key presses.
runKeyFeedWithStartingKeys :: KeyString -> KeyFeed a -> MaybeT X a
runKeyFeedWithStartingKeys st (KeyFeed r) =
evalStateT r $
(map return st ++) $
repeat $ do
mapNextStringWithKeysym $ \m s st -> return (m, s, st)
-- Executes a KeyFeed only on the given key presses.
runKeyFeedWithKeys :: KeyString -> KeyFeed a -> MaybeT X a
runKeyFeedWithKeys st (KeyFeed r) = evalStateT r (toKeyStream st)
-- Executes a function on the next key read and returns the result.
readNextKey :: ((KeyMask, KeySym, String) -> KeyFeed a) -> KeyFeed a
readNextKey fn = KeyFeed $ do
keyList <- get
nextKeyFn <- upMaybe $ head keyList
nextKey@(_, sym, str) <- lift nextKeyFn
-- escape always ends a key feed.
when (sym == xK_Escape) $ do
let (KeyFeed r) = feedFail in r
modify' tail
let (KeyFeed r) = liftFromX (addStringToPendingBuffer str) >> fn nextKey in r
where
upMaybe :: Maybe a -> StateT KeyStream (MaybeT X) a
upMaybe m = lift $ MaybeT (return m)
-- Lifts a Maybe int o a KeyFeed.
hoistMaybe :: Maybe a -> KeyFeed a
hoistMaybe = KeyFeed . lift . MaybeT . return
-- Lifts a Maybe int o a KeyFeed.
hoistMaybeT :: MaybeT X a -> KeyFeed a
hoistMaybeT = KeyFeed . lift
-- Fails a KeyFeed action.
feedFail :: KeyFeed a
feedFail = KeyFeed $ lift (MaybeT $ return Nothing)
-- Lifts an X action into a KeyFeed action.
liftXToFeed :: X a -> KeyFeed a
liftXToFeed = KeyFeed . lift . lift
-- Lifts an X action into a KeyFeed action.
liftXMaybe :: X (Maybe a) -> KeyFeed a
liftXMaybe = KeyFeed . lift . MaybeT
-- Removes a maybe and pushes it into the KeyFeed monad. If the maybe is
-- Nothing, the KeyFeed fails.
absorbMaybe :: KeyFeed (Maybe a) -> KeyFeed a
absorbMaybe fn = hoistMaybe =<< fn
-- Inserts keys to the beginnig of the KeyFeed buffer.
pushKeys :: KeyString -> KeyFeed ()
pushKeys ks = KeyFeed $ modify' (map return ks ++)
-- Inserts a single key to the beginning of the KeyFeed buffer.
pushKey :: (KeyMask, KeySym, String) -> KeyFeed ()
pushKey = pushKeys . (: [])
-- Converts a string of keys to a stream of keys.
toKeyStream :: KeyString -> KeyStream
toKeyStream = map return
|
