From 71e1194fcb39606336b0569147dd0f794b6bfa78 Mon Sep 17 00:00:00 2001 From: Egor Tensin Date: Wed, 6 May 2015 06:27:15 +0300 Subject: initial commit --- AddPath.hs | 74 +++++++++++++++++++++++++++++++++++++++++++++++ EnvUtils.hs | 81 ++++++++++++++++++++++++++++++++++++++++++++++++++++ FixNtSymbolPath.hs | 51 +++++++++++++++++++++++++++++++++ LICENSE.txt | 21 ++++++++++++++ ListPath.hs | 72 ++++++++++++++++++++++++++++++++++++++++++++++ README.md | 11 +++++++ RegUtils.hs | 78 ++++++++++++++++++++++++++++++++++++++++++++++++++ RemovePath.hs | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ SetEnv.hs | 66 ++++++++++++++++++++++++++++++++++++++++++ UnsetEnv.hs | 65 ++++++++++++++++++++++++++++++++++++++++++ Utils.hs | 32 +++++++++++++++++++++ pdbs/.gitignore | 1 + pdbs/README | 1 + symbols/.gitignore | 2 ++ symbols/README | 1 + vscache/.gitignore | 3 ++ vscache/README | 1 + 17 files changed, 644 insertions(+) create mode 100644 AddPath.hs create mode 100644 EnvUtils.hs create mode 100644 FixNtSymbolPath.hs create mode 100644 LICENSE.txt create mode 100644 ListPath.hs create mode 100644 README.md create mode 100644 RegUtils.hs create mode 100644 RemovePath.hs create mode 100644 SetEnv.hs create mode 100644 UnsetEnv.hs create mode 100644 Utils.hs create mode 100644 pdbs/.gitignore create mode 100644 pdbs/README create mode 100644 symbols/.gitignore create mode 100644 symbols/README create mode 100644 vscache/.gitignore create mode 100644 vscache/README 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 + - 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 + - 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 + - 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 + +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 + - 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 + - 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 + - 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 + - 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 + - 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 + - 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 -- cgit v1.2.3