aboutsummaryrefslogtreecommitdiffstatshomepage
path: root/apps/RemovePath.hs
diff options
context:
space:
mode:
Diffstat (limited to 'apps/RemovePath.hs')
-rw-r--r--apps/RemovePath.hs89
1 files changed, 31 insertions, 58 deletions
diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs
index 2f73e21..d85a7f4 100644
--- a/apps/RemovePath.hs
+++ b/apps/RemovePath.hs
@@ -7,76 +7,49 @@
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 Options.Applicative
import qualified Environment
+data Options = Options
+ { name :: String
+ , global :: Bool
+ , paths :: [String]
+ } deriving (Eq, Show)
+
+options = Options
+ <$> nameOption
+ <*> globalOption
+ <*> pathArgs
+ where
+ nameOption = strOption $
+ long "name" <> short 'n' <> metavar "NAME" <> value "PATH" <>
+ help "Specify variable name ('PATH' by default)"
+ globalOption = switch $
+ long "global" <> short 'g' <>
+ help "Whether to remove for all users"
+ pathArgs = many $ argument str $
+ metavar "PATH" <>
+ help "Directory path(s)"
+
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
+main = execParser parser >>= removePath
+ where
+ parser = info (helper <*> options) $
+ fullDesc <> progDesc "Remove directories from your PATH"
-removePath :: [String] -> Options -> IO ()
-removePath paths options = do
+removePath :: Options -> IO ()
+removePath options = do
let varName = name options
userVal <- Environment.queryFromRegistry Environment.CurrentUserEnvironment varName
let userValParts = Environment.splitPaths userVal
- let newUserValParts = filter (`notElem` paths) userValParts
+ let newUserValParts = filter (flip notElem $ paths options) 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
+ let newGlobalValParts = filter (flip notElem $ paths options) 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)
-
-defaultOptions :: Options
-defaultOptions = Options
- { name = "PATH"
- , global = False
- }
-
-buildHelpMessage :: IO String
-buildHelpMessage = 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
-
-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"
- ]