implemented main menu and master password changing

app/Main.hs

@@ -20,29 +20,70 @@ License along with this program.  If not, see
 
 -}
 
+{-# LANGUAGE TemplateHaskell #-}
+
 module Main where
 
-import System.Console.HCL
+import Control.Lens (makeLenses, set, view)
-  ( Request (..)
+import qualified Control.Monad.Trans.State as S
-  , execReq
+import Control.Monad (join)
-  , prompt
+import Control.Monad.Trans.Class (lift)
-  , reqFail
+import Data.Maybe (fromJust)
-  , reqIO
+import qualified System.Console.HCL as R
-  , reqPassword
+
-  , required
+data Status = Status
-  )
+  { _masterPass :: String
+  }
+
+makeLenses ''Status
 
 main :: IO ()
-main = execReq getMasterPass
+main = do
+  ms <- R.runRequest setup
+  case ms of
+    Nothing -> return ()
+    Just s  -> S.evalStateT mainMenu s
 
-getMasterPass :: Request String
+setup :: R.Request Status
+setup = fmap Status getMasterPass
+
+getMasterPass :: R.Request String
 getMasterPass = do
-  p1 <- required $ prompt "master password: " reqPassword
+  p1 <- R.required $ R.prompt "master password: " R.reqPassword
-  p2 <- required $ prompt "confirm master password: " reqPassword
+  p2 <- R.required $ R.prompt "confirm master password: " R.reqPassword
   if p1 /= p2
     then do
-      reqIO $ putStrLn "passwords do not match"
+      R.reqIO $ putStrLn "passwords do not match"
-      reqFail
+      R.reqFail
     else return p1
 
+mainMenu :: S.StateT Status IO ()
+mainMenu = do
+  menu "Main Menu"
+    [ ( "change master password", changeMasterPass )
+    , ( "quit",                   quit             )
+    ]
+
+changeMasterPass :: S.StateT Status IO ()
+changeMasterPass = do
+  oldP <- S.gets $ view masterPass
+  newP <- req $ R.reqDefault getMasterPass oldP
+  S.modify $ set masterPass newP
+  mainMenu
+
+quit :: S.StateT Status IO ()
+quit = return ()
+
+menu :: String -> [(String, S.StateT Status IO a)] -> S.StateT Status IO a
+menu title = reqState . R.prompt title . R.reqMenu . map menuItem
+
+menuItem :: (String, a) -> (String, R.Request a)
+menuItem (str, x) = (str, return x)
+
+reqState :: R.Request (S.StateT s IO a) -> S.StateT s IO a
+reqState = join . req
+
+req :: R.Request a -> S.StateT s IO a
+req = lift . fmap fromJust . R.runRequest . R.required
+
 --jl

package.yaml

@@ -21,6 +21,7 @@ description:         Please see the README on GitHub at <https://github.com/jlam
 
 dependencies:
 - base >= 4.7 && < 5
+- lens
 
 library:
   source-dirs: src
@@ -36,6 +37,7 @@ executables:
     dependencies:
     - passman
     - HCL >= 1.7.1 && < 2
+    - transformers
 
 tests:
   passman-test: