expose keybinding data

src/Hamming/App/Events.hs

@@ -26,11 +26,17 @@ License along with this program.  If not, see
 
 {-# LANGUAGE LambdaCase, OverloadedStrings #-}
 
-module Hamming.App.Events (eventHandler) where
+module Hamming.App.Events (
+  eventHandler,
+  keyConfigFor,
+  keyEventHandlers
+  ) where
 
-import Brick (BrickEvent (..), halt, )
+import Brick (BrickEvent (..), EventM, halt)
 import Brick.Keybindings
   ( Binding
+  , KeyConfig
+  , KeyEventHandler
   , KeyEvents
   , bind
   , ctrl
@@ -54,28 +60,23 @@ import Hamming
 import Hamming.App.Actions
 import Hamming.App.Types
 
-appEvents :: KeyEvents AppEvent
-appEvents = keyEvents
-  [ ( "quit",     QuitEvent      )
-  , ( "edit",     EditEvent      )
-  , ( "display",  DisplayEvent   )
-  , ( "up",       UpEvent        )
-  , ( "down",     DownEvent      )
-  , ( "left",     LeftEvent      )
-  , ( "right",    RightEvent     )
-  , ( "flip_bit", FlipBitEvent   )
-  , ( "chk_bits", CheckBitsEvent )
-  , ( "fix_code", FixCodeEvent   )
-  , ( "reset",    ResetEvent     )
-  ]
-
 -- | Handles an event
 eventHandler :: Handler
 eventHandler (VtyEvent (EvKey k m)) = do
-  bs <- bindingsFor <$> gets (^.appMode)
+  config <- keyConfigFor <$> gets (^.appMode)
   let
-    kConf = newKeyConfig appEvents bs []
-    disp  = fromRight (error "can't build dispatcher") $ keyDispatcher kConf
+    disp = fromRight (error "can't built dispatcher") $
+      keyDispatcher config keyEventHandlers
+  void $ handleKey disp k m
+eventHandler _ = return ()
+
+-- | The key configuration from a given applicaiton mode
+keyConfigFor :: AppMode -> KeyConfig AppKeyEvent
+keyConfigFor m = newKeyConfig appKeyEvents (keyBindingsFor m) []
+
+-- | Defines the actual key events
+keyEventHandlers :: [KeyEventHandler AppKeyEvent (EventM ResName AppState)]
+keyEventHandlers =
   [ onEvent QuitEvent "Quit Program" halt
   , onEvent EditEvent "Edit Mode" $
     appMode .= EditMode initialEditor
@@ -101,11 +102,24 @@ eventHandler (VtyEvent (EvKey k m)) = do
   , onEvent ResetEvent "Reset Code" $
     hammingCode .= 0
   ]
-  void $ handleKey disp k m
-eventHandler _ = return ()
 
-bindingsFor :: AppMode -> [(AppEvent, [Binding])]
-bindingsFor m = coreBindings ++ case m of
+appKeyEvents :: KeyEvents AppKeyEvent
+appKeyEvents = keyEvents
+  [ ( "quit",     QuitEvent      )
+  , ( "edit",     EditEvent      )
+  , ( "display",  DisplayEvent   )
+  , ( "up",       UpEvent        )
+  , ( "down",     DownEvent      )
+  , ( "left",     LeftEvent      )
+  , ( "right",    RightEvent     )
+  , ( "flip_bit", FlipBitEvent   )
+  , ( "chk_bits", CheckBitsEvent )
+  , ( "fix_code", FixCodeEvent   )
+  , ( "reset",    ResetEvent     )
+  ]
+
+keyBindingsFor :: AppMode -> [(AppKeyEvent, [Binding])]
+keyBindingsFor m = coreBindings ++ case m of
   DisplayMode -> displayBindings
   EditMode _  -> editBindings
   where

src/Hamming/App/Types.hs

@@ -43,7 +43,7 @@ module Hamming.App.Types (
   rowNum,
   colNum,
   -- * Event Types
-  AppEvent (..),
+  AppKeyEvent (..),
   -- * Other Types
   ResName,
   Event,
@@ -81,7 +81,7 @@ data EditState = EditState
   } deriving (Eq, Show)
 
 -- | Event identifiers
-data AppEvent
+data AppKeyEvent
   = QuitEvent
   | EditEvent
   | DisplayEvent