{-# 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