diff options
author | Egor Tensin <Egor.Tensin@gmail.com> | 2015-05-06 06:27:15 +0300 |
---|---|---|
committer | Egor Tensin <Egor.Tensin@gmail.com> | 2015-05-06 06:27:15 +0300 |
commit | 71e1194fcb39606336b0569147dd0f794b6bfa78 (patch) | |
tree | 61154840f0bce9be819533ea4b298e83d1d55290 | |
download | windows-env-71e1194fcb39606336b0569147dd0f794b6bfa78.tar.gz windows-env-71e1194fcb39606336b0569147dd0f794b6bfa78.zip |
initial commit
-rw-r--r-- | AddPath.hs | 74 | ||||
-rw-r--r-- | EnvUtils.hs | 81 | ||||
-rw-r--r-- | FixNtSymbolPath.hs | 51 | ||||
-rw-r--r-- | LICENSE.txt | 21 | ||||
-rw-r--r-- | ListPath.hs | 72 | ||||
-rw-r--r-- | README.md | 11 | ||||
-rw-r--r-- | RegUtils.hs | 78 | ||||
-rw-r--r-- | RemovePath.hs | 84 | ||||
-rw-r--r-- | SetEnv.hs | 66 | ||||
-rw-r--r-- | UnsetEnv.hs | 65 | ||||
-rw-r--r-- | Utils.hs | 32 | ||||
-rw-r--r-- | pdbs/.gitignore | 1 | ||||
-rw-r--r-- | pdbs/README | 1 | ||||
-rw-r--r-- | symbols/.gitignore | 2 | ||||
-rw-r--r-- | symbols/README | 1 | ||||
-rw-r--r-- | vscache/.gitignore | 3 | ||||
-rw-r--r-- | vscache/README | 1 |
17 files changed, 644 insertions, 0 deletions
diff --git a/AddPath.hs b/AddPath.hs new file mode 100644 index 0000000..2fc73e8 --- /dev/null +++ b/AddPath.hs @@ -0,0 +1,74 @@ +{- + - Copyright 2015 Egor Tensin <Egor.Tensin@gmail.com> + - This file is licensed under the terms of the MIT License. + - See LICENSE.txt for details. +-} + +module Main ( main ) where + +import Control.Monad ( when ) +import System.Console.GetOpt +import System.Environment ( getArgs, getProgName ) +import System.Exit ( exitFailure, exitSuccess ) +import System.IO ( hPutStr, stderr ) + +import qualified EnvUtils + +main :: IO () +main = do + rawArgs <- getArgs + case getOpt Permute optionDescription rawArgs of + (actions, args, []) -> do + options <- foldl (>>=) (return defaultOptions) actions + case args of + [path] -> addPath path options + _ -> invalidNumberOfArguments + (_, _, errorMessages) -> exitWithUsageErrors errorMessages + +addPath :: String -> Options -> IO () +addPath path options = do + oldVal <- EnvUtils.getEnv $ name options + when (notElem path $ EnvUtils.splitPaths oldVal) $ do + oldValFromReg <- EnvUtils.queryFromRegistry (env options) (name options) + EnvUtils.saveToRegistryWithPrompt (env options) (name options) $ EnvUtils.joinPaths [path,oldValFromReg] + +data Options = Options { name :: String + , env :: EnvUtils.RegistryBasedEnvironment } + deriving (Eq, Show) + +defaultOptions :: Options +defaultOptions = Options { name = "PATH" + , env = EnvUtils.CurrentUserEnvironment } + +buildHelpMessage :: IO String +buildHelpMessage = do + header <- buildHeader + return $ usageInfo header optionDescription + where + buildHeader :: IO String + buildHeader = do + progName <- getProgName + return $ "Usage: " ++ progName ++ " [OPTIONS...] PATH\nOptions:" + +exitWithHelpMessage :: a -> IO b +exitWithHelpMessage _ = do + helpMessage <- buildHelpMessage + putStr helpMessage + exitSuccess + +exitWithUsageErrors :: [String] -> IO a +exitWithUsageErrors errorMessages = do + hPutStr stderr $ concatMap ("Usage error: " ++) errorMessages + helpMessage <- buildHelpMessage + hPutStr stderr helpMessage + exitFailure + +invalidNumberOfArguments :: IO a +invalidNumberOfArguments = exitWithUsageErrors ["invalid number of arguments\n"] + +optionDescription :: [OptDescr (Options -> IO Options)] +optionDescription = [ + Option "n" ["name"] (ReqArg (\s opts -> return opts { name = s }) "NAME") "set the variable name ('PATH' by default)", + Option "g" ["global"] (NoArg $ \opts -> return opts { env = EnvUtils.AllUsersEnvironment }) "add the path for all users", + Option "h" ["help"] (NoArg exitWithHelpMessage) "show this message and exit" + ] diff --git a/EnvUtils.hs b/EnvUtils.hs new file mode 100644 index 0000000..7e9bc96 --- /dev/null +++ b/EnvUtils.hs @@ -0,0 +1,81 @@ +{- + - Copyright 2015 Egor Tensin <Egor.Tensin@gmail.com> + - This file is licensed under the terms of the MIT License. + - See LICENSE.txt for details. +-} + +module EnvUtils ( saveToRegistry + , saveToRegistryWithPrompt + , queryFromRegistry + , wipeFromRegistry + , wipeFromRegistryWithPrompt + , getEnv + , splitPaths + , joinPaths + , RegistryBasedEnvironment ( CurrentUserEnvironment, AllUsersEnvironment ) ) 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 qualified RegUtils +import qualified Utils ( promptToContinue ) + +data RegistryBasedEnvironment = CurrentUserEnvironment + | AllUsersEnvironment + deriving (Eq, Show) + +registrySubKeyPath :: RegistryBasedEnvironment -> String +registrySubKeyPath CurrentUserEnvironment = "Environment" +registrySubKeyPath AllUsersEnvironment = "SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment" + +registryKey CurrentUserEnvironment = RegUtils.hkcu +registryKey AllUsersEnvironment = RegUtils.hklm + +registryKeyPath :: RegistryBasedEnvironment -> String +registryKeyPath CurrentUserEnvironment = "HKCU\\" ++ registrySubKeyPath CurrentUserEnvironment +registryKeyPath AllUsersEnvironment = "HKLM\\" ++ registrySubKeyPath AllUsersEnvironment + +saveToRegistry :: RegistryBasedEnvironment -> String -> String -> IO () +saveToRegistry env = RegUtils.setString (registryKey env) (registrySubKeyPath env) + +saveToRegistryWithPrompt :: RegistryBasedEnvironment -> String -> String -> IO () +saveToRegistryWithPrompt env name value = do + putStrLn $ "Saving variable '" ++ name ++ "' to '" ++ registryKeyPath env ++ "'..." + oldValue <- queryFromRegistry env name + putStrLn $ "\tOld value: " ++ oldValue + putStrLn $ "\tNew value: " ++ value + agreed <- Utils.promptToContinue + when agreed $ saveToRegistry env name value + +queryFromRegistry :: RegistryBasedEnvironment -> String -> IO String +queryFromRegistry env name = catchIOError (RegUtils.getString (registryKey env) (registrySubKeyPath env) name) emptyIfDoesNotExist + where + emptyIfDoesNotExist :: IOError -> IO String + emptyIfDoesNotExist e = if isDoesNotExistError e then return "" else ioError e + +wipeFromRegistry :: RegistryBasedEnvironment -> String -> IO () +wipeFromRegistry env name = catchIOError (RegUtils.delValue (registryKey env) (registrySubKeyPath env) name) ignoreIfDoesNotExist + where + ignoreIfDoesNotExist :: IOError -> IO () + ignoreIfDoesNotExist e = if isDoesNotExistError e then return () else ioError e + +wipeFromRegistryWithPrompt :: RegistryBasedEnvironment -> String -> IO () +wipeFromRegistryWithPrompt 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 + +pathSep = ";" + +splitPaths :: String -> [String] +splitPaths = filter (not . null) . splitOn pathSep + +joinPaths :: [String] -> String +joinPaths = intercalate pathSep . filter (not . null) diff --git a/FixNtSymbolPath.hs b/FixNtSymbolPath.hs new file mode 100644 index 0000000..404dc77 --- /dev/null +++ b/FixNtSymbolPath.hs @@ -0,0 +1,51 @@ +{- + - Copyright 2015 Egor Tensin <Egor.Tensin@gmail.com> + - This file is licensed under the terms of the MIT License. + - See LICENSE.txt for details. +-} + +module Main ( main ) where + +import Control.Monad ( unless ) +import System.Directory ( createDirectoryIfMissing, getCurrentDirectory ) +import System.FilePath ( combine ) + +import qualified EnvUtils + +getRemoteSymbolsDirectoryPath :: IO String +getRemoteSymbolsDirectoryPath = do + localPath <- getLocalPath + createDirectoryIfMissing True localPath + return $ "SRV*" ++ localPath ++ "*" ++ remotePath + where + getLocalPath :: IO String + getLocalPath = do + cwd <- getCurrentDirectory + return $ combine cwd "symbols" + remotePath :: String + remotePath = "http://msdl.microsoft.com/download/symbols" + +getPdbsDirectoryPath :: IO String +getPdbsDirectoryPath = do + cwd <- getCurrentDirectory + let path = combine cwd "pdbs" + createDirectoryIfMissing True path + return path + +fixNtSymbolPath :: IO () +fixNtSymbolPath = do + let env = EnvUtils.CurrentUserEnvironment + val <- EnvUtils.queryFromRegistry env ntSymbolPath + let presentPaths = EnvUtils.splitPaths val + remoteSymbolsPath <- getRemoteSymbolsDirectoryPath + pdbsPath <- getPdbsDirectoryPath + let requiredPaths = [pdbsPath, remoteSymbolsPath] + let missingPaths = filter (`notElem` presentPaths) requiredPaths + unless (null missingPaths) $ do + let newval = EnvUtils.joinPaths $ presentPaths ++ missingPaths + EnvUtils.saveToRegistry env ntSymbolPath newval + where + ntSymbolPath = "_NT_SYMBOL_PATH" + +main :: IO () +main = fixNtSymbolPath diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 index 0000000..fbbdd68 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2015 Egor Tensin <Egor.Tensin@gmail.com> + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/ListPath.hs b/ListPath.hs new file mode 100644 index 0000000..6c1fcfa --- /dev/null +++ b/ListPath.hs @@ -0,0 +1,72 @@ +{- + - Copyright 2015 Egor Tensin <Egor.Tensin@gmail.com> + - This file is licensed under the terms of the MIT License. + - See LICENSE.txt for details. +-} + +module Main ( main ) where + +import System.Console.GetOpt +import System.Directory ( doesDirectoryExist ) +import System.Environment ( getArgs, getProgName ) +import System.Exit ( exitFailure, exitSuccess ) +import System.IO ( hPutStr, stderr ) + +import qualified EnvUtils + +main :: IO () +main = do + rawArgs <- getArgs + case getOpt Permute optionDescription rawArgs of + (actions, args, []) -> do + options <- foldl (>>=) (return defaultOptions) actions + case args of + [] -> listPath options + _ -> invalidNumberOfArguments + (_, _, errorMessages) -> exitWithUsageErrors errorMessages + +listPath :: Options -> IO () +listPath options = do + val <- EnvUtils.getEnv $ name options + mapM_ printPath $ EnvUtils.splitPaths val + where + printPath p = do + exists <- doesDirectoryExist p + putStrLn $ (if exists then "+" else "-") ++ " " ++ p + +data Options = Options { name :: String } deriving (Eq, Show) + +defaultOptions :: Options +defaultOptions = Options { name = "PATH" } + +buildHelpMessage :: IO String +buildHelpMessage = do + header <- buildHeader + return $ usageInfo header optionDescription + where + buildHeader :: IO String + buildHeader = do + progName <- getProgName + return $ "Usage: " ++ progName ++ " [OPTIONS...]\nOptions:" + +exitWithHelpMessage :: a -> IO b +exitWithHelpMessage _ = do + helpMessage <- buildHelpMessage + putStr helpMessage + exitSuccess + +exitWithUsageErrors :: [String] -> IO a +exitWithUsageErrors errorMessages = do + hPutStr stderr $ concatMap ("Usage error: " ++) errorMessages + helpMessage <- buildHelpMessage + hPutStr stderr helpMessage + exitFailure + +invalidNumberOfArguments :: IO a +invalidNumberOfArguments = exitWithUsageErrors ["invalid number of arguments\n"] + +optionDescription :: [OptDescr (Options -> IO Options)] +optionDescription = [ + Option "n" ["name"] (ReqArg (\s opts -> return opts { name = s }) "NAME") "set the variable name ('PATH' by default)", + Option "h" ["help"] (NoArg exitWithHelpMessage) "show this message and exit" + ] diff --git a/README.md b/README.md new file mode 100644 index 0000000..3d0f841 --- /dev/null +++ b/README.md @@ -0,0 +1,11 @@ +# wintmp + +A collection of scripts to manage my environmental variables, created mainly to: + +* learn a bit of Haskell, +* make it easier to add paths to the PATH variable, automatically setup _NT_SYMBOL_PATH, etc. + +## Licensing + +This project, including all of the files and their contents, is licensed under the terms of the MIT License. +See LICENSE.txt for details. diff --git a/RegUtils.hs b/RegUtils.hs new file mode 100644 index 0000000..677e4f8 --- /dev/null +++ b/RegUtils.hs @@ -0,0 +1,78 @@ +{- + - Copyright 2015 Egor Tensin <Egor.Tensin@gmail.com> + - This file is licensed under the terms of the MIT License. + - See LICENSE.txt for details. +-} + +module RegUtils ( delValue + , getString + , hkcu + , hklm + , setString ) where + +import Control.Exception ( bracket ) +import Data.Maybe ( fromMaybe ) +import Foreign.C.String ( peekCWString, withCWString ) +import Foreign.ForeignPtr ( withForeignPtr ) +import Foreign.Marshal.Alloc ( alloca, allocaBytes ) +import Foreign.Ptr ( castPtr, plusPtr ) +import Foreign.Storable ( peek, poke, sizeOf ) +import System.IO.Error ( mkIOError, doesNotExistErrorType ) +import System.Win32.Types +import System.Win32.Registry + +getType :: HKEY -> String -> String -> IO (Maybe RegValueType) +getType key subKeyPath valueName = + bracket (regOpenKey key subKeyPath) regCloseKey $ \key -> + withForeignPtr key $ \keyPtr -> + withCWString valueName $ \valueNamePtr -> + alloca $ \typePtr -> do + ret <- c_RegQueryValueEx keyPtr valueNamePtr nullPtr typePtr nullPtr nullPtr + case ret of + 0x0 -> do + type' <- peek typePtr + return $ Just type' + 0x2 -> return Nothing + _ -> failWith "RegQueryValueEx" ret + +getString :: HKEY -> String -> String -> IO String +getString key subKeyPath valueName = + bracket (regOpenKey key subKeyPath) regCloseKey $ \key -> + withForeignPtr key $ \keyPtr -> + withCWString valueName $ \valueNamePtr -> + alloca $ \dataSizePtr -> do + poke dataSizePtr 0 + ret <- c_RegQueryValueEx keyPtr valueNamePtr nullPtr nullPtr nullPtr dataSizePtr + case ret of + 0x0 -> do + dataSize <- peek dataSizePtr + let newDataSize = dataSize + fromIntegral (sizeOf (undefined :: TCHAR)) + poke dataSizePtr newDataSize + allocaBytes (fromIntegral newDataSize) $ \dataPtr -> do + poke (castPtr $ plusPtr dataPtr $ fromIntegral dataSize) '\0' + failUnlessSuccess "RegQueryValueEx" $ + c_RegQueryValueEx keyPtr valueNamePtr nullPtr nullPtr dataPtr dataSizePtr + peekCWString $ castPtr dataPtr + 0x2 -> ioError $ mkIOError doesNotExistErrorType "RegQueryValueEx" Nothing $ Just (subKeyPath ++ "\\" ++ valueName) + _ -> failWith "RegQueryValueEx" ret + +setString :: HKEY -> String -> String -> String -> IO () +setString key subKeyPath valueName valueValue = + bracket (regOpenKey key subKeyPath) regCloseKey $ \subKey -> + withTStringLen valueValue $ \(ptr, len) -> do + type' <- getType key subKeyPath valueName + regSetValueEx subKey valueName (fromMaybe rEG_SZ type') ptr $ len * sizeOf (undefined :: TCHAR) + +delValue :: HKEY -> String -> String -> IO () +delValue key subKeyPath valueName = + bracket (regOpenKey key subKeyPath) regCloseKey $ \subKey -> + withForeignPtr subKey $ \subKeyPtr -> + withCWString valueName $ \valueNamePtr -> do + ret <- c_RegDeleteValue subKeyPtr valueNamePtr + case ret of + 0x0 -> return () + 0x2 -> ioError $ mkIOError doesNotExistErrorType "RegQueryValueEx" Nothing $ Just (subKeyPath ++ "\\" ++ valueName) + _ -> failWith "RegDeleteValue" ret + +hkcu = hKEY_CURRENT_USER +hklm = hKEY_LOCAL_MACHINE diff --git a/RemovePath.hs b/RemovePath.hs new file mode 100644 index 0000000..50c4ca2 --- /dev/null +++ b/RemovePath.hs @@ -0,0 +1,84 @@ +{- + - Copyright 2015 Egor Tensin <Egor.Tensin@gmail.com> + - This file is licensed under the terms of the MIT License. + - See LICENSE.txt for details. +-} + +module Main ( main ) where + +import Control.Monad ( when ) +import System.Console.GetOpt +import System.Environment ( getArgs, getProgName ) +import System.Exit ( exitFailure, exitSuccess ) +import System.IO ( hPutStr, stderr ) + +import qualified EnvUtils + +main :: IO () +main = do + rawArgs <- getArgs + case getOpt Permute optionDescription rawArgs of + (actions, args, []) -> do + options <- foldl (>>=) (return defaultOptions) actions + case args of + [path] -> removePath path options + _ -> invalidNumberOfArguments + (_, _, errorMessages) -> exitWithUsageErrors errorMessages + +removePath :: String -> Options -> IO () +removePath path options = do + let varName = name options + userVal <- EnvUtils.queryFromRegistry EnvUtils.CurrentUserEnvironment varName + let userValParts = EnvUtils.splitPaths userVal + if path `elem` userValParts + then do + let newUserValParts = filter (/= path) userValParts + EnvUtils.saveToRegistryWithPrompt EnvUtils.CurrentUserEnvironment varName $ EnvUtils.joinPaths newUserValParts + else do + when (global options) $ do + globalVal <- EnvUtils.queryFromRegistry EnvUtils.AllUsersEnvironment varName + let globalValParts = EnvUtils.splitPaths globalVal + when (path `elem` globalValParts) $ do + let newGlobalValParts = filter (/= path) globalValParts + EnvUtils.saveToRegistryWithPrompt EnvUtils.AllUsersEnvironment varName $ EnvUtils.joinPaths newGlobalValParts + +data Options = Options { name :: String + , global :: Bool } + deriving (Eq, Show) + +defaultOptions :: Options +defaultOptions = Options { name = "PATH" + , global = False } + +buildHelpMessage :: IO String +buildHelpMessage = do + header <- buildHeader + return $ usageInfo header optionDescription + where + buildHeader :: IO String + buildHeader = do + progName <- getProgName + return $ "Usage: " ++ progName ++ " [OPTIONS...] PATH\nOptions:" + +exitWithHelpMessage :: a -> IO b +exitWithHelpMessage _ = do + helpMessage <- buildHelpMessage + putStr helpMessage + exitSuccess + +exitWithUsageErrors :: [String] -> IO a +exitWithUsageErrors errorMessages = do + hPutStr stderr $ concatMap ("Usage error: " ++) errorMessages + helpMessage <- buildHelpMessage + hPutStr stderr helpMessage + exitFailure + +invalidNumberOfArguments :: IO a +invalidNumberOfArguments = exitWithUsageErrors ["invalid number of arguments\n"] + +optionDescription :: [OptDescr (Options -> IO Options)] +optionDescription = [ + Option "n" ["name"] (ReqArg (\s opts -> return opts { name = s }) "NAME") "set the variable name ('PATH' by default)", + Option "g" ["global"] (NoArg $ \opts -> return opts { global = True }) "remove the path for all users", + Option "h" ["help"] (NoArg exitWithHelpMessage) "show this message and exit" + ] diff --git a/SetEnv.hs b/SetEnv.hs new file mode 100644 index 0000000..30f5b1e --- /dev/null +++ b/SetEnv.hs @@ -0,0 +1,66 @@ +{- + - Copyright 2015 Egor Tensin <Egor.Tensin@gmail.com> + - This file is licensed under the terms of the MIT License. + - See LICENSE.txt for details. +-} + +module Main ( main ) where + +import System.Console.GetOpt +import System.Environment ( getArgs, getProgName ) +import System.Exit ( exitFailure, exitSuccess ) +import System.IO ( hPutStr, stderr ) + +import qualified EnvUtils + +main :: IO () +main = do + rawArgs <- getArgs + case getOpt Permute optionDescription rawArgs of + (actions, args, []) -> do + options <- foldl (>>=) (return defaultOptions) actions + case args of + [name, value] -> setEnv name value options + _ -> invalidNumberOfArguments + (_, _, errorMessages) -> + exitWithUsageErrors errorMessages + +setEnv :: String -> String -> Options -> IO () +setEnv name value options = EnvUtils.saveToRegistryWithPrompt (env options) name value + +data Options = Options { env :: EnvUtils.RegistryBasedEnvironment } deriving (Eq, Show) + +defaultOptions :: Options +defaultOptions = Options { env = EnvUtils.CurrentUserEnvironment } + +buildHelpMessage :: IO String +buildHelpMessage = do + header <- buildHeader + return $ usageInfo header optionDescription + where + buildHeader :: IO String + buildHeader = do + progName <- getProgName + return $ "Usage: " ++ progName ++ " [OPTIONS...] NAME VALUE\nOptions:" + +exitWithHelpMessage :: Options -> IO a +exitWithHelpMessage _ = do + helpMessage <- buildHelpMessage + putStr helpMessage + exitSuccess + +exitWithUsageErrors :: [String] -> IO a +exitWithUsageErrors errorMessages = do + hPutStr stderr $ concatMap ("Usage error: " ++) errorMessages + helpMessage <- buildHelpMessage + hPutStr stderr helpMessage + exitFailure + +invalidNumberOfArguments :: IO a +invalidNumberOfArguments = exitWithUsageErrors ["invalid number of arguments\n"] + +optionDescription :: [OptDescr (Options -> IO Options)] +optionDescription = [ + Option "g" ["global"] (NoArg $ \opts -> return opts { env = EnvUtils.AllUsersEnvironment }) "save under the registry key for all users", + Option "h" ["help"] (NoArg exitWithHelpMessage) "show this message and exit" + ] diff --git a/UnsetEnv.hs b/UnsetEnv.hs new file mode 100644 index 0000000..9740c0d --- /dev/null +++ b/UnsetEnv.hs @@ -0,0 +1,65 @@ +{- + - Copyright 2015 Egor Tensin <Egor.Tensin@gmail.com> + - This file is licensed under the terms of the MIT License. + - See LICENSE.txt for details. +-} + +module Main ( main ) where + +import System.Console.GetOpt +import System.Environment ( getArgs, getProgName ) +import System.Exit ( exitFailure, exitSuccess ) +import System.IO ( hPutStr, stderr ) + +import qualified EnvUtils + +main :: IO () +main = do + rawArgs <- getArgs + case getOpt Permute optionDescription rawArgs of + (actions, args, []) -> do + options <- foldl (>>=) (return defaultOptions) actions + case args of + [name] -> unsetEnv name options + _ -> invalidNumberOfArguments + (_, _, errorMessages) -> exitWithUsageErrors errorMessages + +unsetEnv :: String -> Options -> IO () +unsetEnv name options = EnvUtils.wipeFromRegistryWithPrompt (env options) name + +data Options = Options { env :: EnvUtils.RegistryBasedEnvironment } deriving (Eq, Show) + +defaultOptions :: Options +defaultOptions = Options { env = EnvUtils.CurrentUserEnvironment } + +buildHelpMessage :: IO String +buildHelpMessage = do + header <- buildHeader + return $ usageInfo header optionDescription + where + buildHeader :: IO String + buildHeader = do + progName <- getProgName + return $ "Usage: " ++ progName ++ " [OPTIONS...] NAME\nOptions:" + +exitWithHelpMessage :: a -> IO b +exitWithHelpMessage _ = do + helpMessage <- buildHelpMessage + putStr helpMessage + exitSuccess + +exitWithUsageErrors :: [String] -> IO a +exitWithUsageErrors errorMessages = do + hPutStr stderr $ concatMap ("Usage error: " ++) errorMessages + helpMessage <- buildHelpMessage + hPutStr stderr helpMessage + exitFailure + +invalidNumberOfArguments :: IO a +invalidNumberOfArguments = exitWithUsageErrors ["invalid number of arguments\n"] + +optionDescription :: [OptDescr (Options -> IO Options)] +optionDescription = [ + Option "g" ["global"] (NoArg $ \opts -> return opts { env = EnvUtils.AllUsersEnvironment }) "delete from the registry key for all users", + Option "h" ["help"] (NoArg exitWithHelpMessage) "show this message and exit" + ] diff --git a/Utils.hs b/Utils.hs new file mode 100644 index 0000000..21ee67b --- /dev/null +++ b/Utils.hs @@ -0,0 +1,32 @@ +{- + - Copyright 2015 Egor Tensin <Egor.Tensin@gmail.com> + - This file is licensed under the terms of the MIT License. + - See LICENSE.txt for details. +-} + +module Utils where + +import Control.Monad ( liftM ) +import Data.Char ( toLower ) +import System.IO ( hFlush, stdout ) + +prompt :: String -> IO String +prompt banner = do + putStr banner + hFlush stdout + getLine + +promptYesNo :: String -> IO Bool +promptYesNo banner = do + response <- liftM (map toLower) $ prompt banner + if response `elem` yeses + then return True + else if response `elem` noes + then return False + else promptToContinue + where + yeses = ["y", "yes"] + noes = ["n", "no"] + +promptToContinue :: IO Bool +promptToContinue = promptYesNo "Continue? (y/n) " diff --git a/pdbs/.gitignore b/pdbs/.gitignore new file mode 100644 index 0000000..eadd157 --- /dev/null +++ b/pdbs/.gitignore @@ -0,0 +1 @@ +*.pdb diff --git a/pdbs/README b/pdbs/README new file mode 100644 index 0000000..43a9584 --- /dev/null +++ b/pdbs/README @@ -0,0 +1 @@ +I store my .pdb files in this directory diff --git a/symbols/.gitignore b/symbols/.gitignore new file mode 100644 index 0000000..f8eecb8 --- /dev/null +++ b/symbols/.gitignore @@ -0,0 +1,2 @@ +*.pdb/ +pingme.txt diff --git a/symbols/README b/symbols/README new file mode 100644 index 0000000..25ad431 --- /dev/null +++ b/symbols/README @@ -0,0 +1 @@ +Downloaded Windows symbols are stored in this directory diff --git a/vscache/.gitignore b/vscache/.gitignore new file mode 100644 index 0000000..514e47a --- /dev/null +++ b/vscache/.gitignore @@ -0,0 +1,3 @@ +* +!.gitignore +!README diff --git a/vscache/README b/vscache/README new file mode 100644 index 0000000..703fb3d --- /dev/null +++ b/vscache/README @@ -0,0 +1 @@ +This directory is used as the fallback location for Visual Studio cache files |