module Hadolint.Config.Configuration
  ( Configuration (..),
    PartialConfiguration (..),

    applyPartialConfiguration,
  )
where

import Data.Maybe (fromMaybe)
import Control.Applicative
import Data.Coerce (coerce)
import Data.Default
import Data.Text (Text)
import Data.YAML ((.:?), (.!=))
import GHC.Generics (Generic)
import Hadolint.Formatter.Format (OutputFormat (..))
import Hadolint.Rule (RuleCode (..), DLSeverity (..), LabelSchema)
import Language.Docker
import Prettyprinter
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.YAML as Yaml


data Configuration =
  Configuration
    { Configuration -> Bool
noFail :: Bool,
      Configuration -> Bool
noColor :: Bool,
      Configuration -> Bool
verbose :: Bool,
      Configuration -> OutputFormat
format :: OutputFormat,
      Configuration -> [RuleCode]
errorRules :: [RuleCode],
      Configuration -> [RuleCode]
warningRules :: [RuleCode],
      Configuration -> [RuleCode]
infoRules :: [RuleCode],
      Configuration -> [RuleCode]
styleRules :: [RuleCode],
      Configuration -> [RuleCode]
ignoreRules :: [RuleCode],
      Configuration -> Set Registry
allowedRegistries :: Set.Set Registry,
      Configuration -> LabelSchema
labelSchema :: LabelSchema,
      Configuration -> Bool
strictLabels :: Bool,
      Configuration -> Bool
disableIgnorePragma :: Bool,
      Configuration -> DLSeverity
failureThreshold :: DLSeverity
    }
  deriving (Configuration -> Configuration -> Bool
(Configuration -> Configuration -> Bool)
-> (Configuration -> Configuration -> Bool) -> Eq Configuration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Configuration -> Configuration -> Bool
$c/= :: Configuration -> Configuration -> Bool
== :: Configuration -> Configuration -> Bool
$c== :: Configuration -> Configuration -> Bool
Eq, Int -> Configuration -> ShowS
[Configuration] -> ShowS
Configuration -> String
(Int -> Configuration -> ShowS)
-> (Configuration -> String)
-> ([Configuration] -> ShowS)
-> Show Configuration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Configuration] -> ShowS
$cshowList :: [Configuration] -> ShowS
show :: Configuration -> String
$cshow :: Configuration -> String
showsPrec :: Int -> Configuration -> ShowS
$cshowsPrec :: Int -> Configuration -> ShowS
Show)

instance Default Configuration where
  def :: Configuration
def =
    Bool
-> Bool
-> Bool
-> OutputFormat
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> Set Registry
-> LabelSchema
-> Bool
-> Bool
-> DLSeverity
-> Configuration
Configuration
      Bool
False
      Bool
False
      Bool
False
      OutputFormat
forall a. Default a => a
def
      [RuleCode]
forall a. Monoid a => a
mempty
      [RuleCode]
forall a. Monoid a => a
mempty
      [RuleCode]
forall a. Monoid a => a
mempty
      [RuleCode]
forall a. Monoid a => a
mempty
      [RuleCode]
forall a. Monoid a => a
mempty
      Set Registry
forall a. Monoid a => a
mempty
      LabelSchema
forall a. Monoid a => a
mempty
      Bool
False
      Bool
False
      DLSeverity
forall a. Default a => a
def

applyPartialConfiguration ::
  Configuration -> PartialConfiguration -> Configuration
applyPartialConfiguration :: Configuration -> PartialConfiguration -> Configuration
applyPartialConfiguration Configuration
config PartialConfiguration
partial =
  Bool
-> Bool
-> Bool
-> OutputFormat
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> Set Registry
-> LabelSchema
-> Bool
-> Bool
-> DLSeverity
-> Configuration
Configuration
    (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Configuration -> Bool
noFail Configuration
config) (PartialConfiguration -> Maybe Bool
partialNoFail PartialConfiguration
partial))
    (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Configuration -> Bool
noColor Configuration
config) (PartialConfiguration -> Maybe Bool
partialNoColor PartialConfiguration
partial))
    (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Configuration -> Bool
verbose Configuration
config) (PartialConfiguration -> Maybe Bool
partialVerbose PartialConfiguration
partial))
    (OutputFormat -> Maybe OutputFormat -> OutputFormat
forall a. a -> Maybe a -> a
fromMaybe (Configuration -> OutputFormat
format Configuration
config) (PartialConfiguration -> Maybe OutputFormat
partialFormat PartialConfiguration
partial))
    (Configuration -> [RuleCode]
errorRules Configuration
config [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration -> [RuleCode]
partialErrorRules PartialConfiguration
partial)
    (Configuration -> [RuleCode]
warningRules Configuration
config [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration -> [RuleCode]
partialWarningRules PartialConfiguration
partial)
    (Configuration -> [RuleCode]
infoRules Configuration
config [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration -> [RuleCode]
partialInfoRules PartialConfiguration
partial)
    (Configuration -> [RuleCode]
styleRules Configuration
config [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration -> [RuleCode]
partialStyleRules PartialConfiguration
partial)
    (Configuration -> [RuleCode]
ignoreRules Configuration
config [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration -> [RuleCode]
partialIgnoreRules PartialConfiguration
partial)
    (Configuration -> Set Registry
allowedRegistries Configuration
config Set Registry -> Set Registry -> Set Registry
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration -> Set Registry
partialAllowedRegistries PartialConfiguration
partial)
    (Configuration -> LabelSchema
labelSchema Configuration
config LabelSchema -> LabelSchema -> LabelSchema
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration -> LabelSchema
partialLabelSchema PartialConfiguration
partial)
    (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Configuration -> Bool
strictLabels Configuration
config) (PartialConfiguration -> Maybe Bool
partialStrictLabels PartialConfiguration
partial))
    (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Configuration -> Bool
disableIgnorePragma Configuration
config) (PartialConfiguration -> Maybe Bool
partialDisableIgnorePragma PartialConfiguration
partial))
    (DLSeverity -> Maybe DLSeverity -> DLSeverity
forall a. a -> Maybe a -> a
fromMaybe (Configuration -> DLSeverity
failureThreshold Configuration
config) (PartialConfiguration -> Maybe DLSeverity
partialFailureThreshold PartialConfiguration
partial))

instance Pretty Configuration where
  pretty :: Configuration -> Doc ann
pretty Configuration
c =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2
      ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
          [ Doc ann
"Configuration:",
            Doc ann
"no fail:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Configuration -> Bool
noFail Configuration
c),
            Doc ann
"no color:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Configuration -> Bool
noColor Configuration
c),
            Doc ann
"output format:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> OutputFormat -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Configuration -> OutputFormat
format Configuration
c),
            Doc ann
"failure threshold:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DLSeverity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Configuration -> DLSeverity
failureThreshold Configuration
c),
            String -> [RuleCode] -> Doc ann
forall ann. String -> [RuleCode] -> Doc ann
prettyPrintRulelist String
"error" (Configuration -> [RuleCode]
errorRules Configuration
c),
            String -> [RuleCode] -> Doc ann
forall ann. String -> [RuleCode] -> Doc ann
prettyPrintRulelist String
"warning" (Configuration -> [RuleCode]
warningRules Configuration
c),
            String -> [RuleCode] -> Doc ann
forall ann. String -> [RuleCode] -> Doc ann
prettyPrintRulelist String
"info" (Configuration -> [RuleCode]
infoRules Configuration
c),
            String -> [RuleCode] -> Doc ann
forall ann. String -> [RuleCode] -> Doc ann
prettyPrintRulelist String
"style" (Configuration -> [RuleCode]
styleRules Configuration
c),
            String -> [RuleCode] -> Doc ann
forall ann. String -> [RuleCode] -> Doc ann
prettyPrintRulelist String
"ignore" (Configuration -> [RuleCode]
ignoreRules Configuration
c),
            Doc ann
"strict labels:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Configuration -> Bool
strictLabels Configuration
c),
            LabelSchema -> Doc ann
forall ann. LabelSchema -> Doc ann
prettyPrintLabelSchema (Configuration -> LabelSchema
labelSchema Configuration
c),
            Doc ann
"disable ignore pragma:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Configuration -> Bool
disableIgnorePragma Configuration
c),
            Set Registry -> Doc ann
forall ann. Set Registry -> Doc ann
prettyPrintRegistries (Configuration -> Set Registry
allowedRegistries Configuration
c)
          ]
      )

prettyPrintRulelist :: String -> [RuleCode] -> Doc ann
prettyPrintRulelist :: String -> [RuleCode] -> Doc ann
prettyPrintRulelist String
name [RuleCode]
lst =
  Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ((Doc ann
"override" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":\n") Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (RuleCode -> Doc ann) -> [RuleCode] -> Doc ann
forall a ann. (a -> Doc ann) -> [a] -> Doc ann
prettyPrintList RuleCode -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [RuleCode]
lst)

-- | This function needs to convert the set to a list because Doc ann is not
-- ordered.
prettyPrintRegistries :: Set.Set Registry -> Doc ann
prettyPrintRegistries :: Set Registry -> Doc ann
prettyPrintRegistries Set Registry
regs =
  Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ( Doc ann
"allowed registries:\n"
             Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (Registry -> Doc ann) -> [Registry] -> Doc ann
forall a ann. (a -> Doc ann) -> [a] -> Doc ann
prettyPrintList
                 (\Registry
r -> Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Registry -> Text
unRegistry Registry
r))
                 (Set Registry -> [Registry]
forall a. Set a -> [a]
Set.toList Set Registry
regs)
         )

prettyPrintLabelSchema :: LabelSchema -> Doc ann
prettyPrintLabelSchema :: LabelSchema -> Doc ann
prettyPrintLabelSchema LabelSchema
ls =
  Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ( Doc ann
"label schema:\n"
             Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ((Text, LabelType) -> Doc ann) -> [(Text, LabelType)] -> Doc ann
forall a ann. (a -> Doc ann) -> [a] -> Doc ann
prettyPrintList
                  (\(Text
n, LabelType
t) -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> LabelType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty LabelType
t)
                  (LabelSchema -> [(Text, LabelType)]
forall k a. Map k a -> [(k, a)]
Map.toList LabelSchema
ls)
         )

-- | pretty print a list with a custom pretty printing function for each element
prettyPrintList :: (a -> Doc ann) -> [a] -> Doc ann
prettyPrintList :: (a -> Doc ann) -> [a] -> Doc ann
prettyPrintList a -> Doc ann
_ [] = Doc ann
"none"
prettyPrintList a -> Doc ann
prnt [a]
lst = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((a -> Doc ann) -> [a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
i -> Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
prnt a
i) [a]
lst)


data PartialConfiguration =
  PartialConfiguration
    { PartialConfiguration -> Maybe Bool
partialNoFail :: Maybe Bool,
      PartialConfiguration -> Maybe Bool
partialNoColor :: Maybe Bool,
      PartialConfiguration -> Maybe Bool
partialVerbose :: Maybe Bool,
      PartialConfiguration -> Maybe OutputFormat
partialFormat :: Maybe OutputFormat,
      PartialConfiguration -> [RuleCode]
partialErrorRules :: [RuleCode],
      PartialConfiguration -> [RuleCode]
partialWarningRules :: [RuleCode],
      PartialConfiguration -> [RuleCode]
partialInfoRules :: [RuleCode],
      PartialConfiguration -> [RuleCode]
partialStyleRules :: [RuleCode],
      PartialConfiguration -> [RuleCode]
partialIgnoreRules :: [RuleCode],
      PartialConfiguration -> Set Registry
partialAllowedRegistries :: Set.Set Registry,
      PartialConfiguration -> LabelSchema
partialLabelSchema :: LabelSchema,
      PartialConfiguration -> Maybe Bool
partialStrictLabels :: Maybe Bool,
      PartialConfiguration -> Maybe Bool
partialDisableIgnorePragma :: Maybe Bool,
      PartialConfiguration -> Maybe DLSeverity
partialFailureThreshold :: Maybe DLSeverity
    }
  deriving (PartialConfiguration -> PartialConfiguration -> Bool
(PartialConfiguration -> PartialConfiguration -> Bool)
-> (PartialConfiguration -> PartialConfiguration -> Bool)
-> Eq PartialConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartialConfiguration -> PartialConfiguration -> Bool
$c/= :: PartialConfiguration -> PartialConfiguration -> Bool
== :: PartialConfiguration -> PartialConfiguration -> Bool
$c== :: PartialConfiguration -> PartialConfiguration -> Bool
Eq, Int -> PartialConfiguration -> ShowS
[PartialConfiguration] -> ShowS
PartialConfiguration -> String
(Int -> PartialConfiguration -> ShowS)
-> (PartialConfiguration -> String)
-> ([PartialConfiguration] -> ShowS)
-> Show PartialConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialConfiguration] -> ShowS
$cshowList :: [PartialConfiguration] -> ShowS
show :: PartialConfiguration -> String
$cshow :: PartialConfiguration -> String
showsPrec :: Int -> PartialConfiguration -> ShowS
$cshowsPrec :: Int -> PartialConfiguration -> ShowS
Show)


instance Semigroup PartialConfiguration where
  PartialConfiguration Maybe Bool
a1 Maybe Bool
a2 Maybe Bool
a3 Maybe OutputFormat
a4 [RuleCode]
a5 [RuleCode]
a6 [RuleCode]
a7 [RuleCode]
a8 [RuleCode]
a9 Set Registry
a10 LabelSchema
a11 Maybe Bool
a12 Maybe Bool
a13 Maybe DLSeverity
a14
    <> :: PartialConfiguration
-> PartialConfiguration -> PartialConfiguration
<> PartialConfiguration Maybe Bool
b1 Maybe Bool
b2 Maybe Bool
b3 Maybe OutputFormat
b4 [RuleCode]
b5 [RuleCode]
b6 [RuleCode]
b7 [RuleCode]
b8 [RuleCode]
b9 Set Registry
b10 LabelSchema
b11 Maybe Bool
b12 Maybe Bool
b13 Maybe DLSeverity
b14 =
      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
b1 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
a1)
        (Maybe Bool
b2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
a2)
        (Maybe Bool
b3 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
a3)
        (Maybe OutputFormat
a4 Maybe OutputFormat -> Maybe OutputFormat -> Maybe OutputFormat
forall a. Semigroup a => a -> a -> a
<> Maybe OutputFormat
b4)
        ([RuleCode]
a5 [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> [RuleCode]
b5)
        ([RuleCode]
a6 [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> [RuleCode]
b6)
        ([RuleCode]
a7 [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> [RuleCode]
b7)
        ([RuleCode]
a8 [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> [RuleCode]
b8)
        ([RuleCode]
a9 [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> [RuleCode]
b9)
        (Set Registry
a10 Set Registry -> Set Registry -> Set Registry
forall a. Semigroup a => a -> a -> a
<> Set Registry
b10)
        (LabelSchema
a11 LabelSchema -> LabelSchema -> LabelSchema
forall a. Semigroup a => a -> a -> a
<> LabelSchema
b11)
        (Maybe Bool
b12 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
a12)
        (Maybe Bool
b13 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
a13)
        (Maybe DLSeverity
a14 Maybe DLSeverity -> Maybe DLSeverity -> Maybe DLSeverity
forall a. Semigroup a => a -> a -> a
<> Maybe DLSeverity
b14)

instance Monoid PartialConfiguration where
  mempty :: PartialConfiguration
mempty =
    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
forall a. Maybe a
Nothing
      Maybe Bool
forall a. Maybe a
Nothing
      Maybe Bool
forall a. Maybe a
Nothing
      Maybe OutputFormat
forall a. Monoid a => a
mempty
      [RuleCode]
forall a. Monoid a => a
mempty
      [RuleCode]
forall a. Monoid a => a
mempty
      [RuleCode]
forall a. Monoid a => a
mempty
      [RuleCode]
forall a. Monoid a => a
mempty
      [RuleCode]
forall a. Monoid a => a
mempty
      Set Registry
forall a. Monoid a => a
mempty
      LabelSchema
forall a. Monoid a => a
mempty
      Maybe Bool
forall a. Maybe a
Nothing
      Maybe Bool
forall a. Maybe a
Nothing
      Maybe DLSeverity
forall a. Monoid a => a
mempty

instance Default PartialConfiguration where
  def :: PartialConfiguration
def = PartialConfiguration
forall a. Monoid a => a
mempty

instance Yaml.FromYAML PartialConfiguration where
  parseYAML :: Node Pos -> Parser PartialConfiguration
parseYAML = String
-> (Mapping Pos -> Parser PartialConfiguration)
-> Node Pos
-> Parser PartialConfiguration
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
Yaml.withMap String
"Configuration" ((Mapping Pos -> Parser PartialConfiguration)
 -> Node Pos -> Parser PartialConfiguration)
-> (Mapping Pos -> Parser PartialConfiguration)
-> Node Pos
-> Parser PartialConfiguration
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> do
    Maybe Bool
partialNoFail <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe (Maybe Bool))
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"no-fail" Parser (Maybe (Maybe Bool)) -> Maybe Bool -> Parser (Maybe Bool)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
partialNoColor <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe (Maybe Bool))
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"no-color" Parser (Maybe (Maybe Bool)) -> Maybe Bool -> Parser (Maybe Bool)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
partialVerbose <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe (Maybe Bool))
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"verbose" Parser (Maybe (Maybe Bool)) -> Maybe Bool -> Parser (Maybe Bool)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe Bool
forall a. Maybe a
Nothing
    Maybe OutputFormat
partialFormat <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe OutputFormat)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"output-format"
    OverrideConfig
override <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe OverrideConfig)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"override" Parser (Maybe OverrideConfig)
-> OverrideConfig -> Parser OverrideConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= OverrideConfig
forall a. Monoid a => a
mempty
    [Text]
ignored <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe [Text])
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"ignored" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [Text]
forall a. Monoid a => a
mempty
    [Text]
trusted <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe [Text])
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"trustedRegistries" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [Text]
forall a. Monoid a => a
mempty
    LabelSchema
partialLabelSchema <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe LabelSchema)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"label-schema" Parser (Maybe LabelSchema) -> LabelSchema -> Parser LabelSchema
forall a. Parser (Maybe a) -> a -> Parser a
.!= LabelSchema
forall a. Monoid a => a
mempty
    Maybe Bool
partialStrictLabels <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe (Maybe Bool))
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"strict-labels" Parser (Maybe (Maybe Bool)) -> Maybe Bool -> Parser (Maybe Bool)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe Bool
forall a. Maybe a
Nothing
    Maybe Bool
partialDisableIgnorePragma <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe (Maybe Bool))
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"disable-ignore-pragma" Parser (Maybe (Maybe Bool)) -> Maybe Bool -> Parser (Maybe Bool)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe Bool
forall a. Maybe a
Nothing
    let partialIgnoreRules :: [RuleCode]
partialIgnoreRules = [Text] -> [RuleCode]
coerce ([Text]
ignored :: [Text])
        partialErrorRules :: [RuleCode]
partialErrorRules = OverrideConfig -> [RuleCode]
overrideErrorRules OverrideConfig
override
        partialWarningRules :: [RuleCode]
partialWarningRules = OverrideConfig -> [RuleCode]
overrideWarningRules OverrideConfig
override
        partialInfoRules :: [RuleCode]
partialInfoRules = OverrideConfig -> [RuleCode]
overrideInfoRules OverrideConfig
override
        partialStyleRules :: [RuleCode]
partialStyleRules = OverrideConfig -> [RuleCode]
overrideStyleRules OverrideConfig
override
        partialAllowedRegistries :: Set Registry
partialAllowedRegistries = [Registry] -> Set Registry
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> [Registry]
coerce ([Text]
trusted :: [Text]))
    Maybe DLSeverity
partialFailureThreshold <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe DLSeverity)
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"failure-threshold"
    PartialConfiguration -> Parser PartialConfiguration
forall (m :: * -> *) a. Monad m => a -> m a
return PartialConfiguration :: Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe OutputFormat
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> Set Registry
-> LabelSchema
-> Maybe Bool
-> Maybe Bool
-> Maybe DLSeverity
-> PartialConfiguration
PartialConfiguration {[RuleCode]
Maybe Bool
Maybe DLSeverity
Maybe OutputFormat
Set Registry
LabelSchema
partialFailureThreshold :: Maybe DLSeverity
partialAllowedRegistries :: Set Registry
partialStyleRules :: [RuleCode]
partialInfoRules :: [RuleCode]
partialWarningRules :: [RuleCode]
partialErrorRules :: [RuleCode]
partialIgnoreRules :: [RuleCode]
partialDisableIgnorePragma :: Maybe Bool
partialStrictLabels :: Maybe Bool
partialLabelSchema :: LabelSchema
partialFormat :: Maybe OutputFormat
partialVerbose :: Maybe Bool
partialNoColor :: Maybe Bool
partialNoFail :: Maybe Bool
partialFailureThreshold :: Maybe DLSeverity
partialDisableIgnorePragma :: Maybe Bool
partialStrictLabels :: Maybe Bool
partialLabelSchema :: LabelSchema
partialAllowedRegistries :: Set Registry
partialIgnoreRules :: [RuleCode]
partialStyleRules :: [RuleCode]
partialInfoRules :: [RuleCode]
partialWarningRules :: [RuleCode]
partialErrorRules :: [RuleCode]
partialFormat :: Maybe OutputFormat
partialVerbose :: Maybe Bool
partialNoColor :: Maybe Bool
partialNoFail :: Maybe Bool
..}


data OverrideConfig = OverrideConfig
  { OverrideConfig -> [RuleCode]
overrideErrorRules :: [RuleCode],
    OverrideConfig -> [RuleCode]
overrideWarningRules :: [RuleCode],
    OverrideConfig -> [RuleCode]
overrideInfoRules :: [RuleCode],
    OverrideConfig -> [RuleCode]
overrideStyleRules :: [RuleCode]
  }
  deriving (Int -> OverrideConfig -> ShowS
[OverrideConfig] -> ShowS
OverrideConfig -> String
(Int -> OverrideConfig -> ShowS)
-> (OverrideConfig -> String)
-> ([OverrideConfig] -> ShowS)
-> Show OverrideConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OverrideConfig] -> ShowS
$cshowList :: [OverrideConfig] -> ShowS
show :: OverrideConfig -> String
$cshow :: OverrideConfig -> String
showsPrec :: Int -> OverrideConfig -> ShowS
$cshowsPrec :: Int -> OverrideConfig -> ShowS
Show, OverrideConfig -> OverrideConfig -> Bool
(OverrideConfig -> OverrideConfig -> Bool)
-> (OverrideConfig -> OverrideConfig -> Bool) -> Eq OverrideConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OverrideConfig -> OverrideConfig -> Bool
$c/= :: OverrideConfig -> OverrideConfig -> Bool
== :: OverrideConfig -> OverrideConfig -> Bool
$c== :: OverrideConfig -> OverrideConfig -> Bool
Eq, (forall x. OverrideConfig -> Rep OverrideConfig x)
-> (forall x. Rep OverrideConfig x -> OverrideConfig)
-> Generic OverrideConfig
forall x. Rep OverrideConfig x -> OverrideConfig
forall x. OverrideConfig -> Rep OverrideConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OverrideConfig x -> OverrideConfig
$cfrom :: forall x. OverrideConfig -> Rep OverrideConfig x
Generic)

instance Semigroup OverrideConfig where
  OverrideConfig [RuleCode]
a1 [RuleCode]
a2 [RuleCode]
a3 [RuleCode]
a4 <> :: OverrideConfig -> OverrideConfig -> OverrideConfig
<> OverrideConfig [RuleCode]
b1 [RuleCode]
b2 [RuleCode]
b3 [RuleCode]
b4 =
    [RuleCode]
-> [RuleCode] -> [RuleCode] -> [RuleCode] -> OverrideConfig
OverrideConfig ([RuleCode]
a1 [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> [RuleCode]
b1) ([RuleCode]
a2 [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> [RuleCode]
b2) ([RuleCode]
a3 [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> [RuleCode]
b3) ([RuleCode]
a4 [RuleCode] -> [RuleCode] -> [RuleCode]
forall a. Semigroup a => a -> a -> a
<> [RuleCode]
b4)

instance Monoid OverrideConfig where
  mempty :: OverrideConfig
mempty = [RuleCode]
-> [RuleCode] -> [RuleCode] -> [RuleCode] -> OverrideConfig
OverrideConfig [RuleCode]
forall a. Monoid a => a
mempty [RuleCode]
forall a. Monoid a => a
mempty [RuleCode]
forall a. Monoid a => a
mempty [RuleCode]
forall a. Monoid a => a
mempty

instance Yaml.FromYAML OverrideConfig where
  parseYAML :: Node Pos -> Parser OverrideConfig
parseYAML = String
-> (Mapping Pos -> Parser OverrideConfig)
-> Node Pos
-> Parser OverrideConfig
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
Yaml.withMap String
"OverrideConfig" ((Mapping Pos -> Parser OverrideConfig)
 -> Node Pos -> Parser OverrideConfig)
-> (Mapping Pos -> Parser OverrideConfig)
-> Node Pos
-> Parser OverrideConfig
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> do
    [Text]
err <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe [Text])
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"error" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [Text]
forall a. Monoid a => a
mempty
    [Text]
wrn <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe [Text])
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"warning" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [Text]
forall a. Monoid a => a
mempty
    [Text]
inf <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe [Text])
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"info" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [Text]
forall a. Monoid a => a
mempty
    [Text]
sty <- Mapping Pos
m Mapping Pos -> Text -> Parser (Maybe [Text])
forall a. FromYAML a => Mapping Pos -> Text -> Parser (Maybe a)
.:? Text
"style" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [Text]
forall a. Monoid a => a
mempty
    let overrideErrorRules :: [RuleCode]
overrideErrorRules = [Text] -> [RuleCode]
coerce ([Text]
err :: [Text])
        overrideWarningRules :: [RuleCode]
overrideWarningRules = [Text] -> [RuleCode]
coerce ([Text]
wrn :: [Text])
        overrideInfoRules :: [RuleCode]
overrideInfoRules = [Text] -> [RuleCode]
coerce ([Text]
inf :: [Text])
        overrideStyleRules :: [RuleCode]
overrideStyleRules = [Text] -> [RuleCode]
coerce ([Text]
sty:: [Text])
    OverrideConfig -> Parser OverrideConfig
forall (m :: * -> *) a. Monad m => a -> m a
return OverrideConfig :: [RuleCode]
-> [RuleCode] -> [RuleCode] -> [RuleCode] -> OverrideConfig
OverrideConfig {[RuleCode]
overrideStyleRules :: [RuleCode]
overrideInfoRules :: [RuleCode]
overrideWarningRules :: [RuleCode]
overrideErrorRules :: [RuleCode]
overrideStyleRules :: [RuleCode]
overrideInfoRules :: [RuleCode]
overrideWarningRules :: [RuleCode]
overrideErrorRules :: [RuleCode]
..}