diff options
Diffstat (limited to 'apps')
-rw-r--r-- | apps/AddPath.hs | 76 | ||||
-rw-r--r-- | apps/FixNtSymbolPath.hs | 51 | ||||
-rw-r--r-- | apps/ListPath.hs | 72 | ||||
-rw-r--r-- | apps/RemovePath.hs | 80 | ||||
-rw-r--r-- | apps/SetEnv.hs | 66 | ||||
-rw-r--r-- | apps/UnsetEnv.hs | 65 |
6 files changed, 410 insertions, 0 deletions
diff --git a/apps/AddPath.hs b/apps/AddPath.hs new file mode 100644 index 0000000..e17adc9 --- /dev/null +++ b/apps/AddPath.hs @@ -0,0 +1,76 @@ +{- + - 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 ( mapM_, 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 + addPath args options + (_, _, errorMessages) -> exitWithUsageErrors errorMessages + +addPath :: [String] -> Options -> IO () +addPath paths options = do + missingPaths <- dropIncludedPaths paths + when (not $ null missingPaths) $ do + oldPath <- EnvUtils.queryFromRegistry (env options) (name options) + EnvUtils.saveToRegistryWithPrompt (env options) (name options) $ EnvUtils.joinPaths $ missingPaths ++ [oldPath] + where + dropIncludedPaths paths = do + currentPath <- EnvUtils.getEnv $ name options + return $ filter (flip notElem $ EnvUtils.splitPaths currentPath) paths + +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/apps/FixNtSymbolPath.hs b/apps/FixNtSymbolPath.hs new file mode 100644 index 0000000..404dc77 --- /dev/null +++ b/apps/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/apps/ListPath.hs b/apps/ListPath.hs new file mode 100644 index 0000000..ca72e87 --- /dev/null +++ b/apps/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/apps/RemovePath.hs b/apps/RemovePath.hs new file mode 100644 index 0000000..2e8fd01 --- /dev/null +++ b/apps/RemovePath.hs @@ -0,0 +1,80 @@ +{- + - 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 + removePath args options + (_, _, errorMessages) -> exitWithUsageErrors errorMessages + +removePath :: [String] -> Options -> IO () +removePath paths options = do + let varName = name options + userVal <- EnvUtils.queryFromRegistry EnvUtils.CurrentUserEnvironment varName + let userValParts = EnvUtils.splitPaths userVal + let newUserValParts = filter (`notElem` paths) userValParts + when (length userValParts /= length newUserValParts) $ do + EnvUtils.saveToRegistryWithPrompt EnvUtils.CurrentUserEnvironment varName $ EnvUtils.joinPaths newUserValParts + when (global options) $ do + globalVal <- EnvUtils.queryFromRegistry EnvUtils.AllUsersEnvironment varName + let globalValParts = EnvUtils.splitPaths globalVal + let newGlobalValParts = filter (`notElem` paths) globalValParts + when (length globalValParts /= length newGlobalValParts) $ do + 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/apps/SetEnv.hs b/apps/SetEnv.hs new file mode 100644 index 0000000..30f5b1e --- /dev/null +++ b/apps/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/apps/UnsetEnv.hs b/apps/UnsetEnv.hs new file mode 100644 index 0000000..cd43696 --- /dev/null +++ b/apps/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" + ] |