bugfix + refactoring

8 files changed, 105 insertions, 93 deletions

diff --git a/apps/AddPath.hs b/apps/AddPath.hs
index 5203723..ad65242 100644
--- a/apps/AddPath.hs
+++ b/apps/AddPath.hs
@@ -7,30 +7,32 @@
 module Main (main) where
 
 import Control.Monad (when)
+import Data.List     (union)
+import Data.Maybe    (fromMaybe)
 
 import Options.Applicative
 
 import qualified Environment
 
 data Options = Options
-    { name :: String
-    , global :: Bool
-    , paths :: [String]
+    { optName :: String
+    , optGlobal :: Bool
+    , optPaths :: [String]
     } deriving (Eq, Show)
 
 options :: Parser Options
 options = Options
-    <$> nameOption
-    <*> globalOption
-    <*> pathArgs
+    <$> optNameDesc
+    <*> optGlobalDesc
+    <*> optPathsDesc
   where
-    nameOption = strOption $
+    optNameDesc = strOption $
         long "name" <> short 'n' <> metavar "NAME" <> value "PATH" <>
         help "Specify variable name ('PATH' by default)"
-    globalOption = switch $
+    optGlobalDesc = switch $
         long "global" <> short 'g' <>
         help "Whether to add for all users"
-    pathArgs = many $ argument str $
+    optPathsDesc = many $ argument str $
         metavar "PATH" <>
         help "Directory path(s)"
 
@@ -42,13 +44,14 @@ main = execParser parser >>= addPath
 
 addPath :: Options -> IO ()
 addPath options = do
-    missingPaths <- dropIncludedPaths $ paths options
-    when (not $ null missingPaths) $ do
-        oldPath <- Environment.query env $ name options
-        Environment.engraveWithPrompt env (name options) $ Environment.pathJoin $ missingPaths ++ [oldPath]
+    oldValue <- Environment.query env varName
+    let oldPaths = Environment.pathSplit $ fromMaybe "" oldValue
+    let newPaths = union oldPaths pathsToAdd
+    when (length oldPaths /= length newPaths) $ do
+        let newValue = Environment.pathJoin newPaths
+        Environment.engraveWithPrompt env varName newValue
   where
-    dropIncludedPaths paths = do
-        currentPath <- Environment.query env $ name options
-        return $ filter (flip notElem $ Environment.pathSplit currentPath) paths
-    env | global options = Environment.AllUsers
-        | otherwise      = Environment.CurrentUser
+    env | optGlobal options = Environment.AllUsers
+        | otherwise         = Environment.CurrentUser
+    varName = optName options
+    pathsToAdd = optPaths options
diff --git a/apps/FixNtSymbolPath.hs b/apps/FixNtSymbolPath.hs
index a44a840..f3d465e 100644
--- a/apps/FixNtSymbolPath.hs
+++ b/apps/FixNtSymbolPath.hs
@@ -6,7 +6,9 @@
 
 module Main (main) where
 
-import Control.Monad    (unless)
+import Control.Monad    (when)
+import Data.List        (union)
+import Data.Maybe       (fromMaybe)
 import System.Directory (createDirectoryIfMissing, getCurrentDirectory)
 import System.FilePath  (combine)
 
@@ -32,18 +34,17 @@ getPdbsDirectoryPath = do
 
 fixNtSymbolPath :: IO ()
 fixNtSymbolPath = do
-    let env = Environment.CurrentUser
-    val <- Environment.query env ntSymbolPath
-    let presentPaths = Environment.pathSplit val
-    remoteSymbolsPath <- getRemoteSymbolsDirectoryPath
-    pdbsPath <- getPdbsDirectoryPath
-    let requiredPaths = [pdbsPath, remoteSymbolsPath]
-    let missingPaths = filter (`notElem` presentPaths) requiredPaths
-    unless (null missingPaths) $ do
-        let newval = Environment.pathJoin $ presentPaths ++ missingPaths
-        Environment.engrave env ntSymbolPath newval
+    oldValue <- Environment.query env varName
+    let oldPaths = Environment.pathSplit $ fromMaybe "" oldValue
+    pathsToAdd <- addPaths
+    let newPaths = union oldPaths pathsToAdd
+    when (length oldPaths /= length newPaths) $ do
+        let newValue = Environment.pathJoin newPaths
+        Environment.engrave env varName newValue
   where
-    ntSymbolPath = "_NT_SYMBOL_PATH"
+    env = Environment.CurrentUser
+    varName = "_NT_SYMBOL_PATH"
+    addPaths = sequence [getRemoteSymbolsDirectoryPath, getPdbsDirectoryPath]
 
 main :: IO ()
 main = fixNtSymbolPath
diff --git a/apps/ListPath.hs b/apps/ListPath.hs
index 63460b9..469fbba 100644
--- a/apps/ListPath.hs
+++ b/apps/ListPath.hs
@@ -16,13 +16,13 @@ import Options.Applicative
 import qualified Environment
 
 data Options = Options
-    { name :: String
+    { optName :: String
     } deriving (Eq, Show)
 
 options :: Parser Options
-options = Options <$> nameOption
+options = Options <$> optNameDesc
   where
-    nameOption = strOption $
+    optNameDesc = strOption $
         long "name" <> short 'n' <> metavar "NAME" <> value "PATH" <>
         help "Specify variable name ('PATH' by default)"
 
@@ -32,14 +32,14 @@ main = execParser parser >>= listPath
     parser = info (helper <*> options) $
         fullDesc <> progDesc "List directories in your PATH"
 
-getEnv :: String -> IO String
-getEnv = liftM (fromMaybe "") . lookupEnv
-
 listPath :: Options -> IO ()
 listPath options = do
-    val <- getEnv $ name options
-    mapM_ printPath $ Environment.pathSplit val
+    oldValue <- getEnv varName
+    let oldPaths = Environment.pathSplit oldValue
+    mapM_ printPath oldPaths
   where
+    varName = optName options
+    getEnv = liftM (fromMaybe "") . lookupEnv
     printPath p = do
         exists <- doesDirectoryExist p
         putStrLn $ (if exists then "+" else "-") ++ " " ++ p
diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs
index e04a67b..2fecda6 100644
--- a/apps/RemovePath.hs
+++ b/apps/RemovePath.hs
@@ -7,29 +7,31 @@
 module Main (main) where
 
 import Control.Monad (when)
+import Data.List     ((\\))
+import Data.Maybe    (fromJust, isJust)
 
 import Options.Applicative
 
 import qualified Environment
 
 data Options = Options
-    { name :: String
-    , global :: Bool
-    , paths :: [String]
+    { optName :: String
+    , optGlobal :: Bool
+    , optPaths :: [String]
     } deriving (Eq, Show)
 
 options = Options
-    <$> nameOption
-    <*> globalOption
-    <*> pathArgs
+    <$> optNameDesc
+    <*> optGlobalDesc
+    <*> optPathsDesc
   where
-    nameOption = strOption $
+    optNameDesc = strOption $
         long "name" <> short 'n' <> metavar "NAME" <> value "PATH" <>
         help "Specify variable name ('PATH' by default)"
-    globalOption = switch $
+    optGlobalDesc = switch $
         long "global" <> short 'g' <>
         help "Whether to remove for all users"
-    pathArgs = many $ argument str $
+    optPathsDesc = many $ argument str $
         metavar "PATH" <>
         help "Directory path(s)"
 
@@ -41,15 +43,18 @@ main = execParser parser >>= removePath
 
 removePath :: Options -> IO ()
 removePath options = do
-    let varName = name options
-    userVal <- Environment.query Environment.CurrentUser varName
-    let userValParts = Environment.pathSplit userVal
-    let newUserValParts = filter (flip notElem $ paths options) userValParts
-    when (length userValParts /= length newUserValParts) $ do
-        Environment.engraveWithPrompt Environment.CurrentUser varName $ Environment.pathJoin newUserValParts
-    when (global options) $ do
-        globalVal <- Environment.query Environment.AllUsers varName
-        let globalValParts = Environment.pathSplit globalVal
-        let newGlobalValParts = filter (flip notElem $ paths options) globalValParts
-        when (length globalValParts /= length newGlobalValParts) $ do
-            Environment.engraveWithPrompt Environment.AllUsers varName $ Environment.pathJoin newGlobalValParts
+    removePathFrom Environment.CurrentUser options
+    when (optGlobal options) $ do
+        removePathFrom Environment.AllUsers options
+  where
+    varName = optName options
+    pathsToRemove = optPaths options
+
+    removePathFrom env options = do
+        oldValue <- Environment.query env varName
+        when (isJust oldValue) $ do
+            let oldPaths = Environment.pathSplit $ fromJust oldValue
+            let newPaths = oldPaths \\ pathsToRemove
+            when (length oldPaths /= length newPaths) $ do
+                let newValue = Environment.pathJoin newPaths
+                Environment.engraveWithPrompt env varName newValue
diff --git a/apps/SetEnv.hs b/apps/SetEnv.hs
index fad7526..812975b 100644
--- a/apps/SetEnv.hs
+++ b/apps/SetEnv.hs
@@ -11,24 +11,24 @@ import Options.Applicative hiding (value)
 import qualified Environment
 
 data Options = Options
-    { global :: Bool
-    , name :: String
-    , value :: String
+    { optGlobal :: Bool
+    , optName :: String
+    , optValue :: String
     } deriving (Eq, Show)
 
 options :: Parser Options
 options = Options
-    <$> globalOption
-    <*> nameArg
-    <*> valueArg
+    <$> optGlobalDesc
+    <*> optNameDesc
+    <*> optValueDesc
   where
-    globalOption = switch $
+    optGlobalDesc = switch $
         long "global" <> short 'g' <>
         help "Whether to set for all users"
-    nameArg = argument str $
+    optNameDesc = argument str $
         metavar "NAME" <>
         help "Variable name"
-    valueArg = argument str $
+    optValueDesc = argument str $
         metavar "VALUE" <>
         help "Variable value"
 
@@ -39,7 +39,9 @@ main = execParser parser >>= setEnv
         fullDesc <> progDesc "Set environment variables"
 
 setEnv :: Options -> IO ()
-setEnv options = Environment.engraveWithPrompt env (name options) (value options)
+setEnv options = Environment.engraveWithPrompt env varName varValue
   where
-    env | global options = Environment.AllUsers
-        | otherwise      = Environment.CurrentUser
+    env | optGlobal options = Environment.AllUsers
+        | otherwise         = Environment.CurrentUser
+    varName = optName options
+    varValue = optValue options
diff --git a/apps/UnsetEnv.hs b/apps/UnsetEnv.hs
index 6fa2f2c..51f71e8 100644
--- a/apps/UnsetEnv.hs
+++ b/apps/UnsetEnv.hs
@@ -11,19 +11,19 @@ import Options.Applicative
 import qualified Environment
 
 data Options = Options
-    { global :: Bool
-    , name :: String
+    { optGlobal :: Bool
+    , optName :: String
     } deriving (Eq, Show)
 
 options :: Parser Options
 options = Options
-    <$> globalOption
-    <*> nameArg
+    <$> optGlobalDesc
+    <*> optNameDesc
   where
-    globalOption = switch $
+    optGlobalDesc = switch $
         long "global" <> short 'g' <>
         help "Whether to unset for all users"
-    nameArg = argument str $
+    optNameDesc = argument str $
         metavar "NAME" <>
         help "Variable name"
 
@@ -34,7 +34,8 @@ main = execParser parser >>= unsetEnv
         fullDesc <> progDesc "Unset environment variables"
 
 unsetEnv :: Options -> IO ()
-unsetEnv options = Environment.wipeWithPrompt env $ name options
+unsetEnv options = Environment.wipeWithPrompt env varName
   where
-    env | global options = Environment.AllUsers
-        | otherwise      = Environment.CurrentUser
+    env | optGlobal options = Environment.AllUsers
+        | otherwise         = Environment.CurrentUser
+    varName = optName options
diff --git a/src/Environment.hs b/src/Environment.hs
index c0dd723..eef1948 100644
--- a/src/Environment.hs
+++ b/src/Environment.hs
@@ -19,6 +19,7 @@ module Environment
 import Control.Monad   (when)
 import Data.List       (intercalate)
 import Data.List.Split (splitOn)
+import Data.Maybe      (fromJust, isJust)
 import System.IO.Error (catchIOError, isDoesNotExistError)
 
 import qualified Graphics.Win32.Window as WinAPI
@@ -64,12 +65,12 @@ notifyEnvUpdate =
 
     allWindows = WinAPI.castUINTPtrToPtr 0xffff
 
-query :: RegistryLocation -> Registry.ValueName -> IO Registry.ValueData
+query :: RegistryLocation -> Registry.ValueName -> IO (Maybe Registry.ValueData)
 query env name = do
     keyHandle <- openRegistryKey env
-    catchIOError (Registry.getString keyHandle name) emptyIfDoesNotExist
+    catchIOError (Registry.getString keyHandle name >>= return . Just) emptyIfDoesNotExist
   where
-    emptyIfDoesNotExist e = if isDoesNotExistError e then return "" else ioError e
+    emptyIfDoesNotExist e = if isDoesNotExistError e then return Nothing else ioError e
 
 engrave :: RegistryLocation -> Registry.ValueName -> Registry.ValueData -> IO ()
 engrave env name value = do
@@ -81,8 +82,12 @@ engraveWithPrompt :: RegistryLocation -> Registry.ValueName -> Registry.ValueDat
 engraveWithPrompt env name value = do
     putStrLn $ "Saving variable '" ++ name ++ "' to '" ++ registryKeyPath env ++ "'..."
     oldValue <- query env name
-    putStrLn $ "\tOld value: " ++ oldValue
-    putStrLn $ "\tNew value: " ++ value
+    if (isJust oldValue)
+        then do
+            putStrLn $ "\tOld value: " ++ fromJust oldValue
+            putStrLn $ "\tNew value: " ++ value
+        else do
+            putStrLn $ "\tValue: " ++ value
     agreed <- Utils.promptToContinue
     when agreed $ engrave env name value
 
diff --git a/src/Registry.hs b/src/Registry.hs
index 4aac81d..4a7c593 100644
--- a/src/Registry.hs
+++ b/src/Registry.hs
@@ -83,9 +83,6 @@ exitCodeSuccess = 0
 exitCodeFileNotFound :: WinAPI.ErrCode
 exitCodeFileNotFound = 0x2
 
-exitCodeMoreData :: WinAPI.ErrCode
-exitCodeMoreData = 0xea
-
 raiseError :: String -> WinAPI.ErrCode -> IO a
 raiseError functionName ret
     | ret == exitCodeFileNotFound = raiseDoesNotExistError functionName
@@ -121,11 +118,9 @@ getString keyHandle valueName =
     alloca $ \dataSizePtr -> do
         poke dataSizePtr 0
         ret <- WinAPI.c_RegQueryValueEx keyPtr valueNamePtr WinAPI.nullPtr WinAPI.nullPtr WinAPI.nullPtr dataSizePtr
-        if ret == exitCodeSuccess
-            then return ""
-            else if ret /= exitCodeMoreData
-                then raiseError "RegQueryValueEx" ret
-                else getStringTerminated keyPtr valueNamePtr dataSizePtr
+        if ret /= exitCodeSuccess
+            then raiseError "RegQueryValueEx" ret
+            else getStringTerminated keyPtr valueNamePtr dataSizePtr
   where
     getStringTerminated keyPtr valueNamePtr dataSizePtr = do
         dataSize <- peek dataSizePtr