aboutsummaryrefslogtreecommitdiffstatshomepage
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--apps/AddPath.hs12
-rw-r--r--apps/FixNtSymbolPath.hs55
-rw-r--r--apps/RemovePath.hs8
-rw-r--r--apps/SetEnv.hs8
-rw-r--r--apps/UnsetEnv.hs8
-rw-r--r--src/Environment.hs14
6 files changed, 60 insertions, 45 deletions
diff --git a/apps/AddPath.hs b/apps/AddPath.hs
index 40fa785..a3004a8 100644
--- a/apps/AddPath.hs
+++ b/apps/AddPath.hs
@@ -49,12 +49,12 @@ main = execParser parser >>= addPath
addPath :: Options -> IO ()
addPath options = do
- oldValue <- Environment.query env varName
+ oldValue <- query
let oldPaths = Environment.pathSplit $ fromMaybe "" oldValue
let newPaths = union oldPaths pathsToAdd
when (length oldPaths /= length newPaths) $ do
let newValue = Environment.pathJoin newPaths
- engrave env varName newValue
+ engrave newValue
where
varName = optName options
pathsToAdd = optPaths options
@@ -63,7 +63,9 @@ addPath options = do
env | forAllUsers = Environment.AllUsers
| otherwise = Environment.CurrentUser
+ query = Environment.query env varName
+
skipPrompt = optYes options
- engrave
- | skipPrompt = Environment.engrave
- | otherwise = Environment.engraveWithPrompt
+ engrave value = if skipPrompt
+ then Environment.engrave env varName value
+ else Environment.engravePrompt env varName value >> return ()
diff --git a/apps/FixNtSymbolPath.hs b/apps/FixNtSymbolPath.hs
index 636e93b..14d3ea6 100644
--- a/apps/FixNtSymbolPath.hs
+++ b/apps/FixNtSymbolPath.hs
@@ -33,45 +33,56 @@ options = Options
long "global" <> short 'g' <>
help "Set up for all users"
-getRemoteSymbolsDirectoryPath :: IO String
-getRemoteSymbolsDirectoryPath = do
- localPath <- getLocalPath
- createDirectoryIfMissing True localPath
- return $ "SRV*" ++ localPath ++ "*" ++ remotePath
+data Dirs = Dirs
+ { pdbsDir :: String
+ , symbolsDir :: String
+ } deriving (Eq, Show)
+
+getRemoteDirs :: Dirs -> Dirs
+getRemoteDirs localDirs = localDirs
+ { symbolsDir = remoteSymbolsDir $ symbolsDir localDirs
+ }
where
- getLocalPath = do
- cwd <- getCurrentDirectory
- return $ combine cwd "symbols"
- remotePath = "http://msdl.microsoft.com/download/symbols"
+ remoteSymbolsDir localDir = "SRV*" ++ localDir ++ "*" ++ remoteSymbolsUrl
+ remoteSymbolsUrl = "http://msdl.microsoft.com/download/symbols"
-getPdbsDirectoryPath :: IO String
-getPdbsDirectoryPath = do
+getLocalDirs :: IO Dirs
+getLocalDirs = do
cwd <- getCurrentDirectory
- let path = combine cwd "pdbs"
- createDirectoryIfMissing True path
- return path
+ return Dirs
+ { pdbsDir = combine cwd "pdbs"
+ , symbolsDir = combine cwd "symbols"
+ }
fixNtSymbolPath :: Options -> IO ()
fixNtSymbolPath options = do
- oldValue <- Environment.query env varName
+ oldValue <- query
let oldPaths = Environment.pathSplit $ fromMaybe "" oldValue
- pathsToAdd <- addPaths
- let newPaths = union oldPaths pathsToAdd
+ localDirs <- getLocalDirs
+ let remoteDirs = getRemoteDirs localDirs
+ let newPaths = union oldPaths $ paths remoteDirs
when (length oldPaths /= length newPaths) $ do
let newValue = Environment.pathJoin newPaths
- engrave env varName newValue
+ confirmed <- engrave newValue
+ when confirmed $
+ createLocalDirs localDirs
where
varName = "_NT_SYMBOL_PATH"
- addPaths = sequence [getRemoteSymbolsDirectoryPath, getPdbsDirectoryPath]
forAllUsers = optGlobal options
env | forAllUsers = Environment.AllUsers
| otherwise = Environment.CurrentUser
+ query = Environment.query env varName
+
skipPrompt = optYes options
- engrave
- | skipPrompt = Environment.engrave
- | otherwise = Environment.engraveWithPrompt
+ engrave value = if skipPrompt
+ then Environment.engrave env varName value >> return True
+ else Environment.engravePrompt env varName value
+
+ paths dirs = [pdbsDir dirs, symbolsDir dirs]
+
+ createLocalDirs = mapM_ (createDirectoryIfMissing True) . paths
main :: IO ()
main = execParser parser >>= fixNtSymbolPath
diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs
index 8c2bcef..21b4ac6 100644
--- a/apps/RemovePath.hs
+++ b/apps/RemovePath.hs
@@ -64,9 +64,9 @@ removePath options = do
let newPaths = oldPaths \\ pathsToRemove
when (length oldPaths /= length newPaths) $ do
let newValue = Environment.pathJoin newPaths
- engrave env varName newValue
+ engrave env newValue
skipPrompt = optYes options
- engrave
- | skipPrompt = Environment.engrave
- | otherwise = Environment.engraveWithPrompt
+ engrave env value = if skipPrompt
+ then Environment.engrave env varName value
+ else Environment.engravePrompt env varName value >> return ()
diff --git a/apps/SetEnv.hs b/apps/SetEnv.hs
index 18e369f..54a3cde 100644
--- a/apps/SetEnv.hs
+++ b/apps/SetEnv.hs
@@ -44,7 +44,7 @@ main = execParser parser >>= setEnv
fullDesc <> progDesc "Set environment variable"
setEnv :: Options -> IO ()
-setEnv options = engrave env varName varValue
+setEnv options = engrave varValue
where
varName = optName options
varValue = optValue options
@@ -54,6 +54,6 @@ setEnv options = engrave env varName varValue
| otherwise = Environment.CurrentUser
skipPrompt = optYes options
- engrave
- | skipPrompt = Environment.engrave
- | otherwise = Environment.engraveWithPrompt
+ engrave value = if skipPrompt
+ then Environment.engrave env varName value
+ else Environment.engravePrompt env varName value >> return ()
diff --git a/apps/UnsetEnv.hs b/apps/UnsetEnv.hs
index 14111d2..6f47473 100644
--- a/apps/UnsetEnv.hs
+++ b/apps/UnsetEnv.hs
@@ -39,7 +39,7 @@ main = execParser parser >>= unsetEnv
fullDesc <> progDesc "Unset environment variable"
unsetEnv :: Options -> IO ()
-unsetEnv options = wipe env varName
+unsetEnv options = wipe
where
varName = optName options
@@ -48,6 +48,6 @@ unsetEnv options = wipe env varName
| otherwise = Environment.CurrentUser
skipPrompt = optYes options
- wipe
- | skipPrompt = Environment.wipe
- | otherwise = Environment.wipeWithPrompt
+ wipe = if skipPrompt
+ then Environment.wipe env varName
+ else Environment.wipePrompt env varName >> return ()
diff --git a/src/Environment.hs b/src/Environment.hs
index 9582009..68a3917 100644
--- a/src/Environment.hs
+++ b/src/Environment.hs
@@ -8,9 +8,9 @@ module Environment
( RegistryLocation(..)
, query
, engrave
- , engraveWithPrompt
+ , engravePrompt
, wipe
- , wipeWithPrompt
+ , wipePrompt
, pathJoin
, pathSplit
@@ -81,8 +81,8 @@ engrave env name value = do
Registry.setString keyHandle name value
notifyEnvUpdate
-engraveWithPrompt :: RegistryLocation -> Registry.ValueName -> Registry.ValueData -> IO ()
-engraveWithPrompt env name value = do
+engravePrompt :: RegistryLocation -> Registry.ValueName -> Registry.ValueData -> IO Bool
+engravePrompt env name value = do
putStrLn $ "Saving variable '" ++ name ++ "' to '" ++ registryKeyPath env ++ "'..."
oldValue <- query env name
if (isJust oldValue)
@@ -93,6 +93,7 @@ engraveWithPrompt env name value = do
putStrLn $ "\tValue: " ++ value
agreed <- Utils.promptToContinue
when agreed $ engrave env name value
+ return agreed
wipe :: RegistryLocation -> Registry.ValueName -> IO ()
wipe env name = do
@@ -102,11 +103,12 @@ wipe env name = do
where
ignoreIfDoesNotExist e = if isDoesNotExistError e then return () else ioError e
-wipeWithPrompt :: RegistryLocation -> Registry.ValueName -> IO ()
-wipeWithPrompt env name = do
+wipePrompt :: RegistryLocation -> Registry.ValueName -> IO Bool
+wipePrompt env name = do
putStrLn $ "Deleting variable '" ++ name ++ "' from '" ++ registryKeyPath env ++ "'..."
agreed <- Utils.promptToContinue
when agreed $ wipe env name
+ return agreed
pathSep :: String
pathSep = ";"
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 02:49:05 +0000