{- - Copyright (C) 2022 Nikola Hadžić - - This file is part of weatherhs. - - weatherhs is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - weatherhs is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with weatherhs. If not, see . -} module ArgParser where import Data.List (intercalate) import Text.Read (readMaybe) import Text.Printf (printf) import Text.Regex.PCRE ((=~)) import System.Environment (getProgName) import qualified System.Console.GetOpt as GetOpt import GetText -- Command-line options flags. data Flag = Help | Version | NoPP | Mode String | AirQuality | Alerts | Days String | Date String | Format String | Unsafe | GetFile deriving (Show, Eq) -- Command-line options definitions. options :: [GetOpt.OptDescr Flag] options = [ GetOpt.Option ['h'] ["help"] (GetOpt.NoArg Help) (__ "Display this help menu and exit."), GetOpt.Option ['v'] ["version"] (GetOpt.NoArg Version) (__ "Display program version and exit."), GetOpt.Option [] ["no-pp"] (GetOpt.NoArg NoPP) (__ "Do not pretty-print data."), GetOpt.Option ['m'] ["mode"] (GetOpt.ReqArg Mode (__ "MODE")) (__ "Information type mode. Can be \"timezone\", \"current\" (default), \"forecast\" or \"astronomy\"."), GetOpt.Option ['a'] ["air-quality"] (GetOpt.NoArg AirQuality) (__ "Also get air quaility data. Only meaningful if the information type mode is \"current\" or \"forecast\"."), GetOpt.Option ['w'] ["alerts"] (GetOpt.NoArg Alerts) (__ "Also get weather alerts data. Only meaningful if the information type mode is \"forecast\"."), GetOpt.Option ['d'] ["days"] (GetOpt.ReqArg Days (__ "INTEGER≥1")) (__ "Number of days to retrieve data for. Only meaningful if the information type mode is \"forecast\". The default is 3."), GetOpt.Option ['t'] ["date"] (GetOpt.ReqArg Date (__ "yyyy-MM-dd")) (__ "Date to retrieve the data for. Only meaningful if the information type mode is \"astronomy\". The default is current date."), GetOpt.Option [] ["format"] (GetOpt.ReqArg Format (__ "FORMAT")) (__ "Format to request data in from the server. Either \"json\" (default) or \"xml\"."), GetOpt.Option [] ["unsafe"] (GetOpt.NoArg Unsafe) (__ "Use HTTP instead of HTTPS for communication with the server."), GetOpt.Option [] ["get-file"] (GetOpt.NoArg GetFile) (__ "Just print the retrieved data file.") ] -- Help menu string. helpMenu :: IO String helpMenu = do progName <- getProgName return ((GetOpt.usageInfo (printf (__ "Usage: %s [OPTION…]\n\nOptions:") progName) options) ++ "\n" ++ __ "See weatherhs(1) for more information.") -- Tests the validity of the given command-line options values. testFlags :: [Flag] -> [String] testFlags flags = foldr (\flag invs -> case flag of Mode str -> if str == "timezone" || str == "current" || str == "forecast" || str == "astronomy" then invs else "-m/--mode" : invs Days str -> case (readMaybe str :: Maybe Int) of Nothing -> "-d/--days" : invs Just int -> if (int <= 0) then "-d/--days" : invs else invs Date str -> if str =~ "^\\d{4,}-\\d{1,2}-\\d{1,2}$" then invs else "-t/--date" : invs Format str -> if str == "json" || str == "xml" then invs else "--format" : invs _ -> invs) [] flags -- Parses the given command-line arguments. -- Returns the parsed command-line arguments as flags. -- Exits the program on invalid input. parseArgs :: [String] -> IO [Flag] parseArgs argv = case GetOpt.getOpt' GetOpt.RequireOrder options argv of (flags, [], [], []) -> case testFlags flags of [] -> return flags invs -> fail (printf (__ "Invalid option values for: %s") (intercalate ", " invs)) (_, nonoptions, unknowns, []) -> fail (printf (__ "Unrecognized options: %s") (intercalate ", " (nonoptions ++ unknowns))) (_, _, _, errs) -> fail (printf (__ "Errors: %s") (intercalate "; " errs))