{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Stack.Options.LogLevelParser where

import qualified Data.Text                         as T
import           Options.Applicative
import           Stack.Options.Utils
import           Stack.Prelude

-- | Parser for a logging level.
logLevelOptsParser :: Bool -> Maybe LogLevel -> Parser (Maybe LogLevel)
logLevelOptsParser :: Bool -> Maybe LogLevel -> Parser (Maybe LogLevel)
logLevelOptsParser hide :: Bool
hide defLogLevel :: Maybe LogLevel
defLogLevel =
  ([Char] -> Maybe LogLevel)
-> Parser [Char] -> Parser (Maybe LogLevel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just (LogLevel -> Maybe LogLevel)
-> ([Char] -> LogLevel) -> [Char] -> Maybe LogLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> LogLevel
parse)
       (Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption ([Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long "verbosity" Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>
                   [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar "VERBOSITY" Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>
                   [[Char]] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasCompleter f => [[Char]] -> Mod f a
completeWith ["silent", "error", "warn", "info", "debug"] Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>
                   [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help "Verbosity: silent, error, warn, info, debug" Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>
                   Bool -> Mod OptionFields [Char]
forall (f :: * -> *) a. Bool -> Mod f a
hideMods Bool
hide)) Parser (Maybe LogLevel)
-> Parser (Maybe LogLevel) -> Parser (Maybe LogLevel)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Maybe LogLevel
-> Mod FlagFields (Maybe LogLevel) -> Parser (Maybe LogLevel)
forall a. a -> Mod FlagFields a -> Parser a
flag' (LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
verboseLevel)
       (Char -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'v' Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long "verbose" Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
forall a. Semigroup a => a -> a -> a
<>
        [Char] -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. [Char] -> Mod f a
help ("Enable verbose mode: verbosity level \"" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> LogLevel -> [Char]
showLevel LogLevel
verboseLevel [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> "\"") Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
forall a. Semigroup a => a -> a -> a
<>
        Bool -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. Bool -> Mod f a
hideMods Bool
hide) Parser (Maybe LogLevel)
-> Parser (Maybe LogLevel) -> Parser (Maybe LogLevel)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Maybe LogLevel
-> Mod FlagFields (Maybe LogLevel) -> Parser (Maybe LogLevel)
forall a. a -> Mod FlagFields a -> Parser a
flag' (LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
silentLevel)
       ([Char] -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long "silent" Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
forall a. Semigroup a => a -> a -> a
<>
        [Char] -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. [Char] -> Mod f a
help ("Enable silent mode: verbosity level \"" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> LogLevel -> [Char]
showLevel LogLevel
silentLevel [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> "\"") Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
forall a. Semigroup a => a -> a -> a
<>
        Bool -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. Bool -> Mod f a
hideMods Bool
hide) Parser (Maybe LogLevel)
-> Parser (Maybe LogLevel) -> Parser (Maybe LogLevel)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Maybe LogLevel -> Parser (Maybe LogLevel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LogLevel
defLogLevel
  where verboseLevel :: LogLevel
verboseLevel = LogLevel
LevelDebug
        silentLevel :: LogLevel
silentLevel = Text -> LogLevel
LevelOther "silent"
        showLevel :: LogLevel -> [Char]
showLevel l :: LogLevel
l =
          case LogLevel
l of
            LevelDebug -> "debug"
            LevelInfo -> "info"
            LevelWarn -> "warn"
            LevelError -> "error"
            LevelOther x :: Text
x -> Text -> [Char]
T.unpack Text
x
        parse :: [Char] -> LogLevel
parse s :: [Char]
s =
          case [Char]
s of
            "debug" -> LogLevel
LevelDebug
            "info" -> LogLevel
LevelInfo
            "warn" -> LogLevel
LevelWarn
            "error" -> LogLevel
LevelError
            _ -> Text -> LogLevel
LevelOther ([Char] -> Text
T.pack [Char]
s)