handle events for password entry form

package.yaml

@@ -27,8 +27,11 @@ dependencies:
 - containers >= 0.6.2.1 && < 0.7
 - microlens >= 0.4.11.2 && < 0.5
 - microlens-th >= 0.4.3.6 && < 0.5
+- microlens-mtl >= 0.2.0.3 && < 0.3
 - random >=1.2.1.1 && < 1.3
 - brick >= 2.1.1 && < 2.2
+- vty >= 6.1 && < 6.2
+- mtl >= 2.3.1 && < 2.4
 
 ghc-options:
 - -Wall

passman.cabal

@@ -4,7 +4,7 @@ cabal-version: 2.2
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 1fb75b25a67b68f60aa6fa054876daeef931fac289d7f62c2b455533ab282fba
+-- hash: fb2b45c8e1d5aead518c67637b3af5e78b55b8f0c5a95a34c20ca5d957527fa0
 
 name:           passman
 version:        0.3.1.1
@@ -28,6 +28,7 @@ library
       Password
       Password.App
       Password.App.Draw
+      Password.App.Event
       Password.App.Types
   other-modules:
       Paths_passman
@@ -46,9 +47,12 @@ library
     , bytestring >=0.11.4.0 && <0.12
     , containers >=0.6.2.1 && <0.7
     , microlens >=0.4.11.2 && <0.5
+    , microlens-mtl >=0.2.0.3 && <0.3
     , microlens-th >=0.4.3.6 && <0.5
+    , mtl >=2.3.1 && <2.4
     , random >=1.2.1.1 && <1.3
     , text >=2.0.2 && <2.1
+    , vty ==6.1.*
   default-language: Haskell2010
 
 executable passman
@@ -67,9 +71,12 @@ executable passman
     , bytestring >=0.11.4.0 && <0.12
     , containers >=0.6.2.1 && <0.7
     , microlens >=0.4.11.2 && <0.5
+    , microlens-mtl >=0.2.0.3 && <0.3
     , microlens-th >=0.4.3.6 && <0.5
+    , mtl >=2.3.1 && <2.4
     , passman
     , random >=1.2.1.1 && <1.3
+    , vty ==6.1.*
   default-language: Haskell2010
 
 test-suite passman-test
@@ -104,7 +111,10 @@ test-suite passman-test
     , bytestring >=0.11.4.0 && <0.12
     , containers >=0.6.2.1 && <0.7
     , microlens >=0.4.11.2 && <0.5
+    , microlens-mtl >=0.2.0.3 && <0.3
     , microlens-th >=0.4.3.6 && <0.5
+    , mtl >=2.3.1 && <2.4
     , passman
     , random >=1.2.1.1 && <1.3
+    , vty ==6.1.*
   default-language: Haskell2010

src/Password/App.hs

@@ -26,15 +26,13 @@ module Password.App (passmanApp) where
 
 import Brick
   ( App (..)
-  , BrickEvent
-  , EventM
   , attrMap
-  , halt
   , showFirstCursor
   , style
   )
 
 import Password.App.Draw
+import Password.App.Event
 import Password.App.Types
 
 -- | The main application
@@ -47,7 +45,4 @@ passmanApp = App
   , appAttrMap      = const $ attrMap (style 0) []
   }
 
-eventHandler :: BrickEvent ResName () -> EventM ResName AppState ()
-eventHandler = const halt
-
 --jl

src/Password/App/Event.hs

@@ -0,0 +1,79 @@
+{-|
+
+Module:      Password.App.Event
+Description: event handling functions
+Copyright:   (C) Jonathan Lamothe
+License:     LGPLv3 (or later)
+Maintainer:  jonathan@jlamothe.net
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Lesser 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
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this program.  If not, see
+<https://www.gnu.org/licenses/>.
+
+-}
+
+{-# LANGUAGE LambdaCase, OverloadedStrings #-}
+
+module Password.App.Event (eventHandler) where
+
+import Brick (BrickEvent (VtyEvent), EventM, halt)
+import Brick.Forms (handleFormEvent)
+import Brick.Keybindings
+  ( Binding
+  , KeyDispatcher
+  , ctrl
+  , handleKey
+  , keyDispatcher
+  , keyEvents
+  , newKeyConfig
+  , onEvent
+  )
+import Control.Monad (unless)
+import Control.Monad.State.Class (gets)
+import Graphics.Vty.Input.Events (Event (EvKey))
+import Lens.Micro ((^.))
+import Lens.Micro.Mtl (zoom)
+
+import Password.App.Types
+
+data KEventID = QuitKE deriving (Eq, Ord, Show)
+
+-- | The main event handler
+eventHandler :: BrickEvent ResName () -> EventM ResName AppState ()
+eventHandler e@(VtyEvent (EvKey k m)) = do
+  disp <- gets getKeyDispatcher
+  handleKey disp k m >>= flip unless (fallbackHandler e)
+eventHandler e = fallbackHandler e
+
+fallbackHandler :: BrickEvent ResName () -> EventM ResName AppState ()
+fallbackHandler e = gets (^.appMode) >>= \case
+  InitMode _ -> zoom (appMode.initState.setPassForm) $
+    handleFormEvent e
+
+getKeyDispatcher
+  :: AppState
+  -> KeyDispatcher KEventID (EventM ResName AppState)
+getKeyDispatcher s = either (error "can't build dispatcher") id $
+  keyDispatcher conf handlers
+  where
+    conf     = newKeyConfig ke bs []
+    ke       = keyEvents []
+    bs       = keyBindingsFor s
+    handlers =
+      [ onEvent QuitKE "Quit Application" halt
+      ]
+
+keyBindingsFor :: AppState -> [(KEventID, [Binding])]
+keyBindingsFor = const [(QuitKE, [ctrl 'c'])]
+
+--jl