{-# LANGUAGE RecordWildCards #-} module SeoCheck.OptParse ( module SeoCheck.OptParse, module SeoCheck.OptParse.Types, ) where import Control.Monad.Logger import Data.Maybe import Network.URI import Options.Applicative import SeoCheck.OptParse.Types import qualified System.Environment as System import Text.Read getSettings :: IO Settings getSettings :: IO Settings getSettings = do Flags flags <- IO Flags getFlags Flags -> IO Settings deriveSettings Flags flags deriveSettings :: Flags -> IO Settings deriveSettings :: Flags -> IO Settings deriveSettings Flags {Maybe Int Maybe Word Maybe LogLevel URI flagMaxDepth :: Flags -> Maybe Word flagFetchers :: Flags -> Maybe Int flagLogLevel :: Flags -> Maybe LogLevel flagUri :: Flags -> URI flagMaxDepth :: Maybe Word flagFetchers :: Maybe Int flagLogLevel :: Maybe LogLevel flagUri :: URI ..} = do let setUri :: URI setUri = URI flagUri setLogLevel :: LogLevel setLogLevel = LogLevel -> Maybe LogLevel -> LogLevel forall a. a -> Maybe a -> a fromMaybe LogLevel LevelWarn Maybe LogLevel flagLogLevel setFetchers :: Maybe Int setFetchers = Maybe Int flagFetchers setMaxDepth :: Maybe Word setMaxDepth = Maybe Word flagMaxDepth Settings -> IO Settings forall (f :: * -> *) a. Applicative f => a -> f a pure Settings :: URI -> LogLevel -> Maybe Int -> Maybe Word -> Settings Settings {Maybe Int Maybe Word URI LogLevel setMaxDepth :: Maybe Word setFetchers :: Maybe Int setLogLevel :: LogLevel setUri :: URI setMaxDepth :: Maybe Word setFetchers :: Maybe Int setLogLevel :: LogLevel setUri :: URI ..} getFlags :: IO Flags getFlags :: IO Flags getFlags = do [String] args <- IO [String] System.getArgs let result :: ParserResult Flags result = [String] -> ParserResult Flags runArgumentsParser [String] args ParserResult Flags -> IO Flags forall a. ParserResult a -> IO a handleParseResult ParserResult Flags result runArgumentsParser :: [String] -> ParserResult Flags runArgumentsParser :: [String] -> ParserResult Flags runArgumentsParser = ParserPrefs -> ParserInfo Flags -> [String] -> ParserResult Flags forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a execParserPure ParserPrefs prefs_ ParserInfo Flags flagsParser where prefs_ :: ParserPrefs prefs_ = ParserPrefs defaultPrefs { prefShowHelpOnError :: Bool prefShowHelpOnError = Bool True, prefShowHelpOnEmpty :: Bool prefShowHelpOnEmpty = Bool True } flagsParser :: ParserInfo Flags flagsParser :: ParserInfo Flags flagsParser = Parser Flags -> InfoMod Flags -> ParserInfo Flags forall a. Parser a -> InfoMod a -> ParserInfo a info (Parser (Flags -> Flags) forall a. Parser (a -> a) helper Parser (Flags -> Flags) -> Parser Flags -> Parser Flags forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Flags parseFlags) InfoMod Flags forall a. InfoMod a fullDesc parseFlags :: Parser Flags parseFlags :: Parser Flags parseFlags = URI -> Maybe LogLevel -> Maybe Int -> Maybe Word -> Flags Flags (URI -> Maybe LogLevel -> Maybe Int -> Maybe Word -> Flags) -> Parser URI -> Parser (Maybe LogLevel -> Maybe Int -> Maybe Word -> Flags) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ReadM URI -> Mod ArgumentFields URI -> Parser URI forall a. ReadM a -> Mod ArgumentFields a -> Parser a argument ((String -> Maybe URI) -> ReadM URI forall a. (String -> Maybe a) -> ReadM a maybeReader String -> Maybe URI parseAbsoluteURI) ( [Mod ArgumentFields URI] -> Mod ArgumentFields URI forall a. Monoid a => [a] -> a mconcat [ String -> Mod ArgumentFields URI forall (f :: * -> *) a. String -> Mod f a help String "The root uri. This must be an absolute URI. For example: https://example.com or http://localhost:8000", String -> Mod ArgumentFields URI forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar String "URI" ] ) Parser (Maybe LogLevel -> Maybe Int -> Maybe Word -> Flags) -> Parser (Maybe LogLevel) -> Parser (Maybe Int -> Maybe Word -> Flags) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> ReadM (Maybe LogLevel) -> Mod OptionFields (Maybe LogLevel) -> Parser (Maybe LogLevel) forall a. ReadM a -> Mod OptionFields a -> Parser a option (LogLevel -> Maybe LogLevel forall a. a -> Maybe a Just (LogLevel -> Maybe LogLevel) -> ReadM LogLevel -> ReadM (Maybe LogLevel) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (String -> Maybe LogLevel) -> ReadM LogLevel forall a. (String -> Maybe a) -> ReadM a maybeReader String -> Maybe LogLevel parseLogLevel) ( [Mod OptionFields (Maybe LogLevel)] -> Mod OptionFields (Maybe LogLevel) forall a. Monoid a => [a] -> a mconcat [ String -> Mod OptionFields (Maybe LogLevel) forall (f :: * -> *) a. HasName f => String -> Mod f a long String "log-level", String -> Mod OptionFields (Maybe LogLevel) forall (f :: * -> *) a. String -> Mod f a help (String -> Mod OptionFields (Maybe LogLevel)) -> String -> Mod OptionFields (Maybe LogLevel) forall a b. (a -> b) -> a -> b $ String "The log level, example values: " String -> String -> String forall a. Semigroup a => a -> a -> a <> [String] -> String forall a. Show a => a -> String show ((LogLevel -> String) -> [LogLevel] -> [String] forall a b. (a -> b) -> [a] -> [b] map (Int -> String -> String forall a. Int -> [a] -> [a] drop Int 5 (String -> String) -> (LogLevel -> String) -> LogLevel -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . LogLevel -> String forall a. Show a => a -> String show) [LogLevel LevelDebug, LogLevel LevelInfo, LogLevel LevelWarn, LogLevel LevelError]), String -> Mod OptionFields (Maybe LogLevel) forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar String "LOG_LEVEL", Maybe LogLevel -> Mod OptionFields (Maybe LogLevel) forall (f :: * -> *) a. HasValue f => a -> Mod f a value Maybe LogLevel forall a. Maybe a Nothing ] ) Parser (Maybe Int -> Maybe Word -> Flags) -> Parser (Maybe Int) -> Parser (Maybe Word -> Flags) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> ReadM (Maybe Int) -> Mod OptionFields (Maybe Int) -> Parser (Maybe Int) forall a. ReadM a -> Mod OptionFields a -> Parser a option (Int -> Maybe Int forall a. a -> Maybe a Just (Int -> Maybe Int) -> ReadM Int -> ReadM (Maybe Int) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ReadM Int forall a. Read a => ReadM a auto) ( [Mod OptionFields (Maybe Int)] -> Mod OptionFields (Maybe Int) forall a. Monoid a => [a] -> a mconcat [ String -> Mod OptionFields (Maybe Int) forall (f :: * -> *) a. HasName f => String -> Mod f a long String "fetchers", String -> Mod OptionFields (Maybe Int) forall (f :: * -> *) a. String -> Mod f a help String "The number of threads to fetch from. This application is usually not CPU bound so you can comfortably set this higher than the number of cores you have", String -> Mod OptionFields (Maybe Int) forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar String "INT", Maybe Int -> Mod OptionFields (Maybe Int) forall (f :: * -> *) a. HasValue f => a -> Mod f a value Maybe Int forall a. Maybe a Nothing ] ) Parser (Maybe Word -> Flags) -> Parser (Maybe Word) -> Parser Flags forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> ReadM (Maybe Word) -> Mod OptionFields (Maybe Word) -> Parser (Maybe Word) forall a. ReadM a -> Mod OptionFields a -> Parser a option (Word -> Maybe Word forall a. a -> Maybe a Just (Word -> Maybe Word) -> ReadM Word -> ReadM (Maybe Word) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ReadM Word forall a. Read a => ReadM a auto) ( [Mod OptionFields (Maybe Word)] -> Mod OptionFields (Maybe Word) forall a. Monoid a => [a] -> a mconcat [ String -> Mod OptionFields (Maybe Word) forall (f :: * -> *) a. HasName f => String -> Mod f a long String "max-depth", String -> Mod OptionFields (Maybe Word) forall (f :: * -> *) a. String -> Mod f a help String "The maximum length of the path from the root to a given URI", String -> Mod OptionFields (Maybe Word) forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar String "INT", Maybe Word -> Mod OptionFields (Maybe Word) forall (f :: * -> *) a. HasValue f => a -> Mod f a value Maybe Word forall a. Maybe a Nothing ] ) parseLogLevel :: String -> Maybe LogLevel parseLogLevel :: String -> Maybe LogLevel parseLogLevel String s = String -> Maybe LogLevel forall a. Read a => String -> Maybe a readMaybe (String -> Maybe LogLevel) -> String -> Maybe LogLevel forall a b. (a -> b) -> a -> b $ String "Level" String -> String -> String forall a. Semigroup a => a -> a -> a <> String s