module Hadolint.Rule.DL4003 (rule) where

import Hadolint.Rule
import Language.Docker.Syntax (Instruction (..))

data HasCmd = HasCmd | NoCmd

rule :: Rule args
rule :: Rule args
rule = (Linenumber -> State HasCmd -> Instruction args -> State HasCmd)
-> State HasCmd -> Rule args
forall a args.
(Linenumber -> State a -> Instruction args -> State a)
-> State a -> Rule args
customRule Linenumber -> State HasCmd -> Instruction args -> State HasCmd
forall args.
Linenumber -> State HasCmd -> Instruction args -> State HasCmd
check (HasCmd -> State HasCmd
forall a. a -> State a
emptyState HasCmd
NoCmd)
  where
    code :: RuleCode
code = RuleCode
"DL4003"
    severity :: DLSeverity
severity = DLSeverity
DLWarningC
    message :: Text
message =
      Text
"Multiple `CMD` instructions found. If you list more than one `CMD` then only the last \
      \`CMD` will take effect"

    -- Reset the state each time we find a FROM
    check :: Linenumber -> State HasCmd -> Instruction args -> State HasCmd
check Linenumber
_ State HasCmd
st From {} = State HasCmd
st State HasCmd -> (State HasCmd -> State HasCmd) -> State HasCmd
forall a b. a -> (a -> b) -> b
|> HasCmd -> State HasCmd -> State HasCmd
forall a. a -> State a -> State a
replaceWith HasCmd
NoCmd
    -- Remember we found a CMD, fail if we found a CMD before
    check Linenumber
_ st :: State HasCmd
st@(State Failures
_ HasCmd
NoCmd) Cmd {} = State HasCmd
st State HasCmd -> (State HasCmd -> State HasCmd) -> State HasCmd
forall a b. a -> (a -> b) -> b
|> HasCmd -> State HasCmd -> State HasCmd
forall a. a -> State a -> State a
replaceWith HasCmd
HasCmd
    -- If we already saw a CMD, add an error for the line
    check Linenumber
line st :: State HasCmd
st@(State Failures
_ HasCmd
HasCmd) Cmd {} = State HasCmd
st State HasCmd -> (State HasCmd -> State HasCmd) -> State HasCmd
forall a b. a -> (a -> b) -> b
|> CheckFailure -> State HasCmd -> State HasCmd
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
..})
    -- otherwise return the accumulator
    check Linenumber
_ State HasCmd
st Instruction args
_ = State HasCmd
st
{-# INLINEABLE rule #-}