diff options
Diffstat (limited to '')
| -rw-r--r-- | apps/RemovePath.hs | 92 |
1 files changed, 47 insertions, 45 deletions
diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs index 3071708..2f73e21 100644 --- a/apps/RemovePath.hs +++ b/apps/RemovePath.hs @@ -4,77 +4,79 @@ - See LICENSE.txt for details. -} -module Main ( main ) where +module Main (main) where -import Control.Monad ( when ) +import Control.Monad (when) import System.Console.GetOpt -import System.Environment ( getArgs, getProgName ) -import System.Exit ( exitFailure, exitSuccess ) -import System.IO ( hPutStr, stderr ) +import System.Environment (getArgs, getProgName) +import System.Exit (exitFailure, exitSuccess) +import System.IO (hPutStr, stderr) import qualified Environment 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 + 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 <- Environment.queryFromRegistry Environment.CurrentUserEnvironment varName - let userValParts = Environment.splitPaths userVal - let newUserValParts = filter (`notElem` paths) userValParts - when (length userValParts /= length newUserValParts) $ do - Environment.saveToRegistryWithPrompt Environment.CurrentUserEnvironment varName $ Environment.joinPaths newUserValParts - when (global options) $ do - globalVal <- Environment.queryFromRegistry Environment.AllUsersEnvironment varName - let globalValParts = Environment.splitPaths globalVal - let newGlobalValParts = filter (`notElem` paths) globalValParts - when (length globalValParts /= length newGlobalValParts) $ do - Environment.saveToRegistryWithPrompt Environment.AllUsersEnvironment varName $ Environment.joinPaths newGlobalValParts + let varName = name options + userVal <- Environment.queryFromRegistry Environment.CurrentUserEnvironment varName + let userValParts = Environment.splitPaths userVal + let newUserValParts = filter (`notElem` paths) userValParts + when (length userValParts /= length newUserValParts) $ do + Environment.saveToRegistryWithPrompt Environment.CurrentUserEnvironment varName $ Environment.joinPaths newUserValParts + when (global options) $ do + globalVal <- Environment.queryFromRegistry Environment.AllUsersEnvironment varName + let globalValParts = Environment.splitPaths globalVal + let newGlobalValParts = filter (`notElem` paths) globalValParts + when (length globalValParts /= length newGlobalValParts) $ do + Environment.saveToRegistryWithPrompt Environment.AllUsersEnvironment varName $ Environment.joinPaths newGlobalValParts -data Options = Options { name :: String - , global :: Bool } - deriving (Eq, Show) +data Options = Options + { name :: String + , global :: Bool + } deriving (Eq, Show) defaultOptions :: Options -defaultOptions = Options { name = "PATH" - , global = False } +defaultOptions = Options + { name = "PATH" + , global = False + } buildHelpMessage :: IO String buildHelpMessage = do - header <- buildHeader - return $ usageInfo header optionDescription - where - buildHeader :: IO String - buildHeader = do + header <- buildHeader + return $ usageInfo header optionDescription + where + buildHeader = do progName <- getProgName return $ "Usage: " ++ progName ++ " [OPTIONS...] [PATH...]\nOptions:" exitWithHelpMessage :: a -> IO b exitWithHelpMessage _ = do - helpMessage <- buildHelpMessage - putStr helpMessage - exitSuccess + helpMessage <- buildHelpMessage + putStr helpMessage + exitSuccess exitWithUsageErrors :: [String] -> IO a exitWithUsageErrors errorMessages = do - hPutStr stderr $ concatMap ("Usage error: " ++) errorMessages - helpMessage <- buildHelpMessage - hPutStr stderr helpMessage - exitFailure + 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" - ] +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" + ] |