module Buffet.Assemble.ConditionInstructionsInContext
  ( get
  ) where

import qualified Buffet.Assemble.ConditionInstructions as ConditionInstructions
import qualified Buffet.Assemble.HasArgInstructionWithName as HasArgInstructionWithName
import qualified Buffet.Ir.Ir as Ir
import qualified Data.Map.Strict as Map
import Prelude (Bool(False), ($), (.), any, id, maybe, mconcat, pure)

get :: Ir.Buffet -> Ir.Option -> Ir.DockerfilePart -> Ir.DockerfilePart
get :: Buffet -> Option -> DockerfilePart -> DockerfilePart
get Buffet
buffet Option
option =
  if Buffet -> Option -> Bool
hasOptionArgInstruction Buffet
buffet Option
option
    then Configuration -> DockerfilePart -> DockerfilePart
ConditionInstructions.get Configuration
configuration
    else DockerfilePart -> DockerfilePart
forall a. a -> a
id
  where
    configuration :: Configuration
configuration =
      Configuration :: Text -> Option -> Configuration
ConditionInstructions.Configuration
        { copyDummySourcePath :: Text
ConditionInstructions.copyDummySourcePath =
            Buffet -> Text
Ir.copyDummySourcePath Buffet
buffet
        , option :: Option
ConditionInstructions.option = Option
option
        }

hasOptionArgInstruction :: Ir.Buffet -> Ir.Option -> Bool
hasOptionArgInstruction :: Buffet -> Option -> Bool
hasOptionArgInstruction Buffet
buffet Option
option =
  Bool -> (Dish -> Bool) -> Maybe Dish -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Dish -> Bool
hasOptionArg (Maybe Dish -> Bool)
-> (Map Option Dish -> Maybe Dish) -> Map Option Dish -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Map Option Dish -> Maybe Dish
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Option
option (Map Option Dish -> Bool) -> Map Option Dish -> Bool
forall a b. (a -> b) -> a -> b
$ Buffet -> Map Option Dish
Ir.optionToDish Buffet
buffet
  where
    hasOptionArg :: Dish -> Bool
hasOptionArg = (DockerfilePart -> Bool) -> [DockerfilePart] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Option -> DockerfilePart -> Bool
HasArgInstructionWithName.get Option
option) ([DockerfilePart] -> Bool)
-> (Dish -> [DockerfilePart]) -> Dish -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dish -> [DockerfilePart]
parts
    parts :: Dish -> [DockerfilePart]
parts Dish
dish =
      [[DockerfilePart]] -> [DockerfilePart]
forall a. Monoid a => [a] -> a
mconcat
        [ DockerfilePart -> [DockerfilePart]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DockerfilePart -> [DockerfilePart])
-> DockerfilePart -> [DockerfilePart]
forall a b. (a -> b) -> a -> b
$ Dish -> DockerfilePart
Ir.beforeFirstBuildStage Dish
dish
        , Dish -> [DockerfilePart]
Ir.localBuildStages Dish
dish
        , DockerfilePart -> [DockerfilePart]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DockerfilePart -> [DockerfilePart])
-> DockerfilePart -> [DockerfilePart]
forall a b. (a -> b) -> a -> b
$ Dish -> DockerfilePart
Ir.globalBuildStage Dish
dish
        ]