diff options
Diffstat (limited to 'apps/ListPath.hs')
-rw-r--r-- | apps/ListPath.hs | 67 |
1 files changed, 17 insertions, 50 deletions
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" - ] |