aboutsummaryrefslogtreecommitdiffstatshomepage
diff options
context:
space:
mode:
Diffstat
-rw-r--r--apps/AddPath.hs12
-rw-r--r--apps/FixNtSymbolPath.hs14
-rw-r--r--apps/ListPath.hs12
-rw-r--r--apps/RemovePath.hs12
-rw-r--r--apps/SetEnv.hs6
-rw-r--r--apps/UnsetEnv.hs6
-rw-r--r--src/Environment.hs99
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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-18 17:18:38 +0000