104 lines
2.8 KiB
Haskell
104 lines
2.8 KiB
Haskell
{-|
|
|
|
|
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, loadDatabase) 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.IO.Class (liftIO)
|
|
import Control.Monad.State.Class (gets, put)
|
|
import Data.Aeson (decodeFileStrict)
|
|
import Graphics.Vty.Input.Events (Event (EvKey))
|
|
import Lens.Micro ((^.))
|
|
import Lens.Micro.Mtl (zoom)
|
|
import System.EasyFile
|
|
( createDirectoryIfMissing
|
|
, getAppUserDataDirectory
|
|
, (</>)
|
|
)
|
|
|
|
import Password.App.Types
|
|
|
|
dbFile :: String
|
|
dbFile = "database.json"
|
|
|
|
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
|
|
|
|
loadDatabase :: EventM ResName AppState ()
|
|
loadDatabase = zoom database $ liftIO
|
|
( do
|
|
dir <- mkAppDir
|
|
let fn = dir </> dbFile
|
|
decodeFileStrict fn
|
|
) >>= mapM_ put
|
|
|
|
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'])]
|
|
|
|
mkAppDir :: IO FilePath
|
|
mkAppDir = do
|
|
path <- getAppUserDataDirectory "passman"
|
|
createDirectoryIfMissing True path
|
|
return path
|
|
|
|
--jl
|