Config

.config/dotnet-tools.json

@@ -0,0 +1,12 @@
+{
+  "version": 1,
+  "isRoot": true,
+  "tools": {
+    "fantomas": {
+      "version": "6.2.3",
+      "commands": [
+        "fantomas"
+      ]
+    }
+  }
+}

.editorconfig

@@ -0,0 +1,41 @@
+root=true
+
+[*]
+charset=utf-8
+end_of_line=crlf
+trim_trailing_whitespace=true
+insert_final_newline=true
+indent_style=space
+indent_size=4
+
+# ReSharper properties
+resharper_xml_indent_size=2
+resharper_xml_max_line_length=100
+resharper_xml_tab_width=2
+
+[*.{csproj,fsproj,sqlproj,targets,props,ts,tsx,css,json}]
+indent_style=space
+indent_size=2
+
+[*.{fs,fsi}]
+fsharp_bar_before_discriminated_union_declaration=true
+fsharp_space_before_uppercase_invocation=true
+fsharp_space_before_class_constructor=true
+fsharp_space_before_member=true
+fsharp_space_before_colon=true
+fsharp_space_before_semicolon=true
+fsharp_multiline_bracket_style=aligned
+fsharp_newline_between_type_definition_and_members=true
+fsharp_align_function_signature_to_indentation=true
+fsharp_alternative_long_member_definitions=true
+fsharp_multi_line_lambda_closing_newline=true
+fsharp_experimental_keep_indent_in_branch=true
+fsharp_max_value_binding_width=80
+fsharp_max_record_width=0
+max_line_length=120
+end_of_line=lf
+
+[*.{appxmanifest,build,dtd,nuspec,xaml,xamlx,xoml,xsd}]
+indent_style=space
+indent_size=2
+tab_width=2

WoofWorkflows/Pipeline.fs

@@ -2,17 +2,31 @@ namespace WoofWorkflows
 
 open System.IO
 
-type Stdout = Stdout of string Comp
+type Stdout = | Stdout of string Comp
 
-type PipelineModifier<'Agent> =
+type PipelineModifier =
     private
         {
             EnvVars : (string * string Comp) list
             // TODO: does this stack the right way? Does last win or first win?
             WorkingDir : DirectoryInfo Comp option
-            Agent : 'Agent
+            AgentModifier : string Comp option
+            Labels : string list
         }
+
     override this.ToString () =
+        let agent =
+            match this.AgentModifier with
+            | None -> "(same agent)"
+            | Some c -> "New agent with image: " + Comp.force c
+
+        let labels =
+            this.Labels
+            |> String.concat ", "
+            |> function
+                | "" -> ""
+                | s -> $"; Labels: %s{s}"
+
         let envVars =
             if this.EnvVars.IsEmpty then
                 ""
@@ -21,156 +35,160 @@ type PipelineModifier<'Agent> =
                 |> Seq.map (fun (k, v) -> k + ":" + Comp.force v)
                 |> String.concat ", "
                 |> fun s -> "; Env vars: " + s
+
         let workingDir =
             match this.WorkingDir with
             | None -> ""
             | Some dir -> "; Working dir: " + (Comp.force dir).FullName
-        let agent = this.Agent.ToString ()
 
-        agent + envVars + workingDir
+        agent + labels + envVars + workingDir
 
-
-type AgentIsSet =
+type Pipeline =
     private
-    | AgentIsSet of image : string Comp
-    override this.ToString () =
-        match this with
-        | AgentIsSet comp -> "Image: " + Comp.force comp
-
-type AgentUnset =
-    private | AgentUnset
-    override this.ToString () =
-        "<no image specified>"
-
-type Pipeline<'Agent> =
     | Empty
-    | ShellScript of script : string * andThen : Pipeline<'Agent>
-    | ShellScriptBind of script : string * consumeStdout : (Stdout -> Pipeline<'Agent>)
-    | WithModifier of Pipeline<'Agent> * PipelineModifier<'Agent>
-    | Sequence of first : Pipeline<AgentUnset> * second : Pipeline<'Agent>
-
-[<RequireQualifiedAccess>]
-module Pipeline =
-    let rec private toStringInner<'A> (bindCount : int) (indentCount : int) (this : Pipeline<'A>) : string =
-        let indent = String.replicate indentCount " "
-        match this with
-        | Pipeline.Empty -> $"%s{indent}<nothing>"
-        | Pipeline.ShellScript(script, andThen) -> $"%s{indent}Run: %s{script}\n%s{indent}Then\n%s{toStringInner bindCount (indentCount + 2) andThen}"
-        | Pipeline.ShellScriptBind(script, consumeStdout) ->
-            let outputDummy = $"<stdout-%i{bindCount}>"
-            let dummyPipeline = consumeStdout (Stdout (Comp.make outputDummy))
-            $"%s{indent}Run: %s{script}\n%s{indent}With its output labelled %s{outputDummy}:\n%s{toStringInner (bindCount + 1) (indentCount + 2) dummyPipeline}"
-        | Pipeline.WithModifier(pipeline, pipelineModifier) -> $"%s{indent}Modified pipeline (%O{pipelineModifier}):\n%s{toStringInner bindCount (indentCount + 2) pipeline}"
-        | Pipeline.Sequence(first, second) -> $"%s{toStringInner bindCount indentCount first}\n%s{toStringInner bindCount indentCount second}"
-
-    let toString (p : Pipeline<'A>) = toStringInner 0 0 p
+    | ShellScript of script : string * andThen : Pipeline
+    | ShellScriptBind of script : string * consumeStdout : (Stdout -> Pipeline)
+    | Sequence of previous : (Pipeline * PipelineModifier) list * final : Pipeline
 
 [<RequireQualifiedAccess>]
 module private PipelineModifier =
-    let empty : PipelineModifier<AgentUnset> =
+    let empty (newAgent : string Comp option) : PipelineModifier =
         {
             EnvVars = []
             WorkingDir = None
-            Agent = AgentUnset
+            AgentModifier = newAgent
+            Labels = []
+        }
+
+    let withEnv (key : string) (value : string Comp) (existing : PipelineModifier) =
+        { existing with
+            EnvVars = (key, value) :: existing.EnvVars
+        }
+
+    let replaceWorkingDir (newDir : DirectoryInfo Comp) (existing : PipelineModifier) =
+        { existing with
+            WorkingDir = Some newDir
+        }
+
+    let addLabel (label : string) (existing : PipelineModifier) =
+        { existing with
+            Labels = label :: existing.Labels
         }
 
 [<Sealed ; Class>]
-type PipelineBuilder<'plat, 'agentFinal> () =
+type PipelineBuilder (agent : string Comp option) =
+    let mutable modifier : PipelineModifier = PipelineModifier.empty agent
+
+    [<CustomOperation "labelled">]
+    member _.WithLabel (mods : PipelineModifier, label : string) : PipelineModifier =
+        { mods with
+            Labels = label :: mods.Labels
+        }
+
+    [<CustomOperation "labelled">]
+    member _.WithLabel (() : unit, label : string) : PipelineModifier =
+        { PipelineModifier.empty agent with
+            Labels = [ label ]
+        }
+
     [<CustomOperation "withEnv">]
-    member _.WithEnv
-        (mods : PipelineModifier<'Agent>, (key : string, value : string Comp))
-        : PipelineModifier<'Agent>
-        =
+    member _.WithEnv (mods : PipelineModifier, (key : string, value : string Comp)) : PipelineModifier =
         { mods with
             EnvVars = (key, value) :: mods.EnvVars
         }
 
     [<CustomOperation "withEnv">]
-    member _.WithEnv
-        (() : unit, (key : string, value : string Comp))
-        : PipelineModifier<AgentUnset>
-        =
-        { PipelineModifier.empty with
-            EnvVars = [key, value]
+    member _.WithEnv (() : unit, (key : string, value : string Comp)) : PipelineModifier =
+        { PipelineModifier.empty agent with
+            EnvVars = [ key, value ]
         }
 
     [<CustomOperation "workingDir">]
-    member _.WorkingDir
-        (mods : PipelineModifier<'Agent>, dir : DirectoryInfo Comp)
-        : PipelineModifier<'Agent>
-        =
+    member _.WorkingDir (mods : PipelineModifier, dir : DirectoryInfo Comp) : PipelineModifier =
         { mods with
             WorkingDir = Some dir
         }
 
     [<CustomOperation "workingDir">]
-    member _.WorkingDir
-        (() : unit, dir : DirectoryInfo Comp)
-        : PipelineModifier<AgentUnset>
-        =
-        { PipelineModifier.empty with
+    member _.WorkingDir (() : unit, dir : DirectoryInfo Comp) : PipelineModifier =
+        { PipelineModifier.empty agent with
             WorkingDir = Some dir
         }
 
-    [<CustomOperation "remote">]
-    member _.Remote
-        (() : unit, image : string Comp)
-        : PipelineModifier<AgentIsSet>
-        =
-        {
-            EnvVars = []
-            WorkingDir = None
-            Agent = AgentIsSet image
-        }
-
-    [<CustomOperation "remote">]
-    member _.Remote
-        (mods : PipelineModifier<AgentUnset>, image : string Comp)
-        : PipelineModifier<AgentIsSet>
-        =
-        {
-            EnvVars = mods.EnvVars
-            WorkingDir = mods.WorkingDir
-            Agent = AgentIsSet image
-        }
-
-    member _.Return (() : unit) = Pipeline.Empty
+    member _.Return (() : unit) : Pipeline = Pipeline.Empty
 
     /// For running a script, capturing stdout
-    member _.Bind (toRun : string, cont : Stdout -> Pipeline<'Agent>) : Pipeline<'Agent> =
-        Pipeline.ShellScriptBind (toRun, cont)
+    member _.Bind (toRun : string, cont : Stdout -> Pipeline) : Pipeline =
+        let go stdout =
+            let subsequent = cont stdout
+            subsequent
+
+        Pipeline.ShellScriptBind (toRun, go)
+
     /// For running a script, without capturing stdout
-    member _.Bind (toRun : string, cont : unit -> Pipeline<'Agent>) : Pipeline<'Agent> =
-        Pipeline.ShellScript (toRun, cont ())
-    /// We can bind any pipeline which doesn't say where it's going to run; the interpretation is that it'll
-    /// run wherever the parent runs.
-    member _.Bind (p : Pipeline<AgentUnset>, cont : unit -> Pipeline<'Agent>) : Pipeline<'Agent> =
-        Pipeline.Sequence (p, cont ())
-    // TODO: we could allow binding in running on the same agent as the parent, interpreting that as "run on the parent",
-    // or binding in running on a different agent from the parent, interpreting that as "run in a new agent".
-    // Seems a bit magic.
-    member _.Yield (() : unit) : unit = ()
-    member _.For (expr : PipelineModifier<'Agent>, cont : unit -> Pipeline<'Agent>) : Pipeline<'Agent> =
-        Pipeline.WithModifier (cont (), expr)
+    member _.Bind (toRun : string, cont : unit -> Pipeline) : Pipeline =
+        // Things later in the pipeline can't alter the modifiers that were specified earlier in the pipeline,
+        // so throw those modifications away.
+        let subsequent = cont ()
+        Pipeline.ShellScript (toRun, subsequent)
+
+    /// Bind in another pipeline, perhaps on a different agent
+    member _.Bind (p : Pipeline * PipelineModifier, cont : unit -> Pipeline) : Pipeline =
+        Pipeline.Sequence ([ p ], cont ())
+
+    member _.Yield (x : unit) : unit = ()
+
+    member _.For (expr : PipelineModifier, cont : unit -> Pipeline) : Pipeline =
+        modifier <- expr
+        let pipeline = cont ()
+        pipeline
+
+    member _.Run x = x, modifier
+
+[<RequireQualifiedAccess>]
+module Pipeline =
+    let rec private toStringInner (bindCount : int) (indentCount : int) (this : Pipeline) : string =
+        let indent = String.replicate indentCount " "
+
+        match this with
+        | Pipeline.Empty -> $"%s{indent}<nothing>"
+        | Pipeline.ShellScript (script, andThen) ->
+            $"%s{indent}Run: %s{script}\n%s{indent}Then\n%s{toStringInner bindCount (indentCount + 2) andThen}"
+        | Pipeline.ShellScriptBind (script, consumeStdout) ->
+            let outputDummy = $"<stdout-%i{bindCount}>"
+            let dummyPipeline = consumeStdout (Stdout (Comp.make outputDummy))
+            $"%s{indent}Run: %s{script}\n%s{indent}With its output labelled %s{outputDummy}:\n%s{toStringInner (bindCount + 1) (indentCount + 2) dummyPipeline}"
+        | Pipeline.Sequence (previous, second) ->
+            let previous =
+                previous
+                |> List.map (fun (previous, modifier) ->
+                    let firstMod = $"%s{indent}  %O{modifier}\n"
+                    let first = $"%s{toStringInner bindCount (indentCount + 2) previous}"
+                    $"%s{firstMod}%s{first}"
+                )
+                |> String.concat $"\n%s{indent}-----\n"
+
+            let second = $"%s{toStringInner bindCount (indentCount + 2) second}"
+            $"%s{previous}%s{indent}----\n%s{second}"
+
+    let toString (p : Pipeline) = toStringInner 0 0 p
+
+    let empty = Pipeline.Empty
+
+    let prependShellScript script andThen = Pipeline.ShellScript (script, andThen)
+
+    let concat (prevStages : (Pipeline * PipelineModifier) list) (final : Pipeline) =
+        Pipeline.Sequence (prevStages, final)
+
+    let bindShellScript script andThen =
+        Pipeline.ShellScriptBind (script, andThen)
+
+    let toStepDag (p : Pipeline, modifier : PipelineModifier) : SealedStepDag<unit, unit> =
+        match modifier.AgentModifier with
+        | None -> failwith "Pipeline must run on an agent, but no agent was specified"
+        | Some _ -> failwith $"TODO\n%O{modifier}\n%s{toString p}"
 
 [<AutoOpen>]
 module PipelineBuilder =
-    let pipeline<'plat, 'agent> = PipelineBuilder<'plat, 'agent> ()
-    let toStepDag<'Agent> (p : Pipeline<'Agent>) : SealedStepDag<unit, unit> = failwith $"TODO\n%s{Pipeline.toString p}"
-
-    let foo () : SealedStepDag<unit, unit> =
-        pipeline {
-            remote (Comp.make "some-image")
-            withEnv ("hi", Comp.make "bye")
-            workingDir (Comp.make (DirectoryInfo "code root here"))
-            withEnv ("foo", Comp.make "bar")
-            let! (Stdout stdout) = "sh script here"
-            do! pipeline {
-                withEnv ("foo", stdout)
-                do! "git config --foo"
-                return ()
-            }
-            do! "a shell script"
-            return ()
-        }
-        |> toStepDag
+    let pipeline (agent : string Comp) = PipelineBuilder (Some agent)
+    let pipelineSameAgent = PipelineBuilder None

WoofWorkflows/Program.fs

@@ -1,8 +1,70 @@
 namespace WoofWorkflows
 
+open System.IO
+
 module Program =
+    let foo () =
+        pipeline (Comp.make "some-image") {
+            workingDir (Comp.make (DirectoryInfo "code root here"))
+            labelled "label 1"
+            withEnv ("foo", Comp.make "bar")
+            withEnv ("hi", Comp.make "bye")
+            let! (Stdout stdout) = "sh script here"
+
+            do!
+                pipelineSameAgent {
+                    withEnv ("foo", stdout)
+                    do! "git config --foo"
+                    return ()
+                }
+
+            do!
+                pipeline (Comp.make "another-image") {
+                    labelled "label 2"
+                    let! (Stdout stdout) = "maybe run a formatter"
+                    return ()
+                }
+
+            do! "a shell script"
+            let! (Stdout stdout) = "another shell script"
+            return ()
+        }
+
+    let foo2 () =
+        let pl =
+            Pipeline.bindShellScript
+                "sh script here"
+                (fun (Stdout stdout) ->
+                    Pipeline.concat
+                        [
+                            let modifier = PipelineModifier.empty None |> PipelineModifier.withEnv "foo" stdout
+                            let pl = Pipeline.empty |> Pipeline.prependShellScript "git config --foo"
+                            yield pl, modifier
+
+                            let modifier =
+                                PipelineModifier.empty (Some (Comp.make "another-image"))
+                                |> PipelineModifier.addLabel "label 2"
+
+                            let pl = Pipeline.bindShellScript "maybe run a formatter" (fun _ -> Pipeline.empty)
+                            yield pl, modifier
+
+                            let modifier = PipelineModifier.empty None
+                            let pl = Pipeline.prependShellScript "a shell script" Pipeline.empty
+                            yield pl, modifier
+                        ]
+                        (Pipeline.bindShellScript "another shell script" (fun (Stdout stdout) -> Pipeline.empty))
+                )
+
+        let modifier =
+            PipelineModifier.empty (Some (Comp.make "some-image"))
+            |> PipelineModifier.replaceWorkingDir (Comp.make (DirectoryInfo "code root here"))
+            |> PipelineModifier.addLabel "label 1"
+            |> PipelineModifier.withEnv "foo" (Comp.make "bar")
+            |> PipelineModifier.withEnv "hi" (Comp.make "bye")
+
+        pl, modifier
+
     [<EntryPoint>]
     let main argv =
-        PipelineBuilder.foo ()
-        |> ignore
-        0
+        foo2 () |> Pipeline.toStepDag |> ignore
+        0

WoofWorkflows/StepDag.fs

@@ -5,13 +5,12 @@ type SealedStepDag<'a, 'plat> = private | SealedStepDag
 
 type Step<'a> = private | Step
 
-type Comp<'a> =
-    private
-    | Thunk of (unit -> 'a)
+type Comp<'a> = private | Thunk of (unit -> 'a)
 
 [<RequireQualifiedAccess>]
 module Comp =
     let make (x : 'a) : Comp<'a> = Thunk (fun () -> x)
+
     let force (x : 'a Comp) =
         match x with
         | Thunk x -> x ()
@@ -20,7 +19,5 @@ module Comp =
 module StepDag =
 
     let empty<'a, 'plat> (v : 'a) : StepDag<'a, 'plat> = StepDag
-    let addStep (name : string) (step : 'a Step) (cont : 'a -> StepDag<'b, 'plat>) : StepDag<'b, 'plat> =
-        failwith ""
+    let addStep (name : string) (step : 'a Step) (cont : 'a -> StepDag<'b, 'plat>) : StepDag<'b, 'plat> = failwith ""
     let seal<'a, 'plat> (s : StepDag<'a, 'plat>) : SealedStepDag<'a, 'plat> = SealedStepDag
-

WoofWorkflows/WoofWorkflows.fsproj

@@ -3,6 +3,8 @@
     <PropertyGroup>
         <OutputType>Exe</OutputType>
         <TargetFramework>net8.0</TargetFramework>
+        <TreatWarningsAsErrors>true</TreatWarningsAsErrors>
+        <WarnOn>FS3559</WarnOn>
     </PropertyGroup>
 
     <ItemGroup>