diff --git a/package.yaml b/package.yaml index b45ace8..134020b 100644 --- a/package.yaml +++ b/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 diff --git a/passman.cabal b/passman.cabal index a2b8727..7a40e37 100644 --- a/passman.cabal +++ b/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 diff --git a/src/Password/App.hs b/src/Password/App.hs index d5ec309..74f9c9e 100644 --- a/src/Password/App.hs +++ b/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 diff --git a/src/Password/App/Event.hs b/src/Password/App/Event.hs new file mode 100644 index 0000000..a7eac47 --- /dev/null +++ b/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 +. + +-} + +{-# 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