setenv: prompt message update

It also now uncoditionally overrides variables (i.e. even when the
corresponding registy values are not strings).

5 files changed, 25 insertions, 11 deletions

diff --git a/apps/AddPath.hs b/apps/AddPath.hs
index 5ff96c5..7e5ae65 100644
--- a/apps/AddPath.hs
+++ b/apps/AddPath.hs
@@ -76,6 +76,6 @@ addPath options = runExceptT doAddPath >>= either ioError return
             let newValue = Env.pathJoin newPaths
             let promptAnd = if skipPrompt
                 then withoutPrompt
-                else withPrompt $ engraveMessage profile varName oldValue newValue
+                else withPrompt $ oldNewMessage profile varName oldValue newValue
             let engrave = Env.engrave profile varName newValue
             void $ promptAnd engrave
diff --git a/apps/PromptMessage.hs b/apps/PromptMessage.hs
index 27851cf..2bee0a5 100644
--- a/apps/PromptMessage.hs
+++ b/apps/PromptMessage.hs
@@ -5,7 +5,8 @@
 -- Stability   : experimental
 
 module PromptMessage
-    ( engraveMessage
+    ( oldNewMessage
+    , newMessage
     , wipeMessage
     ) where
 
@@ -13,17 +14,23 @@ import Text.Printf (printf)
 
 import qualified Windows.Environment as Env
 
-engraveMessage :: Env.Profile -> Env.VarName -> Env.VarValue -> Env.VarValue -> String
-engraveMessage profile name oldValue newValue =
-    descriptionMsg ++ oldValueMsg ++ newValueMsg
+oldNewMessage :: Env.Profile -> Env.VarName -> Env.VarValue -> Env.VarValue -> String
+oldNewMessage profile name oldValue newValue =
+    descrMsg ++ oldValueMsg ++ newValueMsg
   where
     profileKey = Env.profileKeyPath profile
-
-    descriptionMsg = printf "Saving variable '%s' to '%s'...\n" name (show profileKey)
-
+    descrMsg = printf "Saving variable '%s' to '%s'...\n" name (show profileKey)
     oldValueMsg = printf "\tOld value: %s\n" oldValue
     newValueMsg = printf "\tNew value: %s\n" newValue
 
+newMessage :: Env.Profile -> Env.VarName -> Env.VarValue -> String
+newMessage profile name newValue =
+    descrMsg ++ newValueMsg
+  where
+    profileKey = Env.profileKeyPath profile
+    descrMsg = printf "Saving variable '%s' to '%s'...\n" name (show profileKey)
+    newValueMsg = printf "\tNew value: %s\n" newValue
+
 wipeMessage :: Env.Profile -> Env.VarName -> String
 wipeMessage profile name =
     printf "Deleting variable '%s' from '%s'...\n" name (show profileKey)
diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs
index 7b8f1ac..55e03f1 100644
--- a/apps/RemovePath.hs
+++ b/apps/RemovePath.hs
@@ -79,6 +79,6 @@ removePath options = runExceptT doRemovePath >>= either ioError return
             let newValue = Env.pathJoin newPaths
             let promptAnd = if skipPrompt
                 then withoutPrompt
-                else withPrompt $ engraveMessage profile varName oldValue newValue
+                else withPrompt $ oldNewMessage 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 0c8df32..aa8c583 100644
--- a/apps/SetEnv.hs
+++ b/apps/SetEnv.hs
@@ -64,8 +64,8 @@ setEnv options = runExceptT doSetEnv >>= either ioError return
     skipPrompt = optYes options
     promptAnd
         | skipPrompt = withoutPrompt
-        | otherwise  = withPrompt $ engraveMessage profile varName "" varValue
+        | otherwise  = withPrompt $ newMessage profile varName varValue
 
-    engrave = Env.engrave profile varName varValue
+    engrave = Env.engraveForce profile varName varValue
 
     doSetEnv = void $ promptAnd engrave
diff --git a/src/Windows/Environment.hs b/src/Windows/Environment.hs
index 859667e..d44b291 100644
--- a/src/Windows/Environment.hs
+++ b/src/Windows/Environment.hs
@@ -14,6 +14,7 @@ module Windows.Environment
     , VarValue
     , query
     , engrave
+    , engraveForce
     , wipe
 
     , pathJoin
@@ -54,6 +55,12 @@ engrave profile name value = do
     lift notifyEnvironmentUpdate
     return ret
 
+engraveForce :: Profile -> VarName -> VarValue -> ExceptT IOError IO ()
+engraveForce profile name value = do
+    ret <- Registry.setString (profileKeyPath profile) name value
+    lift notifyEnvironmentUpdate
+    return ret
+
 wipe :: Profile -> VarName -> ExceptT IOError IO ()
 wipe profile name = do
     ret <- Registry.deleteValue (profileKeyPath profile) name