Adds computation expressions to compose dockerfiles

src/Dockerfile.fs

@@ -212,3 +212,99 @@ module Dockerfile =
     /// Concatenates a list of Dockerfile instructions into a single Dockerfile
     let buildDockerfile (instructions:Instruction list) =
         instructions |> List.map (printInstruction) |> String.concat System.Environment.NewLine
+
+module Builders =
+    type DockerfileSpec =
+        { Instructions : Dockerfile.Instruction list }
+        member this.Build () = Dockerfile.buildDockerfile this.Instructions
+        member this.Stage : string option =
+            let fromAs = function
+                | Dockerfile.From (_, _, Some buildStage) -> Some buildStage
+                | _ -> None
+            this.Instructions |> List.choose fromAs |> List.tryHead
+
+    type DockerfileBuilder () =
+        member _.Bind (config:DockerfileSpec, fn) : DockerfileSpec = fn config
+        member _.Combine (a:DockerfileSpec, b:DockerfileSpec) = { Instructions = a.Instructions @ b.Instructions }
+        member _.Delay (fn:unit -> DockerfileSpec) = fn ()
+        member _.Yield _ = { Instructions = [] }
+        member _.YieldFrom (config:DockerfileSpec) = config
+        member _.Zero _ = { Instructions = [] }
+        [<CustomOperation "from">]
+        member _.From (config:DockerfileSpec, baseImage:string) =
+            let instruction =
+                match baseImage.Split [|':'|] with
+                | [| name |] -> Dockerfile.From(name, None, None)
+                | [| name; version |] -> Dockerfile.From(name, Some version, None)
+                | _ -> invalidArg "baseImage" "Image should be of form 'name:version'"
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "from_stage">]
+        member _.FromStage (config:DockerfileSpec, baseImage:string, stage:string) =
+            let instruction =
+                match baseImage.Split [|':'|] with
+                | [| name |] -> Dockerfile.From(name, None, Some stage)
+                | [| name; version |] -> Dockerfile.From(name, Some version, Some stage)
+                | _ -> invalidArg "baseImage" "Image should be of form 'name:version'"
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "cmd">]
+        member _.CmdShellCommand (config:DockerfileSpec, shellCmd:string) =
+            let instruction = Dockerfile.Cmd(Dockerfile.ShellCommand shellCmd)
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "copy">]
+        member _.Copy (config:DockerfileSpec, source:string, dest:string) =
+            let instruction = Dockerfile.Copy(Dockerfile.SingleSource source, dest, None)
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "copy_from">]
+        member _.CopyFrom (config:DockerfileSpec, stage:string, source:string, dest:string) =
+            let instruction = Dockerfile.Copy(Dockerfile.SingleSource source, dest, Some (Dockerfile.BuildStage.Name stage))
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "env">]
+        member _.Env (config:DockerfileSpec, envVar:string * string) =
+            let instruction = Dockerfile.Env (Dockerfile.Dictionary ([envVar] |> Map.ofList))
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        member _.Env (config:DockerfileSpec, envVars:Map<string, string>) =
+            let instruction = Dockerfile.Env (Dockerfile.KeyVal.Dictionary envVars)
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "env_vars">]
+        member _.EnvVars (config:DockerfileSpec, envVars:(string * string) list) =
+            let instruction = Dockerfile.Env (Dockerfile.KeyVal.Dictionary (envVars |> Map.ofList))
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "expose">]
+        member _.Expose (config:DockerfileSpec, port:int) =
+            let instruction = Dockerfile.Expose [(uint16 port)]
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        member _.Expose (config:DockerfileSpec, ports:int list) =
+            let instruction = Dockerfile.Expose (ports |> List.map uint16)
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "run_exec">]
+        member _.RunExec (config:DockerfileSpec, exec:string, args:string list) =
+            let instruction = Dockerfile.Run(Dockerfile.Exec (exec, args))
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        member _.RunExec (config:DockerfileSpec, exec:string, args:string) =
+            let instruction = Dockerfile.Run(Dockerfile.Exec (exec, List.ofArray (args.Split null)))
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "run">]
+        member _.RunShell (config:DockerfileSpec, shellCmd:string) =
+            let instruction = Dockerfile.Run(Dockerfile.ShellCommand shellCmd)
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "user">]
+        member _.User (config:DockerfileSpec, user:string) =
+            let instruction =
+                match user.Split [|':'|] with
+                | [| username |] -> Dockerfile.User(username, None)
+                | [| username; group |] -> Dockerfile.User(username, Some group)
+                | _ -> invalidArg "user" "User should be of form 'username:group'"
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "volume">]
+        member _.Volume (config:DockerfileSpec, volume:string) =
+            let instruction = Dockerfile.Volume [volume]
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "add_volumes">]
+        member _.AddVolumes (config:DockerfileSpec, volumes:string list) =
+            let instruction = Dockerfile.Volume volumes
+            { config with Instructions = config.Instructions @ [ instruction ] }
+        [<CustomOperation "workdir">]
+        member _.Workdir (config:DockerfileSpec, workdir:string) =
+            let instruction = Dockerfile.WorkDir workdir
+            { config with Instructions = config.Instructions @ [ instruction ] }
+    let dockerfile = DockerfileBuilder ()

tests/BuilderTests.fs

@@ -0,0 +1,116 @@
+module BuilderTests
+
+open System
+open Xunit
+open FSharp.Text.Docker.Builders
+
+[<Fact>]
+let ``Simple builder`` () =
+    let myDockerfile = dockerfile {
+        from_stage "mcr.microsoft.com/dotnet/sdk:5.0.302" "builder"
+        run_exec "apt-get" "install -y wget"
+        run "dotnet new console -lang F# -n foo"
+        workdir "foo"
+        run "dotnet build -c Release -o app"
+        from "mcr.microsoft.com/dotnet/runtime:5.0.8"
+        expose 80
+        copy_from "builder" "/path/to/source/myApp.dll" "/path/to/dest"
+        cmd "dotnet /path/to/dest/myApp.dll"
+    }
+    let spec = myDockerfile.Build ()
+    let expected = """
+FROM mcr.microsoft.com/dotnet/sdk:5.0.302 AS builder
+RUN ["apt-get","install","-y","wget"]
+RUN dotnet new console -lang F# -n foo
+WORKDIR foo
+RUN dotnet build -c Release -o app
+FROM mcr.microsoft.com/dotnet/runtime:5.0.8
+EXPOSE 80
+COPY --from=builder /path/to/source/myApp.dll /path/to/dest
+CMD dotnet /path/to/dest/myApp.dll
+"""
+    Assert.Equal (expected.Trim(), spec)
+
+[<Fact>]
+let ``From parsing`` () =
+    let myDockerfile = dockerfile {
+        from "good"
+    }
+    let spec = myDockerfile.Build ()
+    Assert.Equal ("FROM good", spec)
+
+    let myDockerfile = dockerfile {
+        from "good:tag"
+    }
+    let spec = myDockerfile.Build ()
+    Assert.Equal ("FROM good:tag", spec)
+
+    Assert.Throws<ArgumentException> (fun _ ->
+        let _ = dockerfile {
+            from "bad:image:tag"
+        }
+        ()
+    ) |> ignore
+
+[<Fact>]
+let ``User parsing`` () =
+    let myDockerfile = dockerfile {
+        user "someuser"
+    }
+    let spec = myDockerfile.Build ()
+    Assert.Equal ("USER someuser", spec)
+
+    let myDockerfile = dockerfile {
+        user "someuser:wheel"
+    }
+    let spec = myDockerfile.Build ()
+    Assert.Equal ("USER someuser:wheel", spec)
+
+    Assert.Throws<ArgumentException> (fun _ ->
+        let _ = dockerfile {
+            from "someuser:wheel:WAT"
+        }
+        ()
+    ) |> ignore
+
+[<Fact>]
+let ``Dockerfile composed of multiple builders`` () =
+    let myDockerfile = dockerfile {
+        let! builder = dockerfile {
+            from_stage "mcr.microsoft.com/dotnet/sdk:5.0.302" "builder"
+            run_exec "apt-get" "install -y wget"
+            run "dotnet new console -lang F# -n foo"
+            workdir "foo"
+            run "dotnet build -c Release -o app"
+        }
+        yield! builder
+        match builder.Stage with
+        | Some stage ->
+            yield! dockerfile {
+                from "mcr.microsoft.com/dotnet/runtime:5.0.8"
+                expose 80
+                env ("DOTNET_EnableDiagnostics", "0")
+                env_vars [
+                    "FOO", "BAR"
+                    "NETCORE", "5.0.8"
+                ]
+                copy_from stage "/path/to/source/myApp.dll" "/path/to/dest"
+            }
+        | _ -> failwith "Missing stage in 'builder' dockerfile"
+        yield! dockerfile { cmd "dotnet /path/to/dest/myApp.dll" }
+    }
+    let spec = myDockerfile.Build ()
+    let expected = """
+FROM mcr.microsoft.com/dotnet/sdk:5.0.302 AS builder
+RUN ["apt-get","install","-y","wget"]
+RUN dotnet new console -lang F# -n foo
+WORKDIR foo
+RUN dotnet build -c Release -o app
+FROM mcr.microsoft.com/dotnet/runtime:5.0.8
+EXPOSE 80
+ENV DOTNET_EnableDiagnostics=0
+ENV FOO=BAR NETCORE=5.0.8
+COPY --from=builder /path/to/source/myApp.dll /path/to/dest
+CMD dotnet /path/to/dest/myApp.dll
+"""
+    Assert.Equal (expected.Trim(), spec)

tests/FSharp.Text.Docker.Tests.fsproj

@@ -7,6 +7,7 @@
   </PropertyGroup>
 
   <ItemGroup>
+    <Compile Include="BuilderTests.fs" />
     <Compile Include="DockerfileTests.fs" />
   </ItemGroup>