aboutsummaryrefslogtreecommitdiffstatshomepage
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--apps/AddPath.hs39
-rw-r--r--apps/FixNtSymbolPath.hs25
-rw-r--r--apps/ListPath.hs16
-rw-r--r--apps/RemovePath.hs47
-rw-r--r--apps/SetEnv.hs26
-rw-r--r--apps/UnsetEnv.hs19
-rw-r--r--src/Environment.hs15
-rw-r--r--src/Registry.hs11
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 08:48:49 +0000