safer registry access routines

+ use patched Win32.

4 files changed, 35 insertions, 29 deletions

diff --git a/apps/AddPath.hs b/apps/AddPath.hs
index 5fba7ce..9f9a5b1 100644
--- a/apps/AddPath.hs
+++ b/apps/AddPath.hs
@@ -6,9 +6,9 @@
 
 module Main (main) where
 
-import Control.Monad (void, when)
-import Data.List     (union)
-import Data.Maybe    (fromMaybe)
+import Control.Monad   (void, when)
+import Data.List       (union)
+import System.IO.Error (ioError, isDoesNotExistError)
 
 import           Options.Applicative
 import qualified Windows.Environment as Env
@@ -52,8 +52,8 @@ main = execParser parser >>= addPath
 
 addPath :: Options -> IO ()
 addPath options = do
-    oldValue <- Env.query profile varName
-    let oldPaths = Env.pathSplit $ fromMaybe "" oldValue
+    oldValue <- Env.query profile varName >>= emptyIfNotFound
+    let oldPaths = Env.pathSplit oldValue
     let newPaths = oldPaths `union` pathsToAdd
     when (length oldPaths /= length newPaths) $ do
         let newValue = Env.pathJoin newPaths
@@ -72,3 +72,8 @@ addPath options = do
         | otherwise   = Env.CurrentUser
 
     skipPrompt = optYes options
+
+    emptyIfNotFound (Left e)
+        | isDoesNotExistError e = return ""
+        | otherwise = ioError e
+    emptyIfNotFound (Right s) = return s
diff --git a/apps/PromptMessage.hs b/apps/PromptMessage.hs
index b02c0a2..27851cf 100644
--- a/apps/PromptMessage.hs
+++ b/apps/PromptMessage.hs
@@ -9,26 +9,23 @@ module PromptMessage
     , wipeMessage
     ) where
 
-import Data.Maybe  (isJust)
 import Text.Printf (printf)
 
 import qualified Windows.Environment as Env
 
-engraveMessage :: Env.Profile -> Env.VarName -> Maybe Env.VarValue -> Env.VarValue -> String
+engraveMessage :: Env.Profile -> Env.VarName -> Env.VarValue -> Env.VarValue -> String
 engraveMessage profile name oldValue newValue =
     descriptionMsg ++ oldValueMsg ++ newValueMsg
   where
     profileKey = Env.profileKeyPath profile
 
-    descriptionMsg = printf "Saving variable '%s' to '%s'...\n" name profileKey
+    descriptionMsg = printf "Saving variable '%s' to '%s'...\n" name (show profileKey)
 
-    oldValueMsg = maybe "" (printf "\tOld value: %s\n") oldValue
-    newValueMsg
-        | isJust oldValue = printf "\tNew value: %s\n" newValue
-        | otherwise       = printf "\tValue: %s\n"     newValue
+    oldValueMsg = printf "\tOld value: %s\n" oldValue
+    newValueMsg = printf "\tNew value: %s\n" newValue
 
 wipeMessage :: Env.Profile -> Env.VarName -> String
 wipeMessage profile name =
-    printf "Deleting variable '%s' from '%s'...\n" name profileKey
+    printf "Deleting variable '%s' from '%s'...\n" name (show profileKey)
   where
     profileKey = Env.profileKeyPath profile
diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs
index 1c8ee51..2956517 100644
--- a/apps/RemovePath.hs
+++ b/apps/RemovePath.hs
@@ -6,9 +6,9 @@
 
 module Main (main) where
 
-import Control.Monad (void, when)
-import Data.List     ((\\))
-import Data.Maybe    (fromJust, isJust)
+import Control.Monad   (void, when)
+import Data.List       ((\\))
+import System.IO.Error (ioError, isDoesNotExistError)
 
 import           Options.Applicative
 import qualified Windows.Environment as Env
@@ -63,15 +63,19 @@ removePath options = do
 
     skipPrompt = optYes options
 
-    removePathFrom profile = do
-        oldValue <- Env.query profile varName
-        when (isJust oldValue) $ do
-            let oldPaths = Env.pathSplit $ fromJust oldValue
-            let newPaths = oldPaths \\ pathsToRemove
-            when (length oldPaths /= length newPaths) $ do
-                let newValue = Env.pathJoin newPaths
-                let promptAnd = if skipPrompt
-                    then withoutPrompt
-                    else withPrompt $ engraveMessage profile varName oldValue newValue
-                let engrave = Env.engrave profile varName newValue
-                void $ promptAnd engrave
+    removePathFrom profile = Env.query profile varName >>= either ignoreMissing (doRemovePathFrom profile)
+
+    ignoreMissing e
+        | isDoesNotExistError e = return ()
+        | otherwise = ioError e
+
+    doRemovePathFrom profile oldValue = do
+        let oldPaths = Env.pathSplit oldValue
+        let newPaths = oldPaths \\ pathsToRemove
+        when (length oldPaths /= length newPaths) $ do
+            let newValue = Env.pathJoin newPaths
+            let promptAnd = if skipPrompt
+                then withoutPrompt
+                else withPrompt $ engraveMessage profile varName oldValue newValue
+            let engrave = Env.engrave profile varName newValue
+            void $ promptAnd engrave
diff --git a/apps/SetEnv.hs b/apps/SetEnv.hs
index 14c23ae..96ef7b1 100644
--- a/apps/SetEnv.hs
+++ b/apps/SetEnv.hs
@@ -61,6 +61,6 @@ setEnv options = void $ promptAnd engrave
     skipPrompt = optYes options
     promptAnd
         | skipPrompt = withoutPrompt
-        | otherwise  = withPrompt $ engraveMessage profile varName Nothing varValue
+        | otherwise  = withPrompt $ engraveMessage profile varName "" varValue
 
     engrave = Env.engrave profile varName varValue