module Hadolint.Config.Commandline
  ( CommandlineConfig (..),
    parseCommandline
  )
where

import Control.Applicative
import Data.Bifunctor (second)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.String (IsString (fromString))
import Data.Text (Text, pack, unpack, breakOn, drop)
import Hadolint.Formatter.Format (readMaybeOutputFormat)
import Hadolint.Config.Configuration
import Hadolint.Rule
  ( LabelName,
    LabelType,
    readEitherLabelType,
    readEitherSeverity
  )
import Options.Applicative
  ( Parser,
    ReadM,
    action,
    argument,
    completeWith,
    eitherReader,
    flag',
    help,
    long,
    maybeReader,
    metavar,
    option,
    short,
    str,
    strOption,
    switch,
  )


data CommandlineConfig =
  CommandlineConfig
    { CommandlineConfig -> Bool
showVersion :: Bool,
      CommandlineConfig -> Maybe FilePath
configFile :: Maybe FilePath,
      CommandlineConfig -> [FilePath]
dockerfiles :: [String],
      CommandlineConfig -> Maybe FilePath
filePathInReportOption :: Maybe FilePath,
      CommandlineConfig -> PartialConfiguration
configuration :: PartialConfiguration
    }
  deriving (CommandlineConfig -> CommandlineConfig -> Bool
(CommandlineConfig -> CommandlineConfig -> Bool)
-> (CommandlineConfig -> CommandlineConfig -> Bool)
-> Eq CommandlineConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandlineConfig -> CommandlineConfig -> Bool
$c/= :: CommandlineConfig -> CommandlineConfig -> Bool
== :: CommandlineConfig -> CommandlineConfig -> Bool
$c== :: CommandlineConfig -> CommandlineConfig -> Bool
Eq, Int -> CommandlineConfig -> ShowS
[CommandlineConfig] -> ShowS
CommandlineConfig -> FilePath
(Int -> CommandlineConfig -> ShowS)
-> (CommandlineConfig -> FilePath)
-> ([CommandlineConfig] -> ShowS)
-> Show CommandlineConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CommandlineConfig] -> ShowS
$cshowList :: [CommandlineConfig] -> ShowS
show :: CommandlineConfig -> FilePath
$cshow :: CommandlineConfig -> FilePath
showsPrec :: Int -> CommandlineConfig -> ShowS
$cshowsPrec :: Int -> CommandlineConfig -> ShowS
Show)

parseCommandline :: Parser CommandlineConfig
parseCommandline :: Parser CommandlineConfig
parseCommandline =
  Bool
-> Maybe FilePath
-> [FilePath]
-> Maybe FilePath
-> PartialConfiguration
-> CommandlineConfig
CommandlineConfig
    (Bool
 -> Maybe FilePath
 -> [FilePath]
 -> Maybe FilePath
 -> PartialConfiguration
 -> CommandlineConfig)
-> Parser Bool
-> Parser
     (Maybe FilePath
      -> [FilePath]
      -> Maybe FilePath
      -> PartialConfiguration
      -> CommandlineConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
parseVersion
    Parser
  (Maybe FilePath
   -> [FilePath]
   -> Maybe FilePath
   -> PartialConfiguration
   -> CommandlineConfig)
-> Parser (Maybe FilePath)
-> Parser
     ([FilePath]
      -> Maybe FilePath -> PartialConfiguration -> CommandlineConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
parseConfigFile
    Parser
  ([FilePath]
   -> Maybe FilePath -> PartialConfiguration -> CommandlineConfig)
-> Parser [FilePath]
-> Parser
     (Maybe FilePath -> PartialConfiguration -> CommandlineConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [FilePath]
parseFiles
    Parser
  (Maybe FilePath -> PartialConfiguration -> CommandlineConfig)
-> Parser (Maybe FilePath)
-> Parser (PartialConfiguration -> CommandlineConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
parseFilePathInReportOption
    Parser (PartialConfiguration -> CommandlineConfig)
-> Parser PartialConfiguration -> Parser CommandlineConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PartialConfiguration
parseConfiguration
  where
    parseVersion :: Parser Bool
parseVersion = Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"version" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show version")

    parseConfigFile :: Parser (Maybe FilePath)
parseConfigFile =
      Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"config" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILENAME"
                Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to the configuration file"
            )
        )

    parseFiles :: Parser [FilePath]
parseFiles = Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ReadM FilePath -> Mod ArgumentFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM FilePath
forall s. IsString s => ReadM s
str (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DOCKERFILE..." Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"file"))

    parseFilePathInReportOption :: Parser (Maybe FilePath)
parseFilePathInReportOption =
      Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"file-path-in-report"
                Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILEPATHINREPORT"
                Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The file path referenced in the generated report.\
                        \ This only applies for the 'checkstyle' format and is\
                        \ useful when running Hadolint with Docker to set the\
                        \ correct file path."
            )
        )

    parseConfiguration :: Parser PartialConfiguration
parseConfiguration =
      Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe OutputFormat
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> Set Registry
-> LabelSchema
-> Maybe Bool
-> Maybe Bool
-> Maybe DLSeverity
-> PartialConfiguration
PartialConfiguration
        (Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe OutputFormat
 -> [RuleCode]
 -> [RuleCode]
 -> [RuleCode]
 -> [RuleCode]
 -> [RuleCode]
 -> Set Registry
 -> LabelSchema
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe DLSeverity
 -> PartialConfiguration)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe OutputFormat
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> Set Registry
      -> LabelSchema
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DLSeverity
      -> PartialConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Bool)
parseNoFail
        Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe OutputFormat
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> Set Registry
   -> LabelSchema
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DLSeverity
   -> PartialConfiguration)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe OutputFormat
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> Set Registry
      -> LabelSchema
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DLSeverity
      -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Bool)
parseNoColor
        Parser
  (Maybe Bool
   -> Maybe OutputFormat
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> Set Registry
   -> LabelSchema
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DLSeverity
   -> PartialConfiguration)
-> Parser (Maybe Bool)
-> Parser
     (Maybe OutputFormat
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> Set Registry
      -> LabelSchema
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DLSeverity
      -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Bool)
parseVerbose
        Parser
  (Maybe OutputFormat
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> Set Registry
   -> LabelSchema
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DLSeverity
   -> PartialConfiguration)
-> Parser (Maybe OutputFormat)
-> Parser
     ([RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> Set Registry
      -> LabelSchema
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DLSeverity
      -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFormat)
parseOutputFormat
        Parser
  ([RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> Set Registry
   -> LabelSchema
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DLSeverity
   -> PartialConfiguration)
-> Parser [RuleCode]
-> Parser
     ([RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> Set Registry
      -> LabelSchema
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DLSeverity
      -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RuleCode]
parseErrorList
        Parser
  ([RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> Set Registry
   -> LabelSchema
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DLSeverity
   -> PartialConfiguration)
-> Parser [RuleCode]
-> Parser
     ([RuleCode]
      -> [RuleCode]
      -> [RuleCode]
      -> Set Registry
      -> LabelSchema
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DLSeverity
      -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RuleCode]
parseWarningList
        Parser
  ([RuleCode]
   -> [RuleCode]
   -> [RuleCode]
   -> Set Registry
   -> LabelSchema
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DLSeverity
   -> PartialConfiguration)
-> Parser [RuleCode]
-> Parser
     ([RuleCode]
      -> [RuleCode]
      -> Set Registry
      -> LabelSchema
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DLSeverity
      -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RuleCode]
parseInfoList
        Parser
  ([RuleCode]
   -> [RuleCode]
   -> Set Registry
   -> LabelSchema
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DLSeverity
   -> PartialConfiguration)
-> Parser [RuleCode]
-> Parser
     ([RuleCode]
      -> Set Registry
      -> LabelSchema
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DLSeverity
      -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RuleCode]
parseStyleList
        Parser
  ([RuleCode]
   -> Set Registry
   -> LabelSchema
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DLSeverity
   -> PartialConfiguration)
-> Parser [RuleCode]
-> Parser
     (Set Registry
      -> LabelSchema
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DLSeverity
      -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RuleCode]
parseIgnoreList
        Parser
  (Set Registry
   -> LabelSchema
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DLSeverity
   -> PartialConfiguration)
-> Parser (Set Registry)
-> Parser
     (LabelSchema
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DLSeverity
      -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Set Registry)
parseAllowedRegistries
        Parser
  (LabelSchema
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DLSeverity
   -> PartialConfiguration)
-> Parser LabelSchema
-> Parser
     (Maybe Bool
      -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LabelSchema
parseLabelSchema
        Parser
  (Maybe Bool
   -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe DLSeverity -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Bool)
parseStrictlabels
        Parser (Maybe Bool -> Maybe DLSeverity -> PartialConfiguration)
-> Parser (Maybe Bool)
-> Parser (Maybe DLSeverity -> PartialConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Bool)
parseDisableIgnorePragma
        Parser (Maybe DLSeverity -> PartialConfiguration)
-> Parser (Maybe DLSeverity) -> Parser PartialConfiguration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DLSeverity)
parseFailureThreshold

    -- All optional flags with boolean value must not have a default value. The
    -- optional parser then converts it to Nothing.
    -- This is to ensure if they are not set, this is correctly mirrored in the
    -- parsed Configuration and then their behaviour with respect to
    -- configurations from environment variables or config files is correct.
    parseNoFail :: Parser (Maybe Bool)
parseNoFail =
      Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
            ( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-fail"
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't exit with a failure status code when any rule is\
                        \ violated"
            )
        )

    parseNoColor :: Parser (Maybe Bool)
parseNoColor =
      Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
            ( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-color"
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't colorize output"
            )
        )

    parseVerbose :: Parser (Maybe Bool)
parseVerbose =
      Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
            ( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"verbose"
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'V'
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Enables verbose logging of hadolint's output to stderr"
            )
        )

    parseOutputFormat :: Parser (Maybe OutputFormat)
parseOutputFormat =
      Parser OutputFormat -> Parser (Maybe OutputFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser OutputFormat -> Parser (Maybe OutputFormat))
-> Parser OutputFormat -> Parser (Maybe OutputFormat)
forall a b. (a -> b) -> a -> b
$
        ReadM OutputFormat
-> Mod OptionFields OutputFormat -> Parser OutputFormat
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ( (FilePath -> Maybe OutputFormat) -> ReadM OutputFormat
forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader (Text -> Maybe OutputFormat
readMaybeOutputFormat (Text -> Maybe OutputFormat)
-> (FilePath -> Text) -> FilePath -> Maybe OutputFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack) )
          ( FilePath -> Mod OptionFields OutputFormat
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"format"
              Mod OptionFields OutputFormat
-> Mod OptionFields OutputFormat -> Mod OptionFields OutputFormat
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields OutputFormat
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' -- options for the output format
              Mod OptionFields OutputFormat
-> Mod OptionFields OutputFormat -> Mod OptionFields OutputFormat
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields OutputFormat
forall (f :: * -> *) a. FilePath -> Mod f a
help
                FilePath
"The output format for the results [tty | json | checkstyle |\
                \ codeclimate | gitlab_codeclimate | gnu | codacy | sonarqube |\
                \ sarif] (default: tty)"
              Mod OptionFields OutputFormat
-> Mod OptionFields OutputFormat -> Mod OptionFields OutputFormat
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Mod OptionFields OutputFormat
forall (f :: * -> *) a. HasCompleter f => [FilePath] -> Mod f a
completeWith
                  [ FilePath
"tty",
                    FilePath
"json",
                    FilePath
"checkstyle",
                    FilePath
"codeclimate",
                    FilePath
"gitlab_codeclimate",
                    FilePath
"codacy",
                    FilePath
"sonarqube",
                    FilePath
"sarif"
                  ]
          )

    parseErrorList :: Parser [RuleCode]
parseErrorList =
      Parser RuleCode -> Parser [RuleCode]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        ( Mod OptionFields RuleCode -> Parser RuleCode
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"error"
                Mod OptionFields RuleCode
-> Mod OptionFields RuleCode -> Mod OptionFields RuleCode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Make the rule `RULECODE` have the level `error`"
                Mod OptionFields RuleCode
-> Mod OptionFields RuleCode -> Mod OptionFields RuleCode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RULECODE"
            )
        )

    parseWarningList :: Parser [RuleCode]
parseWarningList =
      Parser RuleCode -> Parser [RuleCode]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        ( Mod OptionFields RuleCode -> Parser RuleCode
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"warning"
                Mod OptionFields RuleCode
-> Mod OptionFields RuleCode -> Mod OptionFields RuleCode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Make the rule `RULECODE` have the level `warning`"
                Mod OptionFields RuleCode
-> Mod OptionFields RuleCode -> Mod OptionFields RuleCode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RULECODE"
            )
        )

    parseInfoList :: Parser [RuleCode]
parseInfoList =
      Parser RuleCode -> Parser [RuleCode]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        ( Mod OptionFields RuleCode -> Parser RuleCode
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"info"
                Mod OptionFields RuleCode
-> Mod OptionFields RuleCode -> Mod OptionFields RuleCode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Make the rule `RULECODE` have the level `info`"
                Mod OptionFields RuleCode
-> Mod OptionFields RuleCode -> Mod OptionFields RuleCode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RULECODE"
            )
        )

    parseStyleList :: Parser [RuleCode]
parseStyleList =
      Parser RuleCode -> Parser [RuleCode]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        ( Mod OptionFields RuleCode -> Parser RuleCode
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"style"
                Mod OptionFields RuleCode
-> Mod OptionFields RuleCode -> Mod OptionFields RuleCode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Make the rule `RULECODE` have the level `style`"
                Mod OptionFields RuleCode
-> Mod OptionFields RuleCode -> Mod OptionFields RuleCode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RULECODE"
            )
        )

    parseIgnoreList :: Parser [RuleCode]
parseIgnoreList =
      Parser RuleCode -> Parser [RuleCode]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        ( Mod OptionFields RuleCode -> Parser RuleCode
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"ignore"
                Mod OptionFields RuleCode
-> Mod OptionFields RuleCode -> Mod OptionFields RuleCode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RULECODE"
                Mod OptionFields RuleCode
-> Mod OptionFields RuleCode -> Mod OptionFields RuleCode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields RuleCode
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"A rule to ignore. If present, the ignore list in the\
                        \ config file is ignored"
            )
        )

    parseAllowedRegistries :: Parser (Set Registry)
parseAllowedRegistries =
      [Registry] -> Set Registry
forall a. Ord a => [a] -> Set a
Set.fromList ([Registry] -> Set Registry)
-> ([FilePath] -> [Registry]) -> [FilePath] -> Set Registry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Registry) -> [FilePath] -> [Registry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Registry
forall a. IsString a => FilePath -> a
fromString
        ([FilePath] -> Set Registry)
-> Parser [FilePath] -> Parser (Set Registry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
          ( Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"trusted-registry"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"REGISTRY (e.g. docker.io)"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"A docker registry to allow to appear in FROM \
                          \instructions"
              )
          )

    parseLabelSchema :: Parser LabelSchema
parseLabelSchema =
      [(Text, LabelType)] -> LabelSchema
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        ([(Text, LabelType)] -> LabelSchema)
-> Parser [(Text, LabelType)] -> Parser LabelSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, LabelType) -> Parser [(Text, LabelType)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
          ( ReadM (Text, LabelType)
-> Mod OptionFields (Text, LabelType) -> Parser (Text, LabelType)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
              ReadM (Text, LabelType)
readSingleLabelSchema
              ( FilePath -> Mod OptionFields (Text, LabelType)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"require-label"
                  Mod OptionFields (Text, LabelType)
-> Mod OptionFields (Text, LabelType)
-> Mod OptionFields (Text, LabelType)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (Text, LabelType)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"LABELSCHEMA (e.g. maintainer:text)"
                  Mod OptionFields (Text, LabelType)
-> Mod OptionFields (Text, LabelType)
-> Mod OptionFields (Text, LabelType)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (Text, LabelType)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The option --require-label=label:format makes\
                          \ Hadolint check that the label `label` conforms to\
                          \ format requirement `format`"
              )
          )

    parseStrictlabels :: Parser (Maybe Bool)
parseStrictlabels =
      Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
            ( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"strict-labels"
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Do not permit labels other than specified in\
                        \ `label-schema`"
            )
        )

    parseDisableIgnorePragma :: Parser (Maybe Bool)
parseDisableIgnorePragma =
      Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
            ( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"disable-ignore-pragma"
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Disable inline ignore pragmas \
                        \ `# hadolint ignore=DLxxxx`"
            )
        )

    parseFailureThreshold :: Parser (Maybe DLSeverity)
parseFailureThreshold =
      Parser DLSeverity -> Parser (Maybe DLSeverity)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser DLSeverity -> Parser (Maybe DLSeverity))
-> Parser DLSeverity -> Parser (Maybe DLSeverity)
forall a b. (a -> b) -> a -> b
$
        ReadM DLSeverity
-> Mod OptionFields DLSeverity -> Parser DLSeverity
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ( (FilePath -> Either FilePath DLSeverity) -> ReadM DLSeverity
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader (Text -> Either FilePath DLSeverity
readEitherSeverity (Text -> Either FilePath DLSeverity)
-> (FilePath -> Text) -> FilePath -> Either FilePath DLSeverity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack) )
          ( Char -> Mod OptionFields DLSeverity
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't'
              Mod OptionFields DLSeverity
-> Mod OptionFields DLSeverity -> Mod OptionFields DLSeverity
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields DLSeverity
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"failure-threshold"
              Mod OptionFields DLSeverity
-> Mod OptionFields DLSeverity -> Mod OptionFields DLSeverity
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields DLSeverity
forall (f :: * -> *) a. FilePath -> Mod f a
help
                FilePath
"Exit with failure code only when rules with a severity equal\
                \ to or above THRESHOLD are violated. Accepted values: [error\
                \ | warning | info | style | ignore | none] (default: info)"
              Mod OptionFields DLSeverity
-> Mod OptionFields DLSeverity -> Mod OptionFields DLSeverity
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields DLSeverity
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"THRESHOLD"
              Mod OptionFields DLSeverity
-> Mod OptionFields DLSeverity -> Mod OptionFields DLSeverity
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Mod OptionFields DLSeverity
forall (f :: * -> *) a. HasCompleter f => [FilePath] -> Mod f a
completeWith
                  [ FilePath
"error",
                    FilePath
"warning",
                    FilePath
"info",
                    FilePath
"style",
                    FilePath
"ignore",
                    FilePath
"none"
                  ]
          )


type SingleLabelSchema = (LabelName, LabelType)

readSingleLabelSchema :: ReadM SingleLabelSchema
readSingleLabelSchema :: ReadM (Text, LabelType)
readSingleLabelSchema = (FilePath -> Either FilePath (Text, LabelType))
-> ReadM (Text, LabelType)
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader ((FilePath -> Either FilePath (Text, LabelType))
 -> ReadM (Text, LabelType))
-> (FilePath -> Either FilePath (Text, LabelType))
-> ReadM (Text, LabelType)
forall a b. (a -> b) -> a -> b
$ \FilePath
s -> Text -> Either FilePath (Text, LabelType)
labelParser (FilePath -> Text
pack FilePath
s)

labelParser :: Text -> Either String (LabelName, LabelType)
labelParser :: Text -> Either FilePath (Text, LabelType)
labelParser Text
l =
  case (Text -> Either Text LabelType)
-> (Text, Text) -> (Text, Either Text LabelType)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Text -> Either Text LabelType
readEitherLabelType (Text -> Either Text LabelType)
-> (Text -> Text) -> Text -> Either Text LabelType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Data.Text.drop Int
1) ((Text, Text) -> (Text, Either Text LabelType))
-> (Text, Text) -> (Text, Either Text LabelType)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
breakOn Text
":" Text
l of
    (Text
ln, Right LabelType
lt) -> (Text, LabelType) -> Either FilePath (Text, LabelType)
forall a b. b -> Either a b
Right (Text
ln, LabelType
lt)
    (Text
_, Left Text
e) -> FilePath -> Either FilePath (Text, LabelType)
forall a b. a -> Either a b
Left (Text -> FilePath
unpack Text
e)