diff --git a/WoofWorkflows/Pipeline.fs b/WoofWorkflows/Pipeline.fs index 38d6645..b1cd0f8 100644 --- a/WoofWorkflows/Pipeline.fs +++ b/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 - | Remote of image : string Comp + { + EnvVars : (string * string Comp) list + // 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 () = + "" + +type Pipeline<'Agent> = | Empty - | ShellScript of script : string * andThen : Pipeline - | ShellScriptBind of script : string * consumeStdout : (Stdout -> Pipeline) - | WithModifier of Pipeline * PipelineModifier list - | Sequence of first : Pipeline * second : Pipeline + | 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 * second : Pipeline<'Agent> + +[] +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}" + | 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 = $"" + 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 + +[] +module private PipelineModifier = + let empty : PipelineModifier = + { + EnvVars = [] + WorkingDir = None + Agent = AgentUnset + } [] -type Pipeline<'plat> () = +type PipelineBuilder<'plat, 'agentFinal> () = [] member _.WithEnv - (mods : PipelineModifier list, (key : string, value : string Comp)) - : PipelineModifier list + (mods : PipelineModifier<'Agent>, (key : string, value : string Comp)) + : PipelineModifier<'Agent> = - PipelineModifier.WithEnv (key, value) :: mods + { mods with + EnvVars = (key, value) :: mods.EnvVars + } [] member _.WithEnv (() : unit, (key : string, value : string Comp)) - : PipelineModifier list + : PipelineModifier = - [PipelineModifier.WithEnv (key, value)] + { PipelineModifier.empty with + EnvVars = [key, value] + } [] member _.WorkingDir - (mods : PipelineModifier list, (dir : DirectoryInfo Comp)) - : PipelineModifier list + (mods : PipelineModifier<'Agent>, dir : DirectoryInfo Comp) + : PipelineModifier<'Agent> = - PipelineModifier.WorkingDir dir :: mods + { mods with + WorkingDir = Some dir + } [] member _.WorkingDir (() : unit, dir : DirectoryInfo Comp) - : PipelineModifier list + : PipelineModifier = - [PipelineModifier.WorkingDir dir] + { PipelineModifier.empty with + WorkingDir = Some dir + } [] member _.Remote (() : unit, image : string Comp) - : PipelineModifier list + : PipelineModifier = - [PipelineModifier.Remote image] + { + EnvVars = [] + WorkingDir = None + Agent = AgentIsSet image + } [] member _.Remote - (mods : PipelineModifier list, image : string Comp) - : PipelineModifier list + (mods : PipelineModifier, image : string Comp) + : PipelineModifier = - 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, 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) [] -module Pipeline = - let pipeline<'plat> = Pipeline<'plat> () - let toStepDag (p : Pipeline) : SealedStepDag = failwith "TODO" +module PipelineBuilder = + let pipeline<'plat, 'agent> = PipelineBuilder<'plat, 'agent> () + let toStepDag<'Agent> (p : Pipeline<'Agent>) : SealedStepDag = failwith $"TODO\n%s{Pipeline.toString p}" - let foo : SealedStepDag = + let foo () : SealedStepDag = 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>( - declarative.RunShell( - declarative.Bind, object, string>( - "sh script here", - (FSharpFunc, SealedStepDag>) declarative.Return - ), - (FSharpFunc) (fun _ -> "a shell script") - ), - (FSharpFunc>) (fun _ -> - string message = "hi"; - if (true) - throw Operators.Failure(message); - StepDag sd = (StepDag) null; - return declarative.Return(sd); - ) - ); - *) - diff --git a/WoofWorkflows/Program.fs b/WoofWorkflows/Program.fs index 1cfb3c7..bad5f5f 100644 --- a/WoofWorkflows/Program.fs +++ b/WoofWorkflows/Program.fs @@ -3,6 +3,6 @@ module Program = [] let main argv = - Pipeline.foo + PipelineBuilder.foo () |> ignore 0 \ No newline at end of file diff --git a/WoofWorkflows/StepDag.fs b/WoofWorkflows/StepDag.fs index 8af78fe..bb21fe0 100644 --- a/WoofWorkflows/StepDag.fs +++ b/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) [] 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 () [] module StepDag =