Type safe

WoofWorkflows/Pipeline.fs

@@ -4,88 +4,166 @@ open System.IO
 
 type Stdout = Stdout of string Comp
 
-type PipelineModifier =
+type PipelineModifier<'Agent> =
     private
-    | WithEnv of key : string * value : string Comp
+        {
-    | WorkingDir of dir : DirectoryInfo Comp
+            EnvVars : (string * string Comp) list
-    | Remote of image : string Comp
+            // TODO: does this stack the right way? Does last win or first win?
+            WorkingDir : DirectoryInfo Comp option
+            Agent : 'Agent
+        }
+    override this.ToString () =
+        let envVars =
+            if this.EnvVars.IsEmpty then
+                ""
+            else
+                this.EnvVars
+                |> 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 ()
 
-type Pipeline =
+        agent + envVars + workingDir
+
+
+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
+    | ShellScript of script : string * andThen : Pipeline<'Agent>
-    | ShellScriptBind of script : string * consumeStdout : (Stdout -> Pipeline)
+    | ShellScriptBind of script : string * consumeStdout : (Stdout -> Pipeline<'Agent>)
-    | WithModifier of Pipeline * PipelineModifier list
+    | WithModifier of Pipeline<'Agent> * PipelineModifier<'Agent>
-    | Sequence of first : Pipeline * 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 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
+
+[<RequireQualifiedAccess>]
+module private PipelineModifier =
+    let empty : PipelineModifier<AgentUnset> =
+        {
+            EnvVars = []
+            WorkingDir = None
+            Agent = AgentUnset
+        }
 
 [<Sealed ; Class>]
-type Pipeline<'plat> () =
+type PipelineBuilder<'plat, 'agentFinal> () =
     [<CustomOperation "withEnv">]
     member _.WithEnv
-        (mods : PipelineModifier list, (key : string, value : string Comp))
+        (mods : PipelineModifier<'Agent>, (key : string, value : string Comp))
-        : PipelineModifier list
+        : PipelineModifier<'Agent>
         =
-        PipelineModifier.WithEnv (key, value) :: mods
+        { mods with
+            EnvVars = (key, value) :: mods.EnvVars
+        }
 
     [<CustomOperation "withEnv">]
     member _.WithEnv
         (() : unit, (key : string, value : string Comp))
-        : PipelineModifier list
+        : PipelineModifier<AgentUnset>
         =
-        [PipelineModifier.WithEnv (key, value)]
+        { PipelineModifier.empty with
+            EnvVars = [key, value]
+        }
 
     [<CustomOperation "workingDir">]
     member _.WorkingDir
-        (mods : PipelineModifier list, (dir : DirectoryInfo Comp))
+        (mods : PipelineModifier<'Agent>, dir : DirectoryInfo Comp)
-        : PipelineModifier list
+        : PipelineModifier<'Agent>
         =
-        PipelineModifier.WorkingDir dir :: mods
+        { mods with
+            WorkingDir = Some dir
+        }
 
     [<CustomOperation "workingDir">]
     member _.WorkingDir
         (() : unit, dir : DirectoryInfo Comp)
-        : PipelineModifier list
+        : PipelineModifier<AgentUnset>
         =
-        [PipelineModifier.WorkingDir dir]
+        { PipelineModifier.empty with
+            WorkingDir = Some dir
+        }
 
     [<CustomOperation "remote">]
     member _.Remote
         (() : unit, image : string Comp)
-        : PipelineModifier list
+        : PipelineModifier<AgentIsSet>
         =
-        [PipelineModifier.Remote image]
+        {
+            EnvVars = []
+            WorkingDir = None
+            Agent = AgentIsSet image
+        }
 
     [<CustomOperation "remote">]
     member _.Remote
-        (mods : PipelineModifier list, image : string Comp)
+        (mods : PipelineModifier<AgentUnset>, image : string Comp)
-        : PipelineModifier list
+        : PipelineModifier<AgentIsSet>
         =
-        PipelineModifier.Remote image :: mods
+        {
+            EnvVars = mods.EnvVars
+            WorkingDir = mods.WorkingDir
+            Agent = AgentIsSet image
+        }
 
     member _.Return (() : unit) = Pipeline.Empty
 
     /// For running a script, capturing stdout
-    member _.Bind<'b> (toRun : string, cont : Stdout -> Pipeline) : Pipeline =
+    member _.Bind (toRun : string, cont : Stdout -> Pipeline<'Agent>) : Pipeline<'Agent> =
         Pipeline.ShellScriptBind (toRun, cont)
     /// For running a script, without capturing stdout
-    member _.Bind (toRun : string, cont : unit -> Pipeline) : Pipeline =
+    member _.Bind (toRun : string, cont : unit -> Pipeline<'Agent>) : Pipeline<'Agent> =
         Pipeline.ShellScript (toRun, cont ())
-    member _.Bind (p : Pipeline, cont : unit -> Pipeline) : Pipeline =
+    /// 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 list, cont : unit -> Pipeline) : Pipeline =
+    member _.For (expr : PipelineModifier<'Agent>, cont : unit -> Pipeline<'Agent>) : Pipeline<'Agent> =
         Pipeline.WithModifier (cont (), expr)
 
 [<AutoOpen>]
-module Pipeline =
+module PipelineBuilder =
-    let pipeline<'plat> = Pipeline<'plat> ()
+    let pipeline<'plat, 'agent> = PipelineBuilder<'plat, 'agent> ()
-    let toStepDag (p : Pipeline) : SealedStepDag<unit, unit> = failwith "TODO"
+    let toStepDag<'Agent> (p : Pipeline<'Agent>) : SealedStepDag<unit, unit> = failwith $"TODO\n%s{Pipeline.toString p}"
 
-    let foo : SealedStepDag<unit, unit> =
+    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")
-            remote (Comp.make "some-image")
             let! (Stdout stdout) = "sh script here"
             do! pipeline {
                 withEnv ("foo", stdout)
@@ -96,23 +174,3 @@ module Pipeline =
             return ()
         }
         |> toStepDag
-
-        (*
-         declarative.Bind<object, a, SealedStepDag<a, Unit>>(
-            declarative.RunShell<object, string, string>(
-                declarative.Bind<StepDag<object, Unit>, object, string>(
-                  "sh script here",
-                  (FSharpFunc<StepDag<object, Unit>, SealedStepDag<object, Unit>>) declarative.Return
-                ),
-                (FSharpFunc<object, string>) (fun _ -> "a shell script")
-            ),
-            (FSharpFunc<object, SealedStepDag<a, Unit>>) (fun _ ->
-                string message = "hi";
-                if (true)
-                  throw Operators.Failure(message);
-                StepDag<a, Unit> sd = (StepDag<a, Unit>) null;
-                return declarative.Return<a>(sd);
-            )
-         );
-        *)
-

WoofWorkflows/Program.fs

@@ -3,6 +3,6 @@
 module Program =
     [<EntryPoint>]
     let main argv =
-        Pipeline.foo
+        PipelineBuilder.foo ()
         |> ignore
         0

WoofWorkflows/StepDag.fs

@@ -5,11 +5,16 @@ type SealedStepDag<'a, 'plat> = private | SealedStepDag
 
 type Step<'a> = private | Step
 
-type Comp<'a> = private | Comp of (unit -> 'a)
+type Comp<'a> =
+    private
+    | Thunk of (unit -> 'a)
 
 [<RequireQualifiedAccess>]
 module Comp =
-    let make (x : 'a) : Comp<'a> = Comp (fun () -> x)
+    let make (x : 'a) : Comp<'a> = Thunk (fun () -> x)
+    let force (x : 'a Comp) =
+        match x with
+        | Thunk x -> x ()
 
 [<RequireQualifiedAccess>]
 module StepDag =