How about going without weird typars

WoofWorkflows/Pipeline.fs

@@ -4,15 +4,21 @@ open System.IO
 
 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
         }
     override this.ToString () =
+        let agent =
+            match this.AgentModifier with
+            | None -> "(same agent)"
+            | Some c ->
+                "New agent with image: " + Comp.force c
+
         let envVars =
             if this.EnvVars.IsEmpty then
                 ""
@@ -25,61 +31,57 @@ type PipelineModifier<'Agent> =
             match this.WorkingDir with
             | None -> ""
             | Some dir -> "; Working dir: " + (Comp.force dir).FullName
-        let agent = this.Agent.ToString ()
 
         agent + envVars + workingDir
 
-
+type Pipeline =
-type AgentIsSet =
-    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>
+    | ShellScript of script : string * andThen : (Pipeline)
-    | ShellScriptBind of script : string * consumeStdout : (Stdout -> Pipeline<'Agent>)
+    | ShellScriptBind of script : string * consumeStdout : (Stdout -> Pipeline)
-    | WithModifier of Pipeline<'Agent> * PipelineModifier<'Agent>
+    | Sequence of first : (Pipeline * PipelineModifier option) * second : (Pipeline)
-    | 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 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.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, modifier), second) ->
-        | Pipeline.Sequence(first, second) -> $"%s{toStringInner bindCount indentCount first}\n%s{toStringInner bindCount indentCount second}"
+            let firstMod =
+                match modifier with
+                | None -> ""
+                | Some modifier ->
+                    $"%O{modifier}"
+            let first = $"%s{toStringInner bindCount (indentCount + 2) first}"
+            let second = $"%s{toStringInner bindCount (indentCount + 2) second}"
+            $"%s{indent}  {firstMod}\n%s{first}\n%s{indent}----\n%s{second}"
 
-    let toString (p : Pipeline<'A>) = toStringInner 0 0 p
+    let toString (p : Pipeline) = toStringInner 0 0 p
 
 [<RequireQualifiedAccess>]
 module private PipelineModifier =
-    let empty : PipelineModifier<AgentUnset> =
+    let empty (agent : string Comp option) : PipelineModifier =
         {
             EnvVars = []
             WorkingDir = None
-            Agent = AgentUnset
+            AgentModifier = agent
         }
 
 [<Sealed ; Class>]
-type PipelineBuilder<'plat, 'agentFinal> () =
+type PipelineBuilder (agent : string Comp option) =
+    let mutable modifier : PipelineModifier =
+        PipelineModifier.empty agent
+
     [<CustomOperation "withEnv">]
     member _.WithEnv
-        (mods : PipelineModifier<'Agent>, (key : string, value : string Comp))
+        (mods : PipelineModifier, (key : string, value : string Comp))
-        : PipelineModifier<'Agent>
+        : PipelineModifier
         =
         { mods with
             EnvVars = (key, value) :: mods.EnvVars
@@ -88,16 +90,16 @@ type PipelineBuilder<'plat, 'agentFinal> () =
     [<CustomOperation "withEnv">]
     member _.WithEnv
         (() : unit, (key : string, value : string Comp))
-        : PipelineModifier<AgentUnset>
+        : PipelineModifier
         =
-        { PipelineModifier.empty with
+        { PipelineModifier.empty agent with
             EnvVars = [key, value]
         }
 
     [<CustomOperation "workingDir">]
     member _.WorkingDir
-        (mods : PipelineModifier<'Agent>, dir : DirectoryInfo Comp)
+        (mods : PipelineModifier, dir : DirectoryInfo Comp)
-        : PipelineModifier<'Agent>
+        : PipelineModifier
         =
         { mods with
             WorkingDir = Some dir
@@ -106,71 +108,68 @@ type PipelineBuilder<'plat, 'agentFinal> () =
     [<CustomOperation "workingDir">]
     member _.WorkingDir
         (() : unit, dir : DirectoryInfo Comp)
-        : PipelineModifier<AgentUnset>
+        : PipelineModifier
         =
-        { PipelineModifier.empty with
+        { PipelineModifier.empty agent with
             WorkingDir = Some dir
         }
 
-    [<CustomOperation "remote">]
+    member _.Return (() : unit) : Pipeline =
-    member _.Remote
+        Pipeline.Empty
-        (() : 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
 
     /// For running a script, capturing stdout
-    member _.Bind (toRun : string, cont : Stdout -> Pipeline<'Agent>) : Pipeline<'Agent> =
+    member _.Bind (toRun : string, cont : Stdout -> Pipeline) : Pipeline =
-        Pipeline.ShellScriptBind (toRun, cont)
+        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> =
+    member _.Bind (toRun : string, cont : unit -> Pipeline) : Pipeline =
-        Pipeline.ShellScript (toRun, cont ())
+        // Things later in the pipeline can't alter the modifiers that were specified earlier in the pipeline,
-    /// We can bind any pipeline which doesn't say where it's going to run; the interpretation is that it'll
+        // so throw those modifications away.
-    /// run wherever the parent runs.
+        let subsequent = cont ()
-    member _.Bind (p : Pipeline<AgentUnset>, cont : unit -> Pipeline<'Agent>) : Pipeline<'Agent> =
+        Pipeline.ShellScript (toRun, subsequent)
+    /// Bind in another pipeline, perhaps on a different agent
+    member _.Bind (p : Pipeline * PipelineModifier option, cont : unit -> Pipeline) : Pipeline =
         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",
+    member _.Yield (x : unit) : unit = ()
-    // or binding in running on a different agent from the parent, interpreting that as "run in a new agent".
+    member _.For
-    // Seems a bit magic.
+        (expr : PipelineModifier, cont : unit -> Pipeline)
-    member _.Yield (() : unit) : unit = ()
+        : Pipeline
-    member _.For (expr : PipelineModifier<'Agent>, cont : unit -> Pipeline<'Agent>) : Pipeline<'Agent> =
+        =
-        Pipeline.WithModifier (cont (), expr)
+        modifier <- expr
+        let pipeline = cont ()
+        pipeline
+
+    member _.Run x = x, Some modifier
 
 [<AutoOpen>]
 module PipelineBuilder =
-    let pipeline<'plat, 'agent> = PipelineBuilder<'plat, 'agent> ()
+    let pipeline (agent : string Comp) = PipelineBuilder (Some agent)
-    let toStepDag<'Agent> (p : Pipeline<'Agent>) : SealedStepDag<unit, unit> = failwith $"TODO\n%s{Pipeline.toString p}"
+    let pipelineSameAgent = PipelineBuilder None
+    let toStepDag (p : Pipeline, modifier : PipelineModifier option) : SealedStepDag<unit, unit> =
+        match modifier with
+        | None -> failwith "Pipeline must run on an agent, but no agent was specified"
+        | Some modifier ->
+        failwith $"TODO\n%O{modifier}\n%s{Pipeline.toString p}"
 
     let foo () : SealedStepDag<unit, unit> =
-        pipeline {
+        pipeline (Comp.make "some-image") {
-            remote (Comp.make "some-image")
-            withEnv ("hi", Comp.make "bye")
             workingDir (Comp.make (DirectoryInfo "code root here"))
             withEnv ("foo", Comp.make "bar")
+            withEnv ("hi", Comp.make "bye")
             let! (Stdout stdout) = "sh script here"
-            do! pipeline {
+            do! pipelineSameAgent {
                 withEnv ("foo", stdout)
                 do! "git config --foo"
                 return ()
             }
+            do! pipeline (Comp.make "another-image") {
+                let! (Stdout stdout) = "maybe run a formatter"
+                return ()
+            }
             do! "a shell script"
+            let! (Stdout stdout) = "another shell script"
             return ()
         }
         |> toStepDag

WoofWorkflows/WoofWorkflows.fsproj

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