implemented keyboard handler

src/Abacus/App/Events.hs

@@ -0,0 +1,76 @@
+{-|
+
+Module      : Abacus.App.Events
+Description : Application event handling
+Copyright   : (C) Jonathan Lamothe
+License     : AGPL-3.0-or-later
+Maintainer  : jonathan@jlamothe.net
+Stability   : experimental
+Portability : POSIX
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as
+published by the Free Software Foundation, either version 3 of the
+License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public
+License along with this program.  If not, see
+<https://www.gnu.org/licenses/>.
+
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Abacus.App.Events (appKeyDispatcher) where
+
+import Brick (EventM, halt)
+import Brick.Keybindings
+  ( Binding
+  , KeyConfig
+  , KeyDispatcher
+  , KeyEventHandler
+  , KeyEvents
+  , bind
+  , ctrl
+  , keyDispatcher
+  , keyEvents
+  , newKeyConfig
+  , onEvent
+  )
+import Data.Either (fromRight)
+
+import Abacus.App.Types
+
+-- | Application keyboard configuration
+appKeyDispatcher :: KeyDispatcher KeyEventID (EventM () AppState)
+appKeyDispatcher = fromRight (error "can't build key dispatcher") $
+  keyDispatcher keyConfig eventBindings
+
+-- | The key configuration
+keyConfig :: KeyConfig KeyEventID
+keyConfig = newKeyConfig appKeyEvents keyBindings []
+
+-- | Binds a "KeyEventID" to its associated action
+eventBindings :: [KeyEventHandler KeyEventID (EventM () AppState)]
+eventBindings = [onEvent QuitE "Quits the program" halt]
+
+-- | Names the individual key events
+appKeyEvents :: KeyEvents KeyEventID
+appKeyEvents = keyEvents [( "quit", QuitE )]
+
+-- | Key bindings
+keyBindings :: [(KeyEventID, [Binding])]
+keyBindings =
+  [ ( QuitE
+    , [ ctrl 'c'
+      , bind 'q'
+      ]
+    )
+  ]
+
+--jl