From dcc201eca4f160d5e358d336b2d3666ed8abf077 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Mon, 24 Jun 2019 22:47:05 -0400
Subject: refactor without semantic effect

---
 kiki.cabal     |  2 +-
 lib/KeyRing.hs | 60 +++++++++++++++++++++++++++++-----------------------------
 2 files changed, 31 insertions(+), 31 deletions(-)

diff --git a/kiki.cabal b/kiki.cabal
index 1b2d611..e75c1b0 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -27,7 +27,7 @@ Flag unixEnv
   Default: False
 
 Executable kiki
-    Ghc-Options: -W -Wall -Wno-name-shadowing
+    Ghc-Options: -W -Wall -Wno-name-shadowing -Wno-unused-matches
     Main-is: kiki.hs
     -- base >=4.6 due to use of readEither in KikiD.Message
     Build-Depends:   base >=4.6.0.0,
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index f172e87..cece862 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -14,16 +14,16 @@
 -- Typically, a client to this module would prepare a 'KeyRingOperation'
 -- describing what he wants done, and then invoke 'runKeyRing' to make it
 -- happen.
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DoAndIfThenElse #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE CPP                      #-}
+{-# LANGUAGE DeriveFunctor            #-}
+{-# LANGUAGE DoAndIfThenElse          #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase               #-}
+{-# LANGUAGE OverloadedStrings        #-}
+{-# LANGUAGE PatternGuards            #-}
+{-# LANGUAGE ScopedTypeVariables      #-}
+{-# LANGUAGE TupleSections            #-}
+{-# LANGUAGE ViewPatterns             #-}
 module KeyRing (module KeyRing.Types, module Transforms, module PacketTranscoder, module KeyRing, module KeyRing.BuildKeyDB) where
 
 import System.Environment
@@ -1116,28 +1116,27 @@ initializeMissingPEMFiles operation ctx grip mwk transcode db = do
                                      ++ import_rs ++ internals_rs)
 
 
+-- FIXME: try' should probably accept a list of KikiReportActions.
+--  This would be useful for reporting on disk writes that have already
+--  succeded prior to this termination.
+try' :: Monad m => KikiCondition t -> (t -> m (KikiResult a)) -> m (KikiResult a)
+try' v body =
+  case functorToEither v of
+    Left e -> return $ KikiResult e []
+    Right wkun -> body wkun
 
 -- | Load and update key files according to the specified 'KeyRingOperation'.
 runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime)
 runKeyRing operation = do
     -- get homedir and keyring files + fingerprint for working key
     homedir <- getHomeDir (opHome operation) 
-
-    let try' :: KikiCondition a -> (a -> IO (KikiResult b)) -> IO (KikiResult b)
-        -- FIXME: try' should probably accept a list of KikiReportActions.
-        --  This would be useful for reporting on disk writes that have already
-        --  succeded prior to this termination.
-        try' v body =
-            case functorToEither v of
-                   Left e -> return $ KikiResult e []
-                   Right wkun -> body wkun
-
-    try' homedir $ \(homedir,secring,pubring,grip0) -> do
+    try' homedir $ \(_homedir, secring, pubring, grip0) -> do
     let ctx = InputFileContext secring pubring
         tolocks = filesToLock operation ctx 
     secring <- return Nothing
     pubring <- return Nothing
-    lks <- forM tolocks $ \f -> do
+    (locks :: [(Maybe DotLock, FilePath)]) <-
+      forM tolocks $ \f -> do
         createDirectoryIfMissing True $ takeDirectory f
         lk <- dotlock_create f 0
         v <- flip (maybe $ return Nothing) lk $ \lk -> do
@@ -1145,15 +1144,19 @@ runKeyRing operation = do
                 if e==0 then return $ Just lk
                         else dotlock_destroy lk >> return Nothing
         return (v,f)
-    let (lked, map snd -> failed_locks) = partition (isJust . fst) lks
+    let (lked, map snd -> failed_locks) = partition (isJust . fst) locks
     ret <-
       if not $ null failed_locks
        then return $ KikiResult (FailedToLock failed_locks) []
-       else do
+       else realRunKeyRing ctx grip0 operation
+    forM_ lked $ \(Just lk, fname) -> dotlock_release lk
+    return ret
+
 
-        -- merge all keyrings, PEM files, and wallets
+realRunKeyRing :: InputFileContext -> Maybe String -> KeyRingOperation -> IO (KikiResult KeyRingRuntime)
+realRunKeyRing ctx grip0 operation = do
         bresult <- buildKeyDB ctx grip0 operation
-        try' bresult $ \((db,grip,wk,hs,accs,transcode,unspilled),report_imports) -> do
+        try' bresult $ \((db, grip, wk, hs, accs,transcode,unspilled), report_imports) -> do
 
         externals_ret <- initializeMissingPEMFiles operation
                                                    ctx
@@ -1161,7 +1164,7 @@ runKeyRing operation = do
                                                    wk
                                                    transcode
                                                    db
-        try' externals_ret $ \((db,exports),report_externals) -> do
+        try' externals_ret $ \((db, exports), report_externals) -> do
 
         let decrypt = transcode (Unencrypted,S2K 100 "")
             rt = KeyRingRuntime
@@ -1189,7 +1192,7 @@ runKeyRing operation = do
 
         r <- writePEMKeys decrypt (rtKeyDB rt) exports
         try' r $ \report_pems -> do
-        
+
         import_hosts <- writeHostsFiles operation ctx hs
 
         return $ KikiResult (KikiSuccess rt)
@@ -1200,9 +1203,6 @@ runKeyRing operation = do
                             , report_rings
                             , report_pems ]
 
-    forM_ lked $ \(Just lk, fname) -> dotlock_release lk
-
-    return ret
 
 parseOptionFile :: FilePath -> IO [String]
 parseOptionFile fname = do
-- 
cgit v1.2.3