module Hadolint.Rule.DL3012 (rule) where

import Hadolint.Rule
import Language.Docker.Syntax


rule :: Rule args
rule :: Rule args
rule = (Linenumber -> State Bool -> Instruction args -> State Bool)
-> State Bool -> Rule args
forall a args.
(Linenumber -> State a -> Instruction args -> State a)
-> State a -> Rule args
customRule Linenumber -> State Bool -> Instruction args -> State Bool
forall args.
Linenumber -> State Bool -> Instruction args -> State Bool
check (Bool -> State Bool
forall a. a -> State a
emptyState Bool
False)
  where
    code :: RuleCode
code = RuleCode
"DL3012"
    severity :: DLSeverity
severity = DLSeverity
DLErrorC
    message :: Text
message = Text
"Multiple `HEALTHCHECK` instructions"
    check :: Linenumber -> State Bool -> Instruction args -> State Bool
check Linenumber
_ State Bool
st From {} = State Bool
st State Bool -> (State Bool -> State Bool) -> State Bool
forall a b. a -> (a -> b) -> b
|> Bool -> State Bool -> State Bool
forall a. a -> State a -> State a
replaceWith Bool
False
    check Linenumber
line State Bool
st Healthcheck {}
        | Bool -> Bool
not (State Bool -> Bool
forall a. State a -> a
state State Bool
st) = State Bool
st State Bool -> (State Bool -> State Bool) -> State Bool
forall a b. a -> (a -> b) -> b
|> Bool -> State Bool -> State Bool
forall a. a -> State a -> State a
replaceWith Bool
True
        | Bool
otherwise = State Bool
st State Bool -> (State Bool -> State Bool) -> State Bool
forall a b. a -> (a -> b) -> b
|> CheckFailure -> State Bool -> State Bool
forall a. CheckFailure -> State a -> State a
addFail CheckFailure :: RuleCode -> DLSeverity -> Text -> Linenumber -> CheckFailure
CheckFailure {Linenumber
Text
RuleCode
DLSeverity
line :: Linenumber
message :: Text
severity :: DLSeverity
code :: RuleCode
line :: Linenumber
message :: Text
severity :: DLSeverity
code :: RuleCode
..}
    check Linenumber
_ State Bool
st Instruction args
_ = State Bool
st
{-# INLINEABLE rule #-}