aboutsummaryrefslogtreecommitdiffstatshomepage
diff options
context:
space:
mode:
Diffstat
-rw-r--r--apps/AddPath.hs97
-rw-r--r--apps/ListPath.hs67
-rw-r--r--apps/RemovePath.hs89
-rw-r--r--apps/SetEnv.hs80
-rw-r--r--apps/UnsetEnv.hs74
-rw-r--r--src/Utils.hs4
-rw-r--r--wintmp.cabal5
7 files changed, 142 insertions, 274 deletions
diff --git a/apps/AddPath.hs b/apps/AddPath.hs
index e3f8ec3..85f2aa4 100644
--- a/apps/AddPath.hs
+++ b/apps/AddPath.hs
@@ -6,74 +6,49 @@
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 Control.Monad (when)
-import qualified Environment
-
-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
+import Options.Applicative
-addPath :: [String] -> Options -> IO ()
-addPath paths options = do
- missingPaths <- dropIncludedPaths paths
- when (not $ null missingPaths) $ do
- oldPath <- Environment.queryFromRegistry (env options) (name options)
- Environment.saveToRegistryWithPrompt (env options) (name options) $ Environment.joinPaths $ missingPaths ++ [oldPath]
- where
- dropIncludedPaths paths = do
- currentPath <- Environment.getEnv $ name options
- return $ filter (flip notElem $ Environment.splitPaths currentPath) paths
+import qualified Environment
data Options = Options
{ name :: String
- , env :: Environment.RegistryBasedEnvironment
+ , global :: Bool
+ , paths :: [String]
} deriving (Eq, Show)
-defaultOptions :: Options
-defaultOptions = Options
- { name = "PATH"
- , env = Environment.CurrentUserEnvironment
- }
-
-buildHelpMessage :: IO String
-buildHelpMessage = do
- header <- buildHeader
- return $ usageInfo header optionDescription
+options :: Parser Options
+options = Options
+ <$> nameOption
+ <*> globalOption
+ <*> pathArgs
where
- buildHeader :: IO String
- buildHeader = do
- progName <- getProgName
- return $ "Usage: " ++ progName ++ " [OPTIONS...] [PATH...]\nOptions:"
+ 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 add for all users"
+ pathArgs = many $ argument str $
+ metavar "PATH" <>
+ help "Directory path(s)"
-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"]
+main :: IO ()
+main = execParser parser >>= addPath
+ where
+ parser = info (helper <*> options) $
+ fullDesc <> progDesc "Add directories to your PATH"
-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 = Environment.AllUsersEnvironment }) "add the path for all users"
- , Option "h" ["help"] (NoArg exitWithHelpMessage) "show this message and exit"
- ]
+addPath :: Options -> IO ()
+addPath options = do
+ missingPaths <- dropIncludedPaths $ paths options
+ when (not $ null missingPaths) $ do
+ oldPath <- Environment.queryFromRegistry env $ name options
+ Environment.saveToRegistryWithPrompt env (name options) $ Environment.joinPaths $ missingPaths ++ [oldPath]
+ where
+ dropIncludedPaths paths = do
+ currentPath <- Environment.getEnv $ name options
+ return $ filter (flip notElem $ Environment.splitPaths currentPath) paths
+ env | global options = Environment.AllUsersEnvironment
+ | otherwise = Environment.CurrentUserEnvironment
diff --git a/apps/ListPath.hs b/apps/ListPath.hs
index b964998..95d9c8b 100644
--- a/apps/ListPath.hs
+++ b/apps/ListPath.hs
@@ -6,24 +6,28 @@
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 Options.Applicative
import qualified Environment
+data Options = Options
+ { name :: String
+ } deriving (Eq, Show)
+
+options :: Parser Options
+options = Options <$> nameOption
+ where
+ nameOption = strOption $
+ long "name" <> short 'n' <> metavar "NAME" <> value "PATH" <>
+ help "Specify variable name ('PATH' by default)"
+
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
+main = execParser parser >>= listPath
+ where
+ parser = info (helper <*> options) $
+ fullDesc <> progDesc "List directories in your PATH"
listPath :: Options -> IO ()
listPath options = do
@@ -33,40 +37,3 @@ listPath options = do
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
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"
- ]
diff --git a/apps/SetEnv.hs b/apps/SetEnv.hs
index f27be4e..d3439ae 100644
--- a/apps/SetEnv.hs
+++ b/apps/SetEnv.hs
@@ -6,64 +6,40 @@
module Main (main) where
-import System.Console.GetOpt
-import System.Environment (getArgs, getProgName)
-import System.Exit (exitFailure, exitSuccess)
-import System.IO (hPutStr, stderr)
+import Options.Applicative hiding (value)
import qualified Environment
-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 = Environment.saveToRegistryWithPrompt (env options) name value
-
data Options = Options
- { env :: Environment.RegistryBasedEnvironment
+ { global :: Bool
+ , name :: String
+ , value :: String
} deriving (Eq, Show)
-defaultOptions :: Options
-defaultOptions = Options
- { env = Environment.CurrentUserEnvironment
- }
-
-buildHelpMessage :: IO String
-buildHelpMessage = do
- header <- buildHeader
- return $ usageInfo header optionDescription
+options :: Parser Options
+options = Options
+ <$> globalOption
+ <*> nameArg
+ <*> valueArg
where
- buildHeader = do
- progName <- getProgName
- return $ "Usage: " ++ progName ++ " [OPTIONS...] NAME VALUE\nOptions:"
-
-exitWithHelpMessage :: Options -> IO a
-exitWithHelpMessage _ = do
- helpMessage <- buildHelpMessage
- putStr helpMessage
- exitSuccess
+ globalOption = switch $
+ long "global" <> short 'g' <>
+ help "Whether to set for all users"
+ nameArg = argument str $
+ metavar "NAME" <>
+ help "Variable name"
+ valueArg = argument str $
+ metavar "VALUE" <>
+ help "Variable value"
-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"]
+main :: IO ()
+main = execParser parser >>= setEnv
+ where
+ parser = info (helper <*> options) $
+ fullDesc <> progDesc "Set environment variables"
-optionDescription :: [OptDescr (Options -> IO Options)]
-optionDescription =
- [ Option "g" ["global"] (NoArg $ \opts -> return opts { env = Environment.AllUsersEnvironment }) "save under the registry key for all users"
- , Option "h" ["help"] (NoArg exitWithHelpMessage) "show this message and exit"
- ]
+setEnv :: Options -> IO ()
+setEnv options = Environment.saveToRegistryWithPrompt env (name options) (value options)
+ where
+ env | global options = Environment.AllUsersEnvironment
+ | otherwise = Environment.CurrentUserEnvironment
diff --git a/apps/UnsetEnv.hs b/apps/UnsetEnv.hs
index 32626f3..bf7ad93 100644
--- a/apps/UnsetEnv.hs
+++ b/apps/UnsetEnv.hs
@@ -6,63 +6,35 @@
module Main (main) where
-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
-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 = Environment.wipeFromRegistryWithPrompt (env options) name
-
data Options = Options
- { env :: Environment.RegistryBasedEnvironment
+ { global :: Bool
+ , name :: String
} deriving (Eq, Show)
-defaultOptions :: Options
-defaultOptions = Options
- { env = Environment.CurrentUserEnvironment
- }
-
-buildHelpMessage :: IO String
-buildHelpMessage = do
- header <- buildHeader
- return $ usageInfo header optionDescription
+options :: Parser Options
+options = Options
+ <$> globalOption
+ <*> nameArg
where
- buildHeader = do
- progName <- getProgName
- return $ "Usage: " ++ progName ++ " [OPTIONS...] NAME\nOptions:"
-
-exitWithHelpMessage :: a -> IO b
-exitWithHelpMessage _ = do
- helpMessage <- buildHelpMessage
- putStr helpMessage
- exitSuccess
+ globalOption = switch $
+ long "global" <> short 'g' <>
+ help "Whether to unset for all users"
+ nameArg = argument str $
+ metavar "NAME" <>
+ help "Variable name"
-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"]
+main :: IO ()
+main = execParser parser >>= unsetEnv
+ where
+ parser = info (helper <*> options) $
+ fullDesc <> progDesc "Unset environment variables"
-optionDescription :: [OptDescr (Options -> IO Options)]
-optionDescription =
- [ Option "g" ["global"] (NoArg $ \opts -> return opts { env = Environment.AllUsersEnvironment }) "delete from the registry key for all users"
- , Option "h" ["help"] (NoArg exitWithHelpMessage) "show this message and exit"
- ]
+unsetEnv :: Options -> IO ()
+unsetEnv options = Environment.wipeFromRegistryWithPrompt env $ name options
+ where
+ env | global options = Environment.AllUsersEnvironment
+ | otherwise = Environment.CurrentUserEnvironment
diff --git a/src/Utils.hs b/src/Utils.hs
index ec15405..143696b 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -7,8 +7,8 @@
module Utils where
import Control.Monad (liftM)
-import Data.Char (toLower)
-import System.IO (hFlush, stdout)
+import Data.Char (toLower)
+import System.IO (hFlush, stdout)
prompt :: String -> IO String
prompt banner = do
diff --git a/wintmp.cabal b/wintmp.cabal
index 8e73e63..a8a8437 100644
--- a/wintmp.cabal
+++ b/wintmp.cabal
@@ -25,6 +25,7 @@ executable add_path
main-is: AddPath.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
+ , optparse-applicative
, wintmp
default-language: Haskell2010
@@ -41,6 +42,7 @@ executable list_path
main-is: ListPath.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base, directory
+ , optparse-applicative
, wintmp
default-language: Haskell2010
@@ -49,6 +51,7 @@ executable remove_path
main-is: RemovePath.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
+ , optparse-applicative
, wintmp
default-language: Haskell2010
@@ -57,6 +60,7 @@ executable set_env
main-is: SetEnv.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
+ , optparse-applicative
, wintmp
default-language: Haskell2010
@@ -65,6 +69,7 @@ executable unset_env
main-is: UnsetEnv.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
+ , optparse-applicative
, wintmp
default-language: Haskell2010
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 16:20:31 +0000