refactoring

7 files changed, 81 insertions, 80 deletions

diff --git a/apps/AddPath.hs b/apps/AddPath.hs
index 85f2aa4..5203723 100644
--- a/apps/AddPath.hs
+++ b/apps/AddPath.hs
@@ -44,11 +44,11 @@ addPath :: Options -> IO ()
 addPath options = do
     missingPaths <- dropIncludedPaths $ paths options
     when (not $ null missingPaths) $ do
-        oldPath <- Environment.queryFromRegistry env $ name options
-        Environment.saveToRegistryWithPrompt env (name options) $ Environment.joinPaths $ missingPaths ++ [oldPath]
+        oldPath <- Environment.query env $ name options
+        Environment.engraveWithPrompt env (name options) $ Environment.pathJoin $ missingPaths ++ [oldPath]
   where
     dropIncludedPaths paths = do
-        currentPath <- Environment.getEnv $ name options
-        return $ filter (flip notElem $ Environment.splitPaths currentPath) paths
-    env | global options = Environment.AllUsersEnvironment
-        | otherwise      = Environment.CurrentUserEnvironment
+        currentPath <- Environment.query env $ name options
+        return $ filter (flip notElem $ Environment.pathSplit currentPath) paths
+    env | global options = Environment.AllUsers
+        | otherwise      = Environment.CurrentUser
diff --git a/apps/FixNtSymbolPath.hs b/apps/FixNtSymbolPath.hs
index c75291e..a44a840 100644
--- a/apps/FixNtSymbolPath.hs
+++ b/apps/FixNtSymbolPath.hs
@@ -6,9 +6,9 @@
 
 module Main (main) where
 
-import Control.Monad (unless)
+import Control.Monad    (unless)
 import System.Directory (createDirectoryIfMissing, getCurrentDirectory)
-import System.FilePath (combine)
+import System.FilePath  (combine)
 
 import qualified Environment
 
@@ -32,16 +32,16 @@ getPdbsDirectoryPath = do
 
 fixNtSymbolPath :: IO ()
 fixNtSymbolPath = do
-    let env = Environment.CurrentUserEnvironment
-    val <- Environment.queryFromRegistry env ntSymbolPath
-    let presentPaths = Environment.splitPaths val
+    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.joinPaths $ presentPaths ++ missingPaths
-        Environment.saveToRegistry env ntSymbolPath newval
+        let newval = Environment.pathJoin $ presentPaths ++ missingPaths
+        Environment.engrave env ntSymbolPath newval
   where
     ntSymbolPath = "_NT_SYMBOL_PATH"
 
diff --git a/apps/ListPath.hs b/apps/ListPath.hs
index 95d9c8b..63460b9 100644
--- a/apps/ListPath.hs
+++ b/apps/ListPath.hs
@@ -6,7 +6,10 @@
 
 module Main (main) where
 
-import System.Directory (doesDirectoryExist)
+import Control.Monad      (liftM)
+import Data.Maybe         (fromMaybe)
+import System.Directory   (doesDirectoryExist)
+import System.Environment (lookupEnv)
 
 import Options.Applicative
 
@@ -29,10 +32,13 @@ 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 <- Environment.getEnv $ name options
-    mapM_ printPath $ Environment.splitPaths val
+    val <- getEnv $ name options
+    mapM_ printPath $ Environment.pathSplit val
   where
     printPath p = do
         exists <- doesDirectoryExist p
diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs
index d85a7f4..e04a67b 100644
--- a/apps/RemovePath.hs
+++ b/apps/RemovePath.hs
@@ -42,14 +42,14 @@ main = execParser parser >>= removePath
 removePath :: Options -> IO ()
 removePath options = do
     let varName = name options
-    userVal <- Environment.queryFromRegistry Environment.CurrentUserEnvironment varName
-    let userValParts = Environment.splitPaths userVal
+    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.saveToRegistryWithPrompt Environment.CurrentUserEnvironment varName $ Environment.joinPaths newUserValParts
+        Environment.engraveWithPrompt Environment.CurrentUser varName $ Environment.pathJoin newUserValParts
     when (global options) $ do
-        globalVal <- Environment.queryFromRegistry Environment.AllUsersEnvironment varName
-        let globalValParts = Environment.splitPaths globalVal
+        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.saveToRegistryWithPrompt Environment.AllUsersEnvironment varName $ Environment.joinPaths newGlobalValParts
+            Environment.engraveWithPrompt Environment.AllUsers varName $ Environment.pathJoin newGlobalValParts
diff --git a/apps/SetEnv.hs b/apps/SetEnv.hs
index d3439ae..fad7526 100644
--- a/apps/SetEnv.hs
+++ b/apps/SetEnv.hs
@@ -39,7 +39,7 @@ main = execParser parser >>= setEnv
         fullDesc <> progDesc "Set environment variables"
 
 setEnv :: Options -> IO ()
-setEnv options = Environment.saveToRegistryWithPrompt env (name options) (value options)
+setEnv options = Environment.engraveWithPrompt env (name options) (value options)
   where
-    env | global options = Environment.AllUsersEnvironment
-        | otherwise      = Environment.CurrentUserEnvironment
+    env | global options = Environment.AllUsers
+        | otherwise      = Environment.CurrentUser
diff --git a/apps/UnsetEnv.hs b/apps/UnsetEnv.hs
index bf7ad93..6fa2f2c 100644
--- a/apps/UnsetEnv.hs
+++ b/apps/UnsetEnv.hs
@@ -34,7 +34,7 @@ main = execParser parser >>= unsetEnv
         fullDesc <> progDesc "Unset environment variables"
 
 unsetEnv :: Options -> IO ()
-unsetEnv options = Environment.wipeFromRegistryWithPrompt env $ name options
+unsetEnv options = Environment.wipeWithPrompt env $ name options
   where
-    env | global options = Environment.AllUsersEnvironment
-        | otherwise      = Environment.CurrentUserEnvironment
+    env | global options = Environment.AllUsers
+        | otherwise      = Environment.CurrentUser
diff --git a/src/Environment.hs b/src/Environment.hs
index 5a3978e..c0dd723 100644
--- a/src/Environment.hs
+++ b/src/Environment.hs
@@ -5,23 +5,21 @@
 -}
 
 module Environment
-    ( queryFromRegistry
-    , saveToRegistry
-    , saveToRegistryWithPrompt
-    , wipeFromRegistry
-    , wipeFromRegistryWithPrompt
-    , getEnv
-    , splitPaths
-    , joinPaths
-    , RegistryBasedEnvironment(..)
+    ( RegistryLocation(..)
+    , query
+    , engrave
+    , engraveWithPrompt
+    , wipe
+    , wipeWithPrompt
+
+    , pathJoin
+    , pathSplit
     ) where
 
-import           Control.Monad      (liftM, when)
-import           Data.List          (intercalate)
-import           Data.List.Split    (splitOn)
-import           Data.Maybe         (fromMaybe)
-import qualified System.Environment (lookupEnv)
-import           System.IO.Error    (catchIOError, isDoesNotExistError)
+import Control.Monad   (when)
+import Data.List       (intercalate)
+import Data.List.Split (splitOn)
+import System.IO.Error (catchIOError, isDoesNotExistError)
 
 import qualified Graphics.Win32.Window as WinAPI
 import qualified System.Win32.Types    as WinAPI
@@ -29,28 +27,28 @@ import qualified System.Win32.Types    as WinAPI
 import qualified Registry
 import qualified Utils (promptToContinue)
 
-data RegistryBasedEnvironment
-    = CurrentUserEnvironment
-    | AllUsersEnvironment
+data RegistryLocation
+    = CurrentUser
+    | AllUsers
     deriving (Eq, Show)
 
-subKeyPath :: RegistryBasedEnvironment -> Registry.KeyPath
-subKeyPath CurrentUserEnvironment =
+subKeyPath :: RegistryLocation -> Registry.KeyPath
+subKeyPath CurrentUser =
     Registry.keyPathFromString "Environment"
-subKeyPath AllUsersEnvironment =
+subKeyPath AllUsers =
     Registry.keyPathFromString "SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment"
 
-rootKey :: RegistryBasedEnvironment -> Registry.RootKey
-rootKey CurrentUserEnvironment = Registry.CurrentUser
-rootKey AllUsersEnvironment    = Registry.LocalMachine
+rootKey :: RegistryLocation -> Registry.RootKey
+rootKey CurrentUser = Registry.CurrentUser
+rootKey AllUsers    = Registry.LocalMachine
 
-openRootKey :: RegistryBasedEnvironment -> Registry.KeyHandle
+openRootKey :: RegistryLocation -> Registry.KeyHandle
 openRootKey = Registry.openRootKey . rootKey
 
-openRegistryKey :: RegistryBasedEnvironment -> IO Registry.KeyHandle
+openRegistryKey :: RegistryLocation -> IO Registry.KeyHandle
 openRegistryKey env = Registry.openSubKey (openRootKey env) (subKeyPath env)
 
-registryKeyPath :: RegistryBasedEnvironment -> Registry.KeyPath
+registryKeyPath :: RegistryLocation -> Registry.KeyPath
 registryKeyPath env = Registry.keyPathJoin [Registry.rootKeyPath $ rootKey env, subKeyPath env]
 
 notifyEnvUpdate :: IO ()
@@ -66,50 +64,47 @@ notifyEnvUpdate =
 
     allWindows = WinAPI.castUINTPtrToPtr 0xffff
 
-saveToRegistry :: RegistryBasedEnvironment -> Registry.ValueName -> Registry.ValueData -> IO ()
-saveToRegistry env name value = do
+query :: RegistryLocation -> Registry.ValueName -> IO Registry.ValueData
+query env name = do
+    keyHandle <- openRegistryKey env
+    catchIOError (Registry.getString keyHandle name) emptyIfDoesNotExist
+  where
+    emptyIfDoesNotExist e = if isDoesNotExistError e then return "" else ioError e
+
+engrave :: RegistryLocation -> Registry.ValueName -> Registry.ValueData -> IO ()
+engrave env name value = do
     keyHandle <- openRegistryKey env
     Registry.setString keyHandle name value
     notifyEnvUpdate
 
-saveToRegistryWithPrompt :: RegistryBasedEnvironment -> Registry.ValueName -> Registry.ValueData -> IO ()
-saveToRegistryWithPrompt env name value = do
+engraveWithPrompt :: RegistryLocation -> Registry.ValueName -> Registry.ValueData -> IO ()
+engraveWithPrompt env name value = do
     putStrLn $ "Saving variable '" ++ name ++ "' to '" ++ registryKeyPath env ++ "'..."
-    oldValue <- queryFromRegistry env name
+    oldValue <- query env name
     putStrLn $ "\tOld value: " ++ oldValue
     putStrLn $ "\tNew value: " ++ value
     agreed <- Utils.promptToContinue
-    when agreed $ saveToRegistry env name value
+    when agreed $ engrave env name value
 
-queryFromRegistry :: RegistryBasedEnvironment -> Registry.ValueName -> IO Registry.ValueData
-queryFromRegistry env name = do
-    keyHandle <- openRegistryKey env
-    catchIOError (Registry.getString keyHandle name) emptyIfDoesNotExist
-  where
-    emptyIfDoesNotExist e = if isDoesNotExistError e then return "" else ioError e
-
-wipeFromRegistry :: RegistryBasedEnvironment -> Registry.ValueName -> IO ()
-wipeFromRegistry env name = do
+wipe :: RegistryLocation -> Registry.ValueName -> IO ()
+wipe env name = do
     keyHandle <- openRegistryKey env
     catchIOError (Registry.delValue keyHandle name) ignoreIfDoesNotExist
     notifyEnvUpdate
   where
     ignoreIfDoesNotExist e = if isDoesNotExistError e then return () else ioError e
 
-wipeFromRegistryWithPrompt :: RegistryBasedEnvironment -> Registry.ValueName -> IO ()
-wipeFromRegistryWithPrompt env name = do
+wipeWithPrompt :: RegistryLocation -> Registry.ValueName -> IO ()
+wipeWithPrompt env name = do
     putStrLn $ "Deleting variable '" ++ name ++ "' from '" ++ registryKeyPath env ++ "'..."
     agreed <- Utils.promptToContinue
-    when agreed $ wipeFromRegistry env name
-
-getEnv :: String -> IO String
-getEnv = liftM (fromMaybe "") . System.Environment.lookupEnv
+    when agreed $ wipe env name
 
 pathSep :: String
 pathSep = ";"
 
-splitPaths :: String -> [String]
-splitPaths = filter (not . null) . splitOn pathSep
+pathSplit :: String -> [String]
+pathSplit = filter (not . null) . splitOn pathSep
 
-joinPaths :: [String] -> String
-joinPaths = intercalate pathSep . filter (not . null)
+pathJoin :: [String] -> String
+pathJoin = intercalate pathSep . filter (not . null)