user friendliness fixes

- use full sentences
- better menu flow

app/UI.hs

@@ -53,7 +53,7 @@ getMasterPass = do
   p2 <- required $ prompt "confirm master password: " reqPassword
   if p1 /= p2
     then do
-      reqIO $ putStrLn "passwords do not match"
+      reqIO $ putStrLn "The passwords you entered do not match."
       reqFail
     else return p1
 
@@ -72,15 +72,18 @@ addPassword = do
   svc <- req $ prompt "service name: " reqResp
   db <- S.gets $ view database
   if pwHasService svc db
-    then req (confirm "service exists - overwrite?") >>= flip when (addPassword' svc)
+    then do
-    else addPassword' svc
+      edit <- req (confirm $
-  mainMenu
+        "The service already exists in the database.\n" ++
-
+        "Would you like to edit it?")
-addPassword' :: String -> S.StateT Status IO ()
+      if edit
-addPassword' x = do
+        then doEditPolicy svc
-  d <- buildData
+        else mainMenu
-  S.modify $ over database $ pwSetService x d
+    else do
-  showPass x
+      d <- buildData
+      setService svc d
+      showPass svc
+      servMenu svc
 
 viewEditMenu :: S.StateT Status IO ()
 viewEditMenu = menu "View/Edit Password"
@@ -98,14 +101,12 @@ changeMasterPass = do
 
 lockSession :: S.StateT Status IO ()
 lockSession = do
-  lift $ putStrLn "\nsession locked"
+  lift $ putStrLn "\nThe session is locked."
   pass <- S.gets $ view masterPass
-  mx <- lift $ runRequest $ prompt "password: " reqPassword
+  x <- req $ prompt "master password: " reqPassword
-  case mx of
+  if x == pass
-    Nothing -> lockSession
+    then mainMenu
-    Just x  -> if x == pass
+    else lockSession
-      then mainMenu
-      else lockSession
 
 quit :: S.StateT Status IO ()
 quit = return ()
@@ -113,13 +114,11 @@ quit = return ()
 buildData :: S.StateT Status IO PWData
 buildData = do
   d <- run newPWData
-  req $ reqIf (confirm "would you like to change the default policy?")
+  req $ reqIf (confirm "Would you like to change the password policy?")
     (do
       let p = d^.pwPolicy
-      p <- editPolicy p <|> do
+      p' <- reqDefault (editPolicy p) p
-        reqIO $ putStrLn "invalid password policy - using default"
+      return $ set pwPolicy p' d)
-        return p
-      return $ set pwPolicy p d)
     (return d)
 
 searchServ :: S.StateT Status IO ()
@@ -128,7 +127,7 @@ searchServ = do
   db  <- S.gets $ view database
   case pwSearch svc db of
     []  -> do
-      lift $ putStrLn "\nservice not found"
+      lift $ putStrLn "\nThe service could not be found in the database."
       mainMenu
     [x] -> servMenu x
     xs  -> selectServ xs
@@ -145,69 +144,68 @@ servMenu :: String -> S.StateT Status IO ()
 servMenu x = menu x
   [ ( "show password", showPass x >> servMenu x )
   , ( "edit password", editPassMenu x           )
-  , ( "cancel",        mainMenu                 )
+  , ( "back",          mainMenu                 )
   ]
 
 editPassMenu :: String -> S.StateT Status IO ()
 editPassMenu x = menu (x ++ " : Edit Password")
   [ ( "generate new password", changeSalt x   )
   , ( "edit password policy",  doEditPolicy x )
-  , ( "cancel",                servMenu x     )
+  , ( "back",                  servMenu x     )
   ]
 
 changeSalt :: String -> S.StateT Status IO ()
 changeSalt x = withService x mainMenu $ \d -> do
   salt <- run newPWSalt
-  let d' = set pwSalt salt d
+  setService x $ set pwSalt salt d
-  S.modify $ over database $ pwSetService x d'
   showPass x
-  servMenu x
+  editPassMenu x
 
 doEditPolicy :: String -> S.StateT Status IO ()
 doEditPolicy x = withService x mainMenu $ \d -> do
   let p = d^.pwPolicy
-  tryReq (editPolicy p) >>= maybe
+  p' <- req $ reqDefault (editPolicy p) p
-    (lift $ putStrLn "invalid policy - leaving unchanged")
+  setService x $ set pwPolicy p' d
-    (\p' -> do
+  showPass x
-      S.modify $ over database $ pwSetService x $ set pwPolicy p' d
-      showPass x)
   editPassMenu x
 
 showPass :: String -> S.StateT Status IO ()
 showPass x = do
   lift $ putStrLn ""
   withService x
-    (lift $ putStrLn "service not found") $
+    (lift $ putStrLn "The service could not be found in the database.") $
     \d -> do
       pw <- S.gets $ view masterPass
       lift $ putStrLn $ case pwGenerate pw d of
-        Nothing -> "invalid password data"
+        Nothing -> "The password data were not valid."
         Just pw -> "password for " ++ x ++ ": " ++ pw
 
 -- TODO: refactor this monstrosity
 editPolicy :: PWPolicy -> Request PWPolicy
-editPolicy p = if validatePWPolicy p
+editPolicy p = do
-  then do
+  p <- edit "length" (p^.pwLength) pwLength p
-    p <- edit "length" (p^.pwLength) pwLength p
+  p <- edit "min upper case"  (p^.pwUpper) pwUpper p
-    p <- edit "min upper case"  (p^.pwUpper) pwUpper p
+  p <- edit "min lower case" (p^.pwLower) pwLower p
-    p <- edit "min lower case" (p^.pwLower) pwLower p
+  p <- edit "min digits" (p^.pwDigits) pwDigits p
-    p <- edit "min digits" (p^.pwDigits) pwDigits p
+  p <- special p
-    p <- special p
+  if validatePWPolicy p
-    if validatePWPolicy p
+    then return p
-      then return p
+    else do
-      else reqFail
+      reqIO $ putStrLn $
-  else reqFail
+        "\nThe password policy you entered is invalid\n." ++
+        "It will not be changed."
+      reqFail
   where
     edit l v t p = do
       v <- reqDefault
         (prompt ("new " ++ l ++ " (default " ++ show v ++ "): ") reqInt) v
       return $ set t v p
     special p = do
-      reqIO $ putStrLn $ "special chars are currently " ++
+      reqIO $ putStrLn $ "Special characters are currently " ++
         (case p^.pwSpecial of
           Nothing -> "not "
-          Just _  -> "") ++ "allowed"
+          Just _  -> "") ++ "allowed."
-      reqIf (confirm "allow special chars?")
+      reqIf (confirm "Would you like to allow special characters?")
         (case p^.pwSpecial of
           Nothing -> do
             x <- required $ prompt "min special chars: " reqInt

app/Util.hs

@@ -20,9 +20,17 @@ License along with this program.  If not, see
 
 -}
 
-module Util (menu, run, withService, req, tryReq, confirm) where
+module Util
+  ( menu
+  , run
+  , withService
+  , setService
+  , req
+  , tryReq
+  , confirm
+  ) where
 
-import Control.Lens (view)
+import Control.Lens (over, view)
 import Control.Monad (join)
 import Control.Monad.Trans.Class (lift)
 import qualified Control.Monad.Trans.State as S
@@ -69,6 +77,9 @@ withService srv fb act = do
     Nothing -> fb
     Just x  -> act x
 
+setService :: String -> PWData -> S.StateT Status IO ()
+setService k = S.modify . over database . pwSetService k
+
 req :: Request a -> S.StateT s IO a
 req = lift . fmap fromJust . runRequest . required