File: CustomKeybindingDemo.hs

package info (click to toggle)
haskell-brick 2.1.1-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,328 kB
  • sloc: haskell: 8,492; makefile: 5
file content (253 lines) | stat: -rw-r--r-- 10,255 bytes parent folder | download
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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where

import Lens.Micro ((^.))
import Lens.Micro.TH (makeLenses)
import Lens.Micro.Mtl ((<~), (.=), (%=), use)
import Control.Monad (void, forM_, when)
import qualified Data.Set as S
import Data.Maybe (fromJust)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import qualified Graphics.Vty as V
import System.Environment (getArgs)
import System.Exit (exitFailure)

import qualified Brick.Types as T
import Brick.Types (Widget)
import qualified Brick.Keybindings as K
import Brick.AttrMap
import Brick.Util (fg)
import qualified Brick.Main as M
import qualified Brick.Widgets.Border as B
import qualified Brick.Widgets.Center as C
import Brick.Widgets.Core

-- | The abstract key events for the application.
data KeyEvent = QuitEvent
              | IncrementEvent
              | DecrementEvent
              deriving (Ord, Eq, Show)

-- | The mapping of key events to their configuration field names.
allKeyEvents :: K.KeyEvents KeyEvent
allKeyEvents =
    K.keyEvents [ ("quit",      QuitEvent)
                , ("increment", IncrementEvent)
                , ("decrement", DecrementEvent)
                ]

-- | Default key bindings for each abstract key event.
defaultBindings :: [(KeyEvent, [K.Binding])]
defaultBindings =
    [ (QuitEvent,      [K.ctrl 'q', K.bind V.KEsc])
    , (IncrementEvent, [K.bind '+'])
    , (DecrementEvent, [K.bind '-'])
    ]

data St =
    St { _keyConfig :: K.KeyConfig KeyEvent
       -- ^ The key config to use.
       , _lastKey :: Maybe (V.Key, [V.Modifier])
       -- ^ The last key that was pressed.
       , _lastKeyHandled :: Bool
       -- ^ Whether the last key was handled by a handler.
       , _counter :: Int
       -- ^ The counter value to manipulate in the handlers.
       , _customBindingsPath :: Maybe FilePath
       -- ^ Set if the application found custom keybindings in the
       -- specified file.
       , _dispatcher :: K.KeyDispatcher KeyEvent (T.EventM () St)
       -- ^ The key dispatcher we'll use to dispatch input events.
       }

makeLenses ''St

-- | Key event handlers for our application.
handlers :: [K.KeyEventHandler KeyEvent (T.EventM () St)]
handlers =
    -- The first three handlers are triggered by keys mapped to abstract
    -- events, thus decoupling the configured key bindings from these
    -- handlers.
    [ K.onEvent QuitEvent "Quit the program"
          M.halt
    , K.onEvent IncrementEvent "Increment the counter" $
          counter %= succ
    , K.onEvent DecrementEvent "Decrement the counter" $
          counter %= subtract 1

    -- These handlers are always triggered by specific keys and thus
    -- cannot be rebound.
    , K.onKey (K.bind '\t') "Increment the counter by 10" $
          counter %= (+ 10)
    , K.onKey (K.bind V.KBackTab) "Decrement the counter by 10" $
          counter %= subtract 10
    ]

appEvent :: T.BrickEvent () e -> T.EventM () St ()
appEvent (T.VtyEvent (V.EvKey k mods)) = do
    -- Dispatch the key to the event handler to which the key is mapped,
    -- if any. Also record in lastKeyHandled whether the dispatcher
    -- found a matching handler.
    d <- use dispatcher
    lastKey .= Just (k, mods)
    lastKeyHandled <~ K.handleKey d k mods
appEvent _ =
    return ()

drawUi :: St -> [Widget ()]
drawUi st = [body]
    where
        binding = uncurry K.binding <$> st^.lastKey

        -- Generate key binding help using the library so we can embed
        -- it in the UI.
        keybindingHelp = B.borderWithLabel (txt "Active Keybindings") $
                         K.keybindingHelpWidget (st^.keyConfig) handlers

        lastKeyDisplay = withDefAttr lastKeyAttr $
                         txt $ maybe "(none)" K.ppBinding binding

        -- Show the status of the last pressed key, whether we handled
        -- it, and other bits of the application state.
        status = B.borderWithLabel (txt "Status") $
                 hLimit 40 $
                 padRight Max $
                 vBox [ txt   "Last key:         " <+> lastKeyDisplay
                      , str $ "Last key handled: " <> show (st^.lastKeyHandled)
                      , str $ "Counter:          " <> show (st^.counter)
                      ]

        -- Show info about whether the application is currently using
        -- custom bindings loaded from an INI file.
        customBindingInfo =
            B.borderWithLabel (txt "Custom Bindings") $
            case st^.customBindingsPath of
                Nothing ->
                    hLimit 40 $
                    txtWrap $ "No custom bindings loaded. Create an INI file with a " <>
                              (Text.pack $ show sectionName) <>
                              " section or use 'programs/custom_keys.ini'. " <>
                              "Pass its path to this program on the command line."
                Just f -> str "Loaded custom bindings from:" <=> str (show f)

        body = C.center $
               (padRight (Pad 2) $ status <=> customBindingInfo) <+>
               keybindingHelp

lastKeyAttr :: AttrName
lastKeyAttr = attrName "lastKey"

app :: M.App St e ()
app =
    M.App { M.appDraw = drawUi
          , M.appStartEvent = return ()
          , M.appHandleEvent = appEvent
          , M.appAttrMap = const $ attrMap V.defAttr [ (K.eventNameAttr, fg V.magenta)
                                                     , (K.eventDescriptionAttr, fg V.cyan)
                                                     , (K.keybindingAttr, fg V.yellow)
                                                     , (lastKeyAttr, fg V.white `V.withStyle` V.bold)
                                                     ]
          , M.appChooseCursor = M.showFirstCursor
          }

sectionName :: Text.Text
sectionName = "keybindings"

main :: IO ()
main = do
    args <- getArgs

    -- If the command line specified the path to an INI file with custom
    -- bindings, attempt to load it.
    (customBindings, customFile) <- case args of
        [iniFilePath] -> do
            result <- K.keybindingsFromFile allKeyEvents sectionName iniFilePath
            case result of
                -- A section was found and had zero more bindings.
                Right (Just bindings) ->
                    return (bindings, Just iniFilePath)

                -- No section was found at all.
                Right Nothing -> do
                    putStrLn $ "Error: found no section " <> show sectionName <> " in " <> show iniFilePath
                    exitFailure

                -- There was some problem parsing the file as an INI
                -- file.
                Left e -> do
                    putStrLn $ "Error reading keybindings file " <> show iniFilePath <> ": " <> e
                    exitFailure

        _ -> return ([], Nothing)

    -- Create a key config that includes the default bindings as well as
    -- the custom bindings we loaded from the INI file, if any.
    let kc = K.newKeyConfig allKeyEvents defaultBindings customBindings

    -- Before starting the application, check on whether any events have
    -- colliding bindings. Exit if so.
    --
    -- Note that in a Real Application, we would more than likely
    -- want to check for collisions among specific sets of
    -- events. For example, if 'Esc' was bound to both 'quit' and
    -- 'close-dialog-box', we might not care about such a collision
    -- if the application only ever handled the 'close-dialog-box'
    -- event in a separate mode and only ever handled 'quit' at the
    -- top-level of the event handler. But if we had two events such as
    -- 'dialog-box-okay' and 'dialog-box-cancel' that were intended to
    -- be handled in the same mode, we might want to check that those
    -- two events did not have the same binding.
    forM_ (K.keyEventMappings kc) $ \(b, evs) -> do
        when (S.size evs > 1) $ do
            Text.putStrLn $ "Error: key '" <> K.ppBinding b <> "' is bound to multiple events:"
            forM_ evs $ \e ->
                Text.putStrLn $ "  " <> Text.pack (show e) <> " (" <> fromJust (K.keyEventName allKeyEvents e) <> ")"
            exitFailure

    -- Now build a key dispatcher for our event handlers. If this fails
    -- due to key collision detection, we'll print out info about the
    -- collisions.
    d <- case K.keyDispatcher kc handlers of
        Right d -> return d
        Left collisions -> do
            putStrLn "Error: some key events have the same keys bound to them."

            forM_ collisions $ \(b, hs) -> do
                Text.putStrLn $ "Handlers with the '" <> K.ppBinding b <> "' binding:"
                forM_ hs $ \h -> do
                    let trigger = case K.kehEventTrigger $ K.khHandler h of
                            K.ByKey k   -> "triggered by the key '" <> K.ppBinding k <> "'"
                            K.ByEvent e -> "triggered by the event '" <> fromJust (K.keyEventName allKeyEvents e) <> "'"
                        desc = K.handlerDescription $ K.kehHandler $ K.khHandler h

                    Text.putStrLn $ "  " <> desc <> " (" <> trigger <> ")"

            exitFailure

    void $ M.defaultMain app $ St { _keyConfig = kc
                                  , _lastKey = Nothing
                                  , _lastKeyHandled = False
                                  , _counter = 0
                                  , _customBindingsPath = customFile
                                  , _dispatcher = d
                                  }

    -- Now demonstrate how the library's generated key binding help text
    -- looks in plain text and Markdown formats. These can be used to
    -- generate documentation for users. Note that the output generated
    -- here takes the active bindings into account! If you don't want
    -- that, use a key config that doesn't have any custom bindings
    -- applied.
    let sections = [("Main", handlers)]

    putStrLn "Generated plain text help:"
    Text.putStrLn $ K.keybindingTextTable kc sections

    putStrLn "Generated Markdown help:"
    Text.putStrLn $ K.keybindingMarkdownTable kc sections