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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
-- 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 Linear.V (reifyDim)
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 = KeyFeed . lift . lift
finallyX (KeyFeed mt) (KeyFeed err) =
KeyFeed $ do
r <- recover mt
case r of
Nothing -> do
err
let (KeyFeed r) = feedFail in r
Just a -> err >> pure a
where
recover fn = StateT $ \s -> MaybeT $ do
r <- runMaybeT (runStateT fn s)
pure $
Just $
case r of
Nothing -> (Nothing, s)
Just (a, s') -> (Just a, s')
-- 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)
skipKey :: KeyFeed ()
skipKey = KeyFeed $ modify' tail
-- 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 . (: [])
-- Reads the next key, but does not consume it from the read buffer.
peekKey :: ((KeyMask, KeySym, String) -> KeyFeed a) -> KeyFeed a
peekKey fn = KeyFeed $ do
keyList <- get
nextKeyFn <- lift . MaybeT . return $ head keyList
nextKey@(_, sym, str) <- lift nextKeyFn
modify' ((return nextKey :) . tail)
let (KeyFeed r) = fn nextKey in r
-- reifiedKey <- lift nextKeyFn
-- modify' (\l -> reifiedKey : tail l)
-- return reifiedKey
-- Converts a string of keys to a stream of keys.
toKeyStream :: KeyString -> KeyStream
toKeyStream = map return
|
