buffet 0.2.0 → 0.3.0

raw patch · 29 files changed

+483/−407 lines, 29 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +15/−13
• buffet.cabal +14/−11
• src/Buffet.hs +5/−5
• src/Buffet/Assemble/Assemble.hs +11/−0
• src/Buffet/Assemble/AssembleInternal.hs +27/−0
• src/Buffet/Assemble/BeforeFirstBuildStage.hs +14/−0
• src/Buffet/Assemble/ConditionInstructions.hs +75/−0
• src/Buffet/Assemble/ConditionInstructionsInContext.hs +34/−0
• src/Buffet/Assemble/GlobalBuildStage.hs +21/−0
• src/Buffet/Assemble/HasArgInstructionWithName.hs +14/−0
• src/Buffet/Assemble/InsertOptionArgInstructionUnlessPresent.hs +28/−0
• src/Buffet/Assemble/JoinConsecutiveEnvInstructions.hs +14/−0
• src/Buffet/Assemble/JoinConsecutiveRunInstructions.hs +27/−0
• src/Buffet/Assemble/LocalBuildStages.hs +17/−0
• src/Buffet/Assemble/ScheduleParallelInstructions.hs +132/−0
• src/Buffet/Build/BeforeFirstBuildStage.hs +0/−14
• src/Buffet/Build/Build.hs +0/−11
• src/Buffet/Build/BuildInternal.hs +0/−27
• src/Buffet/Build/ConditionInstructions.hs +0/−66
• src/Buffet/Build/GlobalBuildStage.hs +0/−21
• src/Buffet/Build/InsertOptionArgInstructionUnlessPresent.hs +0/−34
• src/Buffet/Build/JoinConsecutiveRunInstructions.hs +0/−27
• src/Buffet/Build/LocalBuildStages.hs +0/−17
• src/Buffet/Build/ScheduleParallelInstructions.hs +0/−122
• src/Buffet/Facade.hs +9/−9
• src/Buffet/Test/TestDish.hs +4/−10
• src/Buffet/Test/TestInternal.hs +14/−12
• src/Buffet/Test/TestSetup.hs +2/−2
• test/Spec.hs +6/−6

@@ -41,22 +41,22 @@ cd buffet ``` -### Building+### Assembling -In the subfolders of the [`example`](example) folder, you see a [Dockerfile for Prettier](example/prettier/Dockerfile) and another [Dockerfile for HTML Tidy](example/tidy/Dockerfile). These Dockerfiles (called "dishes") are the modular toy blocks, which we now automatically combine to one Dockerfile (called "buffet") by running+In the subfolders of [`examples/quick_start`](examples/quick_start), you see a [Dockerfile for Prettier](examples/quick_start/prettier/Dockerfile) and another [Dockerfile for HTML Tidy](examples/quick_start/tidy/Dockerfile). These Dockerfiles (called "dishes") are the modular toy blocks, which we now automatically combine to one Dockerfile (called "buffet") by running  ```bash-buffet build example+buffet assemble examples/quick_start ``` -This prints a Dockerfile based on the subfolders of `example`. From this, we can then build a Docker image `mona_linta` with+This prints a Dockerfile based on the subfolders of `examples/quick_start`. From this, we can then build a Docker image `mona_linta` with  ```bash-buffet build example | docker build \-  --build-arg prettier=1.19.1 --build-arg tidy=1 --tag mona_linta -+buffet assemble examples/quick_start | \+  docker build --build-arg prettier=1.19.1 --tag mona_linta - ``` -Note how we pass a `--build-arg` per tool, assigning each a nonempty value. In case of Prettier, we use this to parameterize the tool version. If we do not mention a tool in a `--build-arg`, it is not available in the image.+Note how in case of Prettier, we pass a `--build-arg` to parameterize the tool version.  ### Testing @@ -68,13 +68,14 @@ tidy --version ``` -To integrate a check like `prettier --version` as a test of the tool installation, add a `HEALTHCHECK` instruction as you see in the [Dockerfile for Prettier](example/prettier/Dockerfile). The exit status of such a command is then reported when you run our example test suite with+To integrate a check like `prettier --version` as a test of the tool installation, add a `HEALTHCHECK` instruction as you see in the [Dockerfile for Prettier](examples/quick_start/prettier/Dockerfile). The exit status of such a command is then reported when you run our example test suite with  ```bash-buffet test --arguments example/test_arguments.yaml example+buffet test --arguments examples/quick_start/test_arguments.yaml \+  examples/quick_start ``` -The file [`test_arguments.yaml`](example/test_arguments.yaml) provides the `--build-arg` configuration for this test run.+This builds a Docker image to then run the tests. The file [`test_arguments.yaml`](examples/quick_start/test_arguments.yaml) provides a map that is used for two things: firstly, its entries are used as `--build-arg` options when building the image, and secondly, only tests of dishes referred in this map are run.  If you like, try adding a test for HTML Tidy. @@ -83,13 +84,14 @@ You can generate documentation with  ```bash-buffet document --template example/document_template.md.mustache example+buffet document --template examples/quick_start/document_template.md.mustache \+  examples/quick_start ``` -This renders the template [`document_template.md.mustache`](example/document_template.md.mustache). To print the raw template context, omit this option as in+This renders the template [`document_template.md.mustache`](examples/quick_start/document_template.md.mustache). To print the raw template context, omit this option as in  ```bash-buffet document example+buffet document examples/quick_start ```  Among others, data from `LABEL` instructions is integrated in the template context.

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 319ef9951348de1ea9c86ff2b630f3782648058a27081eead89bb848f9b51822+-- hash: 5c90f2e0ec4124cff2061142d852633fd18e964bd4a7e694cdc1dcf169ae55af  name:           buffet-version:        0.2.0+version:        0.3.0 synopsis:       Assembles many Dockerfiles in one. description:    See https://github.com/evolutics/buffet category:       Development@@ -29,15 +29,18 @@ library buffet-internal   exposed-modules:       Buffet-      Buffet.Build.BeforeFirstBuildStage-      Buffet.Build.Build-      Buffet.Build.BuildInternal-      Buffet.Build.ConditionInstructions-      Buffet.Build.GlobalBuildStage-      Buffet.Build.InsertOptionArgInstructionUnlessPresent-      Buffet.Build.JoinConsecutiveRunInstructions-      Buffet.Build.LocalBuildStages-      Buffet.Build.ScheduleParallelInstructions+      Buffet.Assemble.Assemble+      Buffet.Assemble.AssembleInternal+      Buffet.Assemble.BeforeFirstBuildStage+      Buffet.Assemble.ConditionInstructions+      Buffet.Assemble.ConditionInstructionsInContext+      Buffet.Assemble.GlobalBuildStage+      Buffet.Assemble.HasArgInstructionWithName+      Buffet.Assemble.InsertOptionArgInstructionUnlessPresent+      Buffet.Assemble.JoinConsecutiveEnvInstructions+      Buffet.Assemble.JoinConsecutiveRunInstructions+      Buffet.Assemble.LocalBuildStages+      Buffet.Assemble.ScheduleParallelInstructions       Buffet.Document.Configuration       Buffet.Document.Document       Buffet.Document.DocumentInternal

@@ -34,7 +34,7 @@     raw =       Options.hsubparser $       mconcat-        [ Options.command "build" build+        [ Options.command "assemble" assemble         , Options.command "document" document         , Options.command "parse" parse         , Options.command "test" test@@ -42,7 +42,7 @@  versionOption :: Options.Parser (a -> a) versionOption =-  Options.infoOption "Buffet 0.2.0" $+  Options.infoOption "Buffet 0.3.0" $   mconcat     [Options.long "version", Options.helpDoc $ Just versionHelp, Options.hidden]   where@@ -53,12 +53,12 @@         , "according to the GNU coding standards."         ] -build :: Options.ParserInfo Facade.Command-build =+assemble :: Options.ParserInfo Facade.Command+assemble =   Options.info parser $   Options.progDesc "Assembles a Dockerfile from a list of Dockerfiles."   where-    parser = fmap Facade.Build $ Facade.BuildArguments <$> menuOperand+    parser = fmap Facade.Assemble $ Facade.AssembleArguments <$> menuOperand  menuOperand :: Options.Parser FilePath menuOperand =

@@ -0,0 +1,11 @@+module Buffet.Assemble.Assemble+  ( get+  ) where++import qualified Buffet.Assemble.AssembleInternal as AssembleInternal+import qualified Buffet.Parse.ParseInternal as ParseInternal+import qualified Data.Text as T+import Prelude (FilePath, IO, (.), fmap)++get :: FilePath -> IO T.Text+get = fmap AssembleInternal.get . ParseInternal.get

@@ -0,0 +1,27 @@+module Buffet.Assemble.AssembleInternal+  ( get+  ) where++import qualified Buffet.Assemble.BeforeFirstBuildStage as BeforeFirstBuildStage+import qualified Buffet.Assemble.GlobalBuildStage as GlobalBuildStage+import qualified Buffet.Assemble.LocalBuildStages as LocalBuildStages+import qualified Buffet.Ir.Ir as Ir+import qualified Buffet.Toolbox.DockerTools as DockerTools+import qualified Buffet.Toolbox.TextTools as TextTools+import qualified Data.Text as T+import Prelude (($), (.), fmap, mconcat)++get :: Ir.Buffet -> T.Text+get buffet =+  printDockerfileParts $+  mconcat+    [ BeforeFirstBuildStage.get buffet+    , LocalBuildStages.get buffet+    , GlobalBuildStage.get buffet+    ]++printDockerfileParts :: [Ir.DockerfilePart] -> T.Text+printDockerfileParts = TextTools.intercalateNewline . fmap printInstructions++printInstructions :: Ir.DockerfilePart -> T.Text+printInstructions = mconcat . fmap DockerTools.printInstruction

@@ -0,0 +1,14 @@+module Buffet.Assemble.BeforeFirstBuildStage+  ( get+  ) where++import qualified Buffet.Assemble.ScheduleParallelInstructions as ScheduleParallelInstructions+import qualified Buffet.Ir.Ir as Ir+import qualified Data.Map.Strict as Map+import Prelude ((.), fmap)++get :: Ir.Buffet -> [Ir.DockerfilePart]+get = ScheduleParallelInstructions.get . dishesInstructions++dishesInstructions :: Ir.Buffet -> [Ir.DockerfilePart]+dishesInstructions = fmap Ir.beforeFirstBuildStage . Map.elems . Ir.optionToDish

@@ -0,0 +1,75 @@+module Buffet.Assemble.ConditionInstructions+  ( Configuration(..)+  , get+  ) where++import qualified Buffet.Assemble.InsertOptionArgInstructionUnlessPresent as InsertOptionArgInstructionUnlessPresent+import qualified Buffet.Ir.Ir as Ir+import qualified Buffet.Toolbox.TextTools as TextTools+import qualified Data.Text as T+import qualified Language.Docker as Docker hiding (sourcePaths)+import qualified Language.Docker.Syntax as Syntax+import Prelude (Eq, Ord, Show, ($), (.), (<>), fmap, mconcat, pure)++data Configuration =+  Configuration+    { copyDummySourcePath :: T.Text+    , option :: Ir.Option+    }+  deriving (Eq, Ord, Show)++get :: Configuration -> Ir.DockerfilePart -> Ir.DockerfilePart+get configuration =+  fmap (conditionInstruction configuration) .+  InsertOptionArgInstructionUnlessPresent.get option'+  where+    option' = option configuration++conditionInstruction ::+     Configuration -> Docker.Instruction T.Text -> Docker.Instruction T.Text+conditionInstruction configuration = condition+  where+    condition (Docker.Copy arguments) =+      conditionCopyInstruction configuration arguments+    condition (Docker.Run (Syntax.ArgumentsText command)) =+      configuredConditionRunInstruction configuration command+    condition instruction = instruction++conditionCopyInstruction ::+     Configuration -> Docker.CopyArgs -> Docker.Instruction T.Text+conditionCopyInstruction buffet arguments =+  Docker.Copy arguments {Docker.sourcePaths = sources}+  where+    sources = fmap makePattern originalSources <> pure dummy+    makePattern path =+      Docker.SourcePath+        {Docker.unSourcePath = T.snoc (Docker.unSourcePath path) '*'}+    originalSources = Docker.sourcePaths arguments+    dummy = Docker.SourcePath {Docker.unSourcePath = copyDummySourcePath buffet}++configuredConditionRunInstruction ::+     Configuration -> T.Text -> Docker.Instruction T.Text+configuredConditionRunInstruction configuration =+  conditionRunInstruction condition+  where+    condition =+      mconcat+        [T.pack "[ -n \"${", Ir.option $ option configuration, T.pack "}\" ]"]++conditionRunInstruction :: T.Text -> T.Text -> Docker.Instruction T.Text+conditionRunInstruction condition thenPart =+  Docker.Run $ Syntax.ArgumentsText command+  where+    command =+      TextTools.intercalateNewline $+      mconcat [[conditionLine], indentLines thenLines, [indentLine endLine]]+    conditionLine = mconcat [T.pack "if ", condition, T.pack "; then \\"]+    thenLines = T.lines embeddedThen+    embeddedThen = mconcat [indentLine thenPart, T.pack " \\"]+    endLine = T.pack "; fi"++indentLines :: [T.Text] -> [T.Text]+indentLines = fmap indentLine++indentLine :: T.Text -> T.Text+indentLine = T.append $ T.pack "  "

@@ -0,0 +1,34 @@+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 =+  if hasOptionArgInstruction buffet option+    then ConditionInstructions.get configuration+    else id+  where+    configuration =+      ConditionInstructions.Configuration+        { ConditionInstructions.copyDummySourcePath =+            Ir.copyDummySourcePath buffet+        , ConditionInstructions.option = option+        }++hasOptionArgInstruction :: Ir.Buffet -> Ir.Option -> Bool+hasOptionArgInstruction buffet option =+  maybe False hasOptionArg . Map.lookup option $ Ir.optionToDish buffet+  where+    hasOptionArg = any (HasArgInstructionWithName.get option) . parts+    parts dish =+      mconcat+        [ pure $ Ir.beforeFirstBuildStage dish+        , Ir.localBuildStages dish+        , pure $ Ir.globalBuildStage dish+        ]

@@ -0,0 +1,21 @@+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 = ScheduleParallelInstructions.get . dishesInstructions++dishesInstructions :: Ir.Buffet -> [Ir.DockerfilePart]+dishesInstructions buffet =+  fmap (uncurry $ dishInstructions buffet) . Map.toAscList $+  Ir.optionToDish buffet++dishInstructions :: Ir.Buffet -> Ir.Option -> Ir.Dish -> Ir.DockerfilePart+dishInstructions buffet option =+  ConditionInstructionsInContext.get buffet option . Ir.globalBuildStage

@@ -0,0 +1,14 @@+module Buffet.Assemble.HasArgInstructionWithName+  ( get+  ) where++import qualified Buffet.Ir.Ir as Ir+import qualified Language.Docker as Docker+import Prelude (Bool(False), (==), any)++get :: Ir.Option -> Ir.DockerfilePart -> Bool+get option = any isArgWithName+  where+    isArgWithName (Docker.Arg name _) = name == optionName+    isArgWithName _ = False+    optionName = Ir.option option

@@ -0,0 +1,28 @@+module Buffet.Assemble.InsertOptionArgInstructionUnlessPresent+  ( get+  ) where++import qualified Buffet.Assemble.HasArgInstructionWithName as HasArgInstructionWithName+import qualified Buffet.Ir.Ir as Ir+import qualified Data.List as List+import qualified Language.Docker as Docker+import Prelude (Bool(False, True), Maybe(Nothing), (<>), span)++get :: Ir.Option -> Ir.DockerfilePart -> Ir.DockerfilePart+get option stage = firstFroms <> preparedAfterFirstFroms+  where+    (firstFroms, afterFirstFroms) = span isFrom stage+    preparedAfterFirstFroms =+      if HasArgInstructionWithName.get option afterFirstFroms+        then afterFirstFroms+        else List.insert arg firstArgs <> afterFirstArgs+    arg = Docker.Arg (Ir.option option) Nothing+    (firstArgs, afterFirstArgs) = span isArg afterFirstFroms++isFrom :: Docker.Instruction a -> Bool+isFrom (Docker.From _) = True+isFrom _ = False++isArg :: Docker.Instruction a -> Bool+isArg (Docker.Arg _ _) = True+isArg _ = False

@@ -0,0 +1,14 @@+module Buffet.Assemble.JoinConsecutiveEnvInstructions+  ( get+  ) where++import qualified Buffet.Ir.Ir as Ir+import qualified Language.Docker as Docker+import Prelude ((<>), foldr)++get :: Ir.DockerfilePart -> Ir.DockerfilePart+get = foldr process []+  where+    process (Docker.Env first) (Docker.Env second:rest) =+      Docker.Env (first <> second) : rest+    process first rest = first : rest

@@ -0,0 +1,27 @@+module Buffet.Assemble.JoinConsecutiveRunInstructions+  ( get+  ) where++import qualified Buffet.Ir.Ir as Ir+import qualified Data.Text as T+import qualified Language.Docker as Docker+import qualified Language.Docker.Syntax as Syntax+import Prelude (($), foldr, mconcat)++get :: Ir.DockerfilePart -> Ir.DockerfilePart+get = foldr process []+  where+    process (Docker.Run first) (Docker.Run second:rest) =+      Docker.Run (joinRuns first second) : rest+    process first rest = first : rest++joinRuns ::+     Docker.Arguments T.Text+  -> Docker.Arguments T.Text+  -> Docker.Arguments T.Text+joinRuns first second =+  Syntax.ArgumentsText $+  mconcat [command first, T.pack " \\\n  && ", command second]+  where+    command (Syntax.ArgumentsText shell) = shell+    command (Syntax.ArgumentsList exec) = exec

@@ -0,0 +1,17 @@+module Buffet.Assemble.LocalBuildStages+  ( get+  ) where++import qualified Buffet.Assemble.ConditionInstructionsInContext as ConditionInstructionsInContext+import qualified Buffet.Ir.Ir as Ir+import qualified Data.Map.Strict as Map+import Prelude (($), (.), concatMap, fmap, uncurry)++get :: Ir.Buffet -> [Ir.DockerfilePart]+get buffet =+  concatMap (uncurry $ dishBuildStages buffet) . Map.toAscList $+  Ir.optionToDish buffet++dishBuildStages :: Ir.Buffet -> Ir.Option -> Ir.Dish -> [Ir.DockerfilePart]+dishBuildStages buffet option =+  fmap (ConditionInstructionsInContext.get buffet option) . Ir.localBuildStages

@@ -0,0 +1,132 @@+module Buffet.Assemble.ScheduleParallelInstructions+  ( get+  ) where++import qualified Buffet.Assemble.JoinConsecutiveEnvInstructions as JoinConsecutiveEnvInstructions+import qualified Buffet.Assemble.JoinConsecutiveRunInstructions as JoinConsecutiveRunInstructions+import qualified Buffet.Ir.Ir as Ir+import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.Text as T+import qualified Language.Docker as Docker+import Prelude+  ( Bool(False, True)+  , Maybe(Just, Nothing)+  , ($)+  , (.)+  , (/=)+  , (<>)+  , (==)+  , all+  , concatMap+  , dropWhile+  , filter+  , fmap+  , mconcat+  , minimum+  , null+  , span+  , splitAt+  , take+  , unzip+  )++type ScheduleStep+   = [Ir.DockerfilePart] -> (Ir.DockerfilePart, [Ir.DockerfilePart])++get :: [Ir.DockerfilePart] -> [Ir.DockerfilePart]+get = wrap . schedule []+  where+    wrap [] = []+    wrap timetable = [timetable]+    schedule timetable queues =+      if all null queues+        then timetable+        else schedule timetable' queues'+      where+        timetable' = timetable <> step+        (step, queues') = scheduleStep queues++scheduleStep :: ScheduleStep+scheduleStep queues =+  case filter (\(_, queues') -> queues' /= queues) results of+    [] -> ([], queues)+    result:_ -> result+  where+    results = fmap ($ queues) strategies+    strategies =+      [ scheduleFromInstructions+      , scheduleArgInstructions+      , scheduleShellInstructions+      , scheduleCopyInstructions+      , scheduleEnvInstructions+      , scheduleRunInstructions+      , scheduleWorkdirInstructions+      , scheduleNextInstructionEach+      ]++scheduleFromInstructions :: ScheduleStep+scheduleFromInstructions = unifyInstructions isFrom+  where+    isFrom (Docker.From _) = True+    isFrom _ = False++unifyInstructions :: (Docker.Instruction T.Text -> Bool) -> ScheduleStep+unifyInstructions isRelevant queues =+  case minimumInstruction of+    Nothing -> ([], queues)+    Just instruction ->+      ([instruction], fmap (dropWhile (== instruction)) queues)+  where+    minimumInstruction =+      fmap minimum . NonEmpty.nonEmpty $ nextInstructionsIfRelevant+    nextInstructionsIfRelevant = concatMap (filter isRelevant . take 1) queues++scheduleArgInstructions :: ScheduleStep+scheduleArgInstructions = unifyInstructions isArg+  where+    isArg (Docker.Arg _ _) = True+    isArg _ = False++scheduleShellInstructions :: ScheduleStep+scheduleShellInstructions = unifyInstructions isShell+  where+    isShell (Docker.Shell _) = True+    isShell _ = False++scheduleCopyInstructions :: ScheduleStep+scheduleCopyInstructions = spanInstructions isCopy+  where+    isCopy (Docker.Copy _) = True+    isCopy _ = False++spanInstructions :: (Docker.Instruction T.Text -> Bool) -> ScheduleStep+spanInstructions isRelevant queues = (mconcat spans, queues')+  where+    (spans, queues') = unzip $ fmap (span isRelevant) queues++scheduleEnvInstructions :: ScheduleStep+scheduleEnvInstructions queues =+  (JoinConsecutiveEnvInstructions.get envs, queues')+  where+    (envs, queues') = spanInstructions isEnv queues+    isEnv (Docker.Env _) = True+    isEnv _ = False++scheduleRunInstructions :: ScheduleStep+scheduleRunInstructions queues =+  (JoinConsecutiveRunInstructions.get runs, queues')+  where+    (runs, queues') = spanInstructions isRun queues+    isRun (Docker.Run _) = True+    isRun _ = False++scheduleWorkdirInstructions :: ScheduleStep+scheduleWorkdirInstructions = unifyInstructions isWorkdir+  where+    isWorkdir (Docker.Workdir _) = True+    isWorkdir _ = False++scheduleNextInstructionEach :: ScheduleStep+scheduleNextInstructionEach queues = (mconcat nexts, queues')+  where+    (nexts, queues') = unzip $ fmap (splitAt 1) queues

@@ -1,14 +0,0 @@-module Buffet.Build.BeforeFirstBuildStage-  ( get-  ) where--import qualified Buffet.Build.ScheduleParallelInstructions as ScheduleParallelInstructions-import qualified Buffet.Ir.Ir as Ir-import qualified Data.Map.Strict as Map-import Prelude ((.), fmap)--get :: Ir.Buffet -> [Ir.DockerfilePart]-get = ScheduleParallelInstructions.get . dishesInstructions--dishesInstructions :: Ir.Buffet -> [Ir.DockerfilePart]-dishesInstructions = fmap Ir.beforeFirstBuildStage . Map.elems . Ir.optionToDish

@@ -1,11 +0,0 @@-module Buffet.Build.Build-  ( get-  ) where--import qualified Buffet.Build.BuildInternal as BuildInternal-import qualified Buffet.Parse.ParseInternal as ParseInternal-import qualified Data.Text as T-import Prelude (FilePath, IO, (.), fmap)--get :: FilePath -> IO T.Text-get = fmap BuildInternal.get . ParseInternal.get

@@ -1,27 +0,0 @@-module Buffet.Build.BuildInternal-  ( get-  ) where--import qualified Buffet.Build.BeforeFirstBuildStage as BeforeFirstBuildStage-import qualified Buffet.Build.GlobalBuildStage as GlobalBuildStage-import qualified Buffet.Build.LocalBuildStages as LocalBuildStages-import qualified Buffet.Ir.Ir as Ir-import qualified Buffet.Toolbox.DockerTools as DockerTools-import qualified Buffet.Toolbox.TextTools as TextTools-import qualified Data.Text as T-import Prelude (($), (.), fmap, mconcat)--get :: Ir.Buffet -> T.Text-get buffet =-  printDockerfileParts $-  mconcat-    [ BeforeFirstBuildStage.get buffet-    , LocalBuildStages.get buffet-    , GlobalBuildStage.get buffet-    ]--printDockerfileParts :: [Ir.DockerfilePart] -> T.Text-printDockerfileParts = TextTools.intercalateNewline . fmap printInstructions--printInstructions :: Ir.DockerfilePart -> T.Text-printInstructions = mconcat . fmap DockerTools.printInstruction

@@ -1,66 +0,0 @@-module Buffet.Build.ConditionInstructions-  ( get-  ) where--import qualified Buffet.Build.InsertOptionArgInstructionUnlessPresent as InsertOptionArgInstructionUnlessPresent-import qualified Buffet.Ir.Ir as Ir-import qualified Buffet.Toolbox.TextTools as TextTools-import qualified Data.Text as T-import qualified Language.Docker as Docker hiding (sourcePaths)-import qualified Language.Docker.Syntax as Syntax-import Prelude (($), (.), (<>), fmap, mconcat, pure)--get :: Ir.Buffet -> Ir.Option -> Ir.DockerfilePart -> Ir.DockerfilePart-get buffet option =-  fmap (conditionInstruction buffet option) .-  InsertOptionArgInstructionUnlessPresent.get option--conditionInstruction ::-     Ir.Buffet-  -> Ir.Option-  -> Docker.Instruction T.Text-  -> Docker.Instruction T.Text-conditionInstruction buffet option = condition-  where-    condition (Docker.Copy arguments) =-      conditionalCopyInstruction buffet arguments-    condition (Docker.Run (Syntax.ArgumentsText command)) =-      optionConditionalRunInstruction option command-    condition instruction = instruction--conditionalCopyInstruction ::-     Ir.Buffet -> Docker.CopyArgs -> Docker.Instruction T.Text-conditionalCopyInstruction buffet arguments =-  Docker.Copy arguments {Docker.sourcePaths = conditionalSources}-  where-    conditionalSources = fmap makePattern originalSources <> pure dummy-    makePattern path =-      Docker.SourcePath-        {Docker.unSourcePath = T.snoc (Docker.unSourcePath path) '*'}-    originalSources = Docker.sourcePaths arguments-    dummy =-      Docker.SourcePath {Docker.unSourcePath = Ir.copyDummySourcePath buffet}--optionConditionalRunInstruction ::-     Ir.Option -> T.Text -> Docker.Instruction T.Text-optionConditionalRunInstruction option = conditionalRunInstruction condition-  where-    condition = mconcat [T.pack "[ -n \"${", Ir.option option, T.pack "}\" ]"]--conditionalRunInstruction :: T.Text -> T.Text -> Docker.Instruction T.Text-conditionalRunInstruction condition thenPart =-  Docker.Run $ Syntax.ArgumentsText command-  where-    command =-      TextTools.intercalateNewline $-      mconcat [[conditionLine], indentLines thenLines, [indentLine endLine]]-    conditionLine = mconcat [T.pack "if ", condition, T.pack "; then \\"]-    thenLines = T.lines embeddedThen-    embeddedThen = mconcat [indentLine thenPart, T.pack " \\"]-    endLine = T.pack "; fi"--indentLines :: [T.Text] -> [T.Text]-indentLines = fmap indentLine--indentLine :: T.Text -> T.Text-indentLine = T.append $ T.pack "  "

@@ -1,21 +0,0 @@-module Buffet.Build.GlobalBuildStage-  ( get-  ) where--import qualified Buffet.Build.ConditionInstructions as ConditionInstructions-import qualified Buffet.Build.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 = ScheduleParallelInstructions.get . dishesInstructions--dishesInstructions :: Ir.Buffet -> [Ir.DockerfilePart]-dishesInstructions buffet =-  fmap (uncurry $ dishInstructions buffet) . Map.toAscList $-  Ir.optionToDish buffet--dishInstructions :: Ir.Buffet -> Ir.Option -> Ir.Dish -> Ir.DockerfilePart-dishInstructions buffet option =-  ConditionInstructions.get buffet option . Ir.globalBuildStage

@@ -1,34 +0,0 @@-module Buffet.Build.InsertOptionArgInstructionUnlessPresent-  ( get-  ) where--import qualified Buffet.Ir.Ir as Ir-import qualified Data.List as List-import qualified Language.Docker as Docker-import Prelude (Bool(False, True), Maybe(Nothing), (<>), (==), any, span)--get :: Ir.Option -> Ir.DockerfilePart -> Ir.DockerfilePart-get option stage = firstFroms <> preparedAfterFirstFroms-  where-    (firstFroms, afterFirstFroms) = span isFrom stage-    preparedAfterFirstFroms =-      if hasArgWithName option afterFirstFroms-        then afterFirstFroms-        else List.insert arg firstArgs <> afterFirstArgs-    arg = Docker.Arg (Ir.option option) Nothing-    (firstArgs, afterFirstArgs) = span isArg afterFirstFroms--isFrom :: Docker.Instruction a -> Bool-isFrom (Docker.From _) = True-isFrom _ = False--hasArgWithName :: Ir.Option -> Ir.DockerfilePart -> Bool-hasArgWithName option = any isArgWithName-  where-    isArgWithName (Docker.Arg name _) = name == optionName-    isArgWithName _ = False-    optionName = Ir.option option--isArg :: Docker.Instruction a -> Bool-isArg (Docker.Arg _ _) = True-isArg _ = False

@@ -1,27 +0,0 @@-module Buffet.Build.JoinConsecutiveRunInstructions-  ( get-  ) where--import qualified Buffet.Ir.Ir as Ir-import qualified Data.Text as T-import qualified Language.Docker as Docker-import qualified Language.Docker.Syntax as Syntax-import Prelude (($), foldr, mconcat)--get :: Ir.DockerfilePart -> Ir.DockerfilePart-get = foldr process []-  where-    process (Docker.Run first) (Docker.Run second:rest) =-      Docker.Run (joinRuns first second) : rest-    process first rest = first : rest--joinRuns ::-     Docker.Arguments T.Text-  -> Docker.Arguments T.Text-  -> Docker.Arguments T.Text-joinRuns first second =-  Syntax.ArgumentsText $-  mconcat [command first, T.pack " \\\n  && ", command second]-  where-    command (Syntax.ArgumentsText shell) = shell-    command (Syntax.ArgumentsList exec) = exec

@@ -1,17 +0,0 @@-module Buffet.Build.LocalBuildStages-  ( get-  ) where--import qualified Buffet.Build.ConditionInstructions as ConditionInstructions-import qualified Buffet.Ir.Ir as Ir-import qualified Data.Map.Strict as Map-import Prelude (($), (.), concatMap, fmap, uncurry)--get :: Ir.Buffet -> [Ir.DockerfilePart]-get buffet =-  concatMap (uncurry $ dishBuildStages buffet) . Map.toAscList $-  Ir.optionToDish buffet--dishBuildStages :: Ir.Buffet -> Ir.Option -> Ir.Dish -> [Ir.DockerfilePart]-dishBuildStages buffet option =-  fmap (ConditionInstructions.get buffet option) . Ir.localBuildStages

@@ -1,122 +0,0 @@-module Buffet.Build.ScheduleParallelInstructions-  ( get-  ) where--import qualified Buffet.Build.JoinConsecutiveRunInstructions as JoinConsecutiveRunInstructions-import qualified Buffet.Ir.Ir as Ir-import qualified Data.List.NonEmpty as NonEmpty-import qualified Data.Text as T-import qualified Language.Docker as Docker-import Prelude-  ( Bool(False, True)-  , Maybe(Just, Nothing)-  , ($)-  , (.)-  , (/=)-  , (<>)-  , (==)-  , all-  , concatMap-  , dropWhile-  , filter-  , fmap-  , mconcat-  , minimum-  , null-  , span-  , splitAt-  , take-  , unzip-  )--type ScheduleStep-   = [Ir.DockerfilePart] -> (Ir.DockerfilePart, [Ir.DockerfilePart])--get :: [Ir.DockerfilePart] -> [Ir.DockerfilePart]-get = wrap . schedule []-  where-    wrap [] = []-    wrap timetable = [timetable]-    schedule timetable queues =-      if all null queues-        then timetable-        else schedule timetable' queues'-      where-        timetable' = timetable <> step-        (step, queues') = scheduleStep queues--scheduleStep :: ScheduleStep-scheduleStep queues =-  case filter (\(_, queues') -> queues' /= queues) results of-    [] -> ([], queues)-    result:_ -> result-  where-    results = fmap ($ queues) strategies-    strategies =-      [ scheduleFromInstructions-      , scheduleArgInstructions-      , scheduleShellInstructions-      , scheduleCopyInstructions-      , scheduleRunInstructions-      , scheduleWorkdirInstructions-      , scheduleNextInstructionEach-      ]--scheduleFromInstructions :: ScheduleStep-scheduleFromInstructions = unifyInstructions isFrom-  where-    isFrom (Docker.From _) = True-    isFrom _ = False--unifyInstructions :: (Docker.Instruction T.Text -> Bool) -> ScheduleStep-unifyInstructions isRelevant queues =-  case minimumInstruction of-    Nothing -> ([], queues)-    Just instruction ->-      ([instruction], fmap (dropWhile (== instruction)) queues)-  where-    minimumInstruction =-      fmap minimum . NonEmpty.nonEmpty $ nextInstructionsIfRelevant-    nextInstructionsIfRelevant = concatMap (filter isRelevant . take 1) queues--scheduleArgInstructions :: ScheduleStep-scheduleArgInstructions = unifyInstructions isArg-  where-    isArg (Docker.Arg _ _) = True-    isArg _ = False--scheduleShellInstructions :: ScheduleStep-scheduleShellInstructions = unifyInstructions isShell-  where-    isShell (Docker.Shell _) = True-    isShell _ = False--scheduleCopyInstructions :: ScheduleStep-scheduleCopyInstructions = spanInstructions isCopy-  where-    isCopy (Docker.Copy _) = True-    isCopy _ = False--spanInstructions :: (Docker.Instruction T.Text -> Bool) -> ScheduleStep-spanInstructions isRelevant queues = (mconcat spans, queues')-  where-    (spans, queues') = unzip $ fmap (span isRelevant) queues--scheduleRunInstructions :: ScheduleStep-scheduleRunInstructions queues =-  (JoinConsecutiveRunInstructions.get runs, queues')-  where-    (runs, queues') = spanInstructions isRun queues-    isRun (Docker.Run _) = True-    isRun _ = False--scheduleWorkdirInstructions :: ScheduleStep-scheduleWorkdirInstructions = unifyInstructions isWorkdir-  where-    isWorkdir (Docker.Workdir _) = True-    isWorkdir _ = False--scheduleNextInstructionEach :: ScheduleStep-scheduleNextInstructionEach queues = (mconcat nexts, queues')-  where-    (nexts, queues') = unzip $ fmap (splitAt 1) queues

@@ -1,5 +1,5 @@ module Buffet.Facade-  ( BuildArguments(..)+  ( AssembleArguments(..)   , Command(..)   , DocumentArguments(..)   , ParseArguments(..)@@ -7,7 +7,7 @@   , get   ) where -import qualified Buffet.Build.Build as Build+import qualified Buffet.Assemble.Assemble as Assemble import qualified Buffet.Document.Configuration as Document import qualified Buffet.Document.Document as Document import qualified Buffet.Parse.Parse as Parse@@ -19,15 +19,15 @@ import qualified System.Exit as Exit  data Command-  = Build BuildArguments+  = Assemble AssembleArguments   | Document DocumentArguments   | Parse ParseArguments   | Test TestArguments   deriving (Eq, Ord, Show) -newtype BuildArguments =-  BuildArguments-    { buildMenu :: FilePath+newtype AssembleArguments =+  AssembleArguments+    { assembleMenu :: FilePath     }   deriving (Eq, Ord, Show) @@ -54,13 +54,13 @@ get :: Command -> IO () get command =   case command of-    Build arguments -> build arguments+    Assemble arguments -> assemble arguments     Document arguments -> document arguments     Parse arguments -> parse arguments     Test arguments -> test arguments -build :: BuildArguments -> IO ()-build arguments = Build.get (buildMenu arguments) >>= T.IO.putStr+assemble :: AssembleArguments -> IO ()+assemble arguments = Assemble.get (assembleMenu arguments) >>= T.IO.putStr  document :: DocumentArguments -> IO () document arguments =

@@ -5,25 +5,19 @@ import qualified Buffet.Ir.Ir as Ir import qualified Buffet.Test.TestResult as TestResult import qualified Buffet.Test.TestSetup as TestSetup-import qualified Data.Foldable as Foldable import qualified Data.Text as T-import Prelude (Bool, IO, Maybe(Nothing), ($), (.), (==), pure, traverse)+import Prelude (Bool, IO, Maybe, ($), (.), (==), pure, traverse) import qualified System.Exit as Exit import qualified System.Process.Typed as Process  get :: TestSetup.TestSetup -> IO TestResult.TestResult get testSetup = do-  healthCheckPassed' <--    if T.null optionValue'-      then pure Nothing-      else checkHealth testSetup+  healthCheckPassed <- checkHealth testSetup   pure     TestResult.TestResult-      { TestResult.optionValue = optionValue'-      , TestResult.healthCheckPassed = healthCheckPassed'+      { TestResult.optionValue = TestSetup.optionValue testSetup+      , TestResult.healthCheckPassed = healthCheckPassed       }-  where-    optionValue' = Foldable.fold $ TestSetup.optionValue testSetup  checkHealth :: TestSetup.TestSetup -> IO (Maybe Bool) checkHealth testSetup = traverse run . Ir.healthCheck $ TestSetup.dish testSetup

@@ -2,7 +2,7 @@   ( get   ) where -import qualified Buffet.Build.BuildInternal as BuildInternal+import qualified Buffet.Assemble.AssembleInternal as AssembleInternal import qualified Buffet.Ir.Ir as Ir import qualified Buffet.Test.Configuration as Configuration import qualified Buffet.Test.ParseArguments as ParseArguments@@ -24,22 +24,24 @@   arguments <- ParseArguments.get configuration   let use image = evaluateTestResults <$> sequenceA tests         where-          tests = Map.mapWithKey test $ Ir.optionToDish buffet-          test option dish =-            TestDish.get-              TestSetup.TestSetup-                { TestSetup.log = log-                , TestSetup.image = image-                , TestSetup.option = option-                , TestSetup.optionValue = Map.lookup option arguments-                , TestSetup.dish = dish-                }+          tests = Map.mapMaybeWithKey test $ Ir.optionToDish buffet+          test option dish = testSetup <$> Map.lookup option arguments+            where+              testSetup optionValue =+                TestDish.get+                  TestSetup.TestSetup+                    { TestSetup.log = log+                    , TestSetup.image = image+                    , TestSetup.option = option+                    , TestSetup.optionValue = optionValue+                    , TestSetup.dish = dish+                    }       imageConfiguration =         UsingDockerImage.Configuration           { UsingDockerImage.log = log           , UsingDockerImage.dockerBuild =               UsingDockerImage.DockerBuild-                { UsingDockerImage.dockerfile = BuildInternal.get buffet+                { UsingDockerImage.dockerfile = AssembleInternal.get buffet                 , UsingDockerImage.arguments = arguments                 }           }

@@ -4,7 +4,7 @@  import qualified Buffet.Ir.Ir as Ir import qualified Data.Text as T-import Prelude (Eq, Maybe, Show)+import Prelude (Eq, Show) import qualified System.IO as IO  data TestSetup =@@ -12,7 +12,7 @@     { log :: IO.Handle     , image :: T.Text     , option :: Ir.Option-    , optionValue :: Maybe T.Text+    , optionValue :: T.Text     , dish :: Ir.Dish     }   deriving (Eq, Show)

@@ -16,11 +16,11 @@   sequenceA     [ helpTests "test/data/help"     , versionTests "test/data/version"-    , buildTests "test/data/build"+    , assembleTests "test/data/assemble"     , documentTests "test/data/document"     , parseTests "test/data/parse"     , testTests "test/data/test"-    , exampleTests "test/data/example"+    , examplesTests "test/data/examples"     ]  helpTests :: FilePath -> IO Tasty.TestTree@@ -45,8 +45,8 @@     configuration =       defaultConfiguration {TestUtility.assertStdout = TestVersion.get} -buildTests :: FilePath -> IO Tasty.TestTree-buildTests = TestTools.folderBasedTests $ assert defaultConfiguration+assembleTests :: FilePath -> IO Tasty.TestTree+assembleTests = TestTools.folderBasedTests $ assert defaultConfiguration  documentTests :: FilePath -> IO Tasty.TestTree documentTests = TestTools.folderBasedTests $ assert defaultConfiguration@@ -61,5 +61,5 @@ testTests :: FilePath -> IO Tasty.TestTree testTests = TestTools.folderBasedTests $ assert defaultConfiguration -exampleTests :: FilePath -> IO Tasty.TestTree-exampleTests = TestTools.folderBasedTests $ assert defaultConfiguration+examplesTests :: FilePath -> IO Tasty.TestTree+examplesTests = TestTools.folderBasedTests $ assert defaultConfiguration