module Hadolint.Rule.DL3050 (rule) where

import qualified Data.Map as Map
import Hadolint.Rule
import Language.Docker.Syntax


rule :: LabelSchema -> Bool -> Rule args
rule :: LabelSchema -> Bool -> Rule args
rule LabelSchema
labelschema Bool
strictlabels = RuleCode
-> DLSeverity -> Text -> (Instruction args -> Bool) -> Rule args
forall args.
RuleCode
-> DLSeverity -> Text -> (Instruction args -> Bool) -> Rule args
simpleRule RuleCode
code DLSeverity
severity Text
message Instruction args -> Bool
forall args. Instruction args -> Bool
check
  where
    code :: RuleCode
code = RuleCode
"DL3050"
    severity :: DLSeverity
severity = DLSeverity
DLInfoC
    message :: Text
message = Text
"Superfluous label(s) present."
    check :: Instruction args -> Bool
check (Label Pairs
pairs)
        | Bool
strictlabels = ((Text, Text) -> Bool) -> Pairs -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LabelSchema -> [Text]
forall k a. Map k a -> [k]
Map.keys LabelSchema
labelschema) (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) Pairs
pairs
        | Bool
otherwise = Bool
True
    check Instruction args
_ = Bool
True
{-# INLINEABLE rule #-}