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

module Stack.Options.LogLevelParser
  ( logLevelOptsParser
  ) where

import qualified Data.Text as T
import           Options.Applicative
                   ( Parser, completeWith, flag', help, long, metavar, short
                   , strOption
                   )
import           Stack.Options.Utils ( hideMods )
import           Stack.Prelude

-- | Parser for a logging level.

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