{-# LANGUAGE RecordWildCards #-} module LinkCheck.OptParse ( module LinkCheck.OptParse, module LinkCheck.OptParse.Types, ) where import Control.Monad.Logger import Data.Maybe import LinkCheck.OptParse.Types import Network.URI import Options.Applicative 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 Bool Maybe Int Maybe Word Maybe LogLevel URI flagCacheSize :: Flags -> Maybe Word flagMaxDepth :: Flags -> Maybe Word flagCheckFragments :: Flags -> Maybe Bool flagExternal :: Flags -> Maybe Bool flagFetchers :: Flags -> Maybe Int flagLogLevel :: Flags -> Maybe LogLevel flagUri :: Flags -> URI flagCacheSize :: Maybe Word flagMaxDepth :: Maybe Word flagCheckFragments :: Maybe Bool flagExternal :: Maybe Bool 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 LevelInfo Maybe LogLevel flagLogLevel setFetchers :: Maybe Int setFetchers = Maybe Int flagFetchers setExternal :: Bool setExternal = Bool -> Maybe Bool -> Bool forall a. a -> Maybe a -> a fromMaybe Bool False Maybe Bool flagExternal setCheckFragments :: Bool setCheckFragments = Bool -> Maybe Bool -> Bool forall a. a -> Maybe a -> a fromMaybe Bool False Maybe Bool flagCheckFragments setMaxDepth :: Maybe Word setMaxDepth = Maybe Word flagMaxDepth setCacheSize :: Maybe Word setCacheSize = Maybe Word flagCacheSize Settings -> IO Settings forall (f :: * -> *) a. Applicative f => a -> f a pure Settings :: URI -> LogLevel -> Maybe Int -> Bool -> Bool -> Maybe Word -> Maybe Word -> Settings Settings {Bool Maybe Int Maybe Word URI LogLevel setCacheSize :: Maybe Word setMaxDepth :: Maybe Word setCheckFragments :: Bool setExternal :: Bool setFetchers :: Maybe Int setLogLevel :: LogLevel setUri :: URI setCacheSize :: Maybe Word setMaxDepth :: Maybe Word setCheckFragments :: Bool setExternal :: Bool 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 Bool -> Maybe Bool -> Maybe Word -> Maybe Word -> Flags Flags (URI -> Maybe LogLevel -> Maybe Int -> Maybe Bool -> Maybe Bool -> Maybe Word -> Maybe Word -> Flags) -> Parser URI -> Parser (Maybe LogLevel -> Maybe Int -> Maybe Bool -> Maybe Bool -> Maybe Word -> 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 Bool -> Maybe Bool -> Maybe Word -> Maybe Word -> Flags) -> Parser (Maybe LogLevel) -> Parser (Maybe Int -> Maybe Bool -> Maybe Bool -> Maybe Word -> 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 Bool -> Maybe Bool -> Maybe Word -> Maybe Word -> Flags) -> Parser (Maybe Int) -> Parser (Maybe Bool -> Maybe Bool -> Maybe Word -> Maybe Word -> Flags) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Int -> Parser (Maybe Int) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional ( ReadM Int -> Mod OptionFields Int -> Parser Int forall a. ReadM a -> Mod OptionFields a -> Parser a option ReadM Int forall a. Read a => ReadM a auto ( [Mod OptionFields Int] -> Mod OptionFields Int forall a. Monoid a => [a] -> a mconcat [ String -> Mod OptionFields Int forall (f :: * -> *) a. HasName f => String -> Mod f a long String "fetchers", String -> Mod OptionFields 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 Int forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar String "INT" ] ) ) Parser (Maybe Bool -> Maybe Bool -> Maybe Word -> Maybe Word -> Flags) -> Parser (Maybe Bool) -> Parser (Maybe Bool -> Maybe Word -> Maybe Word -> Flags) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Bool -> Parser (Maybe Bool) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional ( Mod FlagFields Bool -> Parser Bool switch ( [Mod FlagFields Bool] -> Mod FlagFields Bool forall a. Monoid a => [a] -> a mconcat [ String -> Mod FlagFields Bool forall (f :: * -> *) a. HasName f => String -> Mod f a long String "external", String -> Mod FlagFields Bool forall (f :: * -> *) a. String -> Mod f a help String "Also check external links" ] ) ) Parser (Maybe Bool -> Maybe Word -> Maybe Word -> Flags) -> Parser (Maybe Bool) -> Parser (Maybe Word -> Maybe Word -> Flags) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Bool -> Parser (Maybe Bool) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional ( Mod FlagFields Bool -> Parser Bool switch ( [Mod FlagFields Bool] -> Mod FlagFields Bool forall a. Monoid a => [a] -> a mconcat [ String -> Mod FlagFields Bool forall (f :: * -> *) a. HasName f => String -> Mod f a long String "check-fragments", String -> Mod FlagFields Bool forall (f :: * -> *) a. String -> Mod f a help String "Also check that the URIs' fragment occurs on the page" ] ) ) Parser (Maybe Word -> Maybe Word -> Flags) -> Parser (Maybe Word) -> Parser (Maybe Word -> Flags) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Word -> Parser (Maybe Word) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional ( ReadM Word -> Mod OptionFields Word -> Parser Word forall a. ReadM a -> Mod OptionFields a -> Parser a option ReadM Word forall a. Read a => ReadM a auto ( [Mod OptionFields Word] -> Mod OptionFields Word forall a. Monoid a => [a] -> a mconcat [ String -> Mod OptionFields Word forall (f :: * -> *) a. HasName f => String -> Mod f a long String "max-depth", String -> Mod OptionFields Word forall (f :: * -> *) a. String -> Mod f a help String "Stop looking after reaching this number of links from the root" ] ) ) Parser (Maybe Word -> Flags) -> Parser (Maybe Word) -> Parser Flags forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Word -> Parser (Maybe Word) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional ( ReadM Word -> Mod OptionFields Word -> Parser Word forall a. ReadM a -> Mod OptionFields a -> Parser a option ReadM Word forall a. Read a => ReadM a auto ( [Mod OptionFields Word] -> Mod OptionFields Word forall a. Monoid a => [a] -> a mconcat [ String -> Mod OptionFields Word forall (f :: * -> *) a. HasName f => String -> Mod f a long String "cache-size", String -> Mod OptionFields Word forall (f :: * -> *) a. String -> Mod f a help String "Cache this many requests' fragments." ] ) ) 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