CantFindHome error

1 files changed, 15 insertions, 7 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index a2485c4..995afe6 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -166,7 +166,11 @@ data RSAPrivateKey = RSAPrivateKey
  deriving Show
 
 
-data KikiCondition a = KikiSuccess a | FailedToLock [FilePath] | BadPassphrase | FailedToMakeSignature
+data KikiCondition a = KikiSuccess a
+    | FailedToLock [FilePath]
+    | BadPassphrase
+    | FailedToMakeSignature
+    | CantFindHome
 
 #define TRIVIAL(OP) fmap _ (OP) = OP
 instance Functor KikiCondition where
@@ -582,7 +586,13 @@ doImportG doDecrypt db m0 tag fname key = do
 
 runKeyRing :: KeyRingData -> (KeyRingRuntime -> a) -> IO (KikiResult a)
 runKeyRing keyring op = do
-    (homedir,secring,pubring,grip0) <- getHomeDir (homeSpec keyring)
+    homedir <- getHomeDir (homeSpec keyring)
+    let try' :: KikiCondition a -> (a -> IO (KikiResult b)) -> IO (KikiResult b)
+        try' v body =
+            case functorToEither v of
+                   Left e -> return $ KikiResult e []
+                   Right wkun -> body wkun
+    try' homedir $ \(homedir,secring,pubring,grip0) -> do
     let tolocks = filesToLock keyring secring pubring
     lks <- forM tolocks $ \f -> do
         lk <- dotlock_create f 0
@@ -596,9 +606,7 @@ runKeyRing keyring op = do
     ret <- case functorToEither ret of
       Right {} -> do
          bresult <- buildKeyDB secring pubring grip0 keyring -- build db
-         case functorToEither bresult of
-            Left e -> return $ KikiResult e [] 
-            Right ((db,grip), report1) -> do
+         try' bresult $ \((db,grip),report1) -> do
              a <- return $ op KeyRingRuntime
                             { rtPubring = pubring
                             , rtSecring = secring
@@ -627,14 +635,14 @@ parseOptionFile fname = do
 
 getHomeDir protohome = do
         homedir <- envhomedir protohome
-        flip (maybe (error "Could not determine home directory."))
+        flip (maybe (return CantFindHome))
              homedir $ \homedir -> do
         -- putStrLn $ "homedir = " ++show homedir
         let secring = homedir ++ "/" ++ "secring.gpg"
             pubring = homedir ++ "/" ++ "pubring.gpg"
         -- putStrLn $ "secring = " ++ show secring
         workingkey <- getWorkingKey homedir
-        return (homedir,secring,pubring,workingkey)
+        return $ KikiSuccess (homedir,secring,pubring,workingkey)
  where
     envhomedir opt = do
         gnupghome <- lookupEnv (homevar home) >>=