optparse-applicative instead of GetOpt

1 files changed, 23 insertions, 51 deletions

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