module Buffet.Assemble.GlobalBuildStage
  ( get
  ) where

import qualified Buffet.Assemble.ConditionInstructionsInContext as ConditionInstructionsInContext
import qualified Buffet.Assemble.ScheduleParallelInstructions as ScheduleParallelInstructions
import qualified Buffet.Ir.Ir as Ir
import qualified Data.Map.Strict as Map
import Prelude (($), (.), fmap, uncurry)

get :: Ir.Buffet -> [Ir.DockerfilePart]
get :: Buffet -> [DockerfilePart]
get = [DockerfilePart] -> [DockerfilePart]
ScheduleParallelInstructions.get ([DockerfilePart] -> [DockerfilePart])
-> (Buffet -> [DockerfilePart]) -> Buffet -> [DockerfilePart]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffet -> [DockerfilePart]
dishesInstructions

dishesInstructions :: Ir.Buffet -> [Ir.DockerfilePart]
dishesInstructions :: Buffet -> [DockerfilePart]
dishesInstructions Buffet
buffet =
  ((Option, Dish) -> DockerfilePart)
-> [(Option, Dish)] -> [DockerfilePart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Option -> Dish -> DockerfilePart)
-> (Option, Dish) -> DockerfilePart
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Option -> Dish -> DockerfilePart)
 -> (Option, Dish) -> DockerfilePart)
-> (Option -> Dish -> DockerfilePart)
-> (Option, Dish)
-> DockerfilePart
forall a b. (a -> b) -> a -> b
$ Buffet -> Option -> Dish -> DockerfilePart
dishInstructions Buffet
buffet) ([(Option, Dish)] -> [DockerfilePart])
-> (Map Option Dish -> [(Option, Dish)])
-> Map Option Dish
-> [DockerfilePart]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Option Dish -> [(Option, Dish)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map Option Dish -> [DockerfilePart])
-> Map Option Dish -> [DockerfilePart]
forall a b. (a -> b) -> a -> b
$
  Buffet -> Map Option Dish
Ir.optionToDish Buffet
buffet

dishInstructions :: Ir.Buffet -> Ir.Option -> Ir.Dish -> Ir.DockerfilePart
dishInstructions :: Buffet -> Option -> Dish -> DockerfilePart
dishInstructions Buffet
buffet Option
option =
  Buffet -> Option -> DockerfilePart -> DockerfilePart
ConditionInstructionsInContext.get Buffet
buffet Option
option (DockerfilePart -> DockerfilePart)
-> (Dish -> DockerfilePart) -> Dish -> DockerfilePart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dish -> DockerfilePart
Ir.globalBuildStage