From d854f16486913af7fb70e4ff251a29d5cf2d7323 Mon Sep 17 00:00:00 2001 From: Egor Tensin Date: Sun, 17 Jul 2016 18:24:12 +0300 Subject: refactoring --- apps/AddPath.hs | 12 ++++++----- apps/FixNtSymbolPath.hs | 55 +++++++++++++++++++++++++++++-------------------- apps/RemovePath.hs | 8 +++---- apps/SetEnv.hs | 8 +++---- apps/UnsetEnv.hs | 8 +++---- src/Environment.hs | 14 +++++++------ 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 = ";" -- cgit v1.2.3