diff --git a/WoofWorkflows/Pipeline.fs b/WoofWorkflows/Pipeline.fs index d7ec896..bc83b61 100644 --- a/WoofWorkflows/Pipeline.fs +++ b/WoofWorkflows/Pipeline.fs @@ -2,7 +2,7 @@ namespace WoofWorkflows open System.IO -type Stdout = Stdout of string Comp +type Stdout = | Stdout of string Comp type PipelineModifier = private @@ -13,17 +13,19 @@ type PipelineModifier = 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 + | Some c -> "New agent with image: " + Comp.force c let labels = this.Labels |> String.concat ", " - |> function | "" -> "" | s -> $"; Labels: %s{s}" + |> function + | "" -> "" + | s -> $"; Labels: %s{s}" let envVars = if this.EnvVars.IsEmpty then @@ -33,6 +35,7 @@ type PipelineModifier = |> Seq.map (fun (k, v) -> k + ":" + Comp.force v) |> String.concat ", " |> fun s -> "; Env vars: " + s + let workingDir = match this.WorkingDir with | None -> "" @@ -63,113 +66,99 @@ module private PipelineModifier = } let replaceWorkingDir (newDir : DirectoryInfo Comp) (existing : PipelineModifier) = - { existing with WorkingDir = Some newDir } + { existing with + WorkingDir = Some newDir + } let addLabel (label : string) (existing : PipelineModifier) = - { existing with Labels = label :: existing.Labels } + { existing with + Labels = label :: existing.Labels + } [] type PipelineBuilder (agent : string Comp option) = - let mutable modifier : PipelineModifier = - PipelineModifier.empty agent + let mutable modifier : PipelineModifier = PipelineModifier.empty agent [] - member _.WithLabel - (mods : PipelineModifier, label : string) - : PipelineModifier - = + member _.WithLabel (mods : PipelineModifier, label : string) : PipelineModifier = { mods with Labels = label :: mods.Labels } [] - member _.WithLabel - (() : unit, label : string) - : PipelineModifier - = + member _.WithLabel (() : unit, label : string) : PipelineModifier = { PipelineModifier.empty agent with - Labels = [label] + Labels = [ label ] } [] - member _.WithEnv - (mods : PipelineModifier, (key : string, value : string Comp)) - : PipelineModifier - = + member _.WithEnv (mods : PipelineModifier, (key : string, value : string Comp)) : PipelineModifier = { mods with EnvVars = (key, value) :: mods.EnvVars } [] - member _.WithEnv - (() : unit, (key : string, value : string Comp)) - : PipelineModifier - = + member _.WithEnv (() : unit, (key : string, value : string Comp)) : PipelineModifier = { PipelineModifier.empty agent with - EnvVars = [key, value] + EnvVars = [ key, value ] } [] - member _.WorkingDir - (mods : PipelineModifier, dir : DirectoryInfo Comp) - : PipelineModifier - = + member _.WorkingDir (mods : PipelineModifier, dir : DirectoryInfo Comp) : PipelineModifier = { mods with WorkingDir = Some dir } [] - member _.WorkingDir - (() : unit, dir : DirectoryInfo Comp) - : PipelineModifier - = + member _.WorkingDir (() : unit, dir : DirectoryInfo Comp) : PipelineModifier = { PipelineModifier.empty agent with WorkingDir = Some dir } - member _.Return (() : unit) : Pipeline = - Pipeline.Empty + member _.Return (() : unit) : Pipeline = Pipeline.Empty /// For running a script, capturing stdout 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) : 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 ()) + Pipeline.Sequence ([ p ], cont ()) + member _.Yield (x : unit) : unit = () - member _.For - (expr : PipelineModifier, cont : unit -> Pipeline) - : Pipeline - = + + member _.For (expr : PipelineModifier, cont : unit -> Pipeline) : Pipeline = modifier <- expr let pipeline = cont () pipeline - member _.Run x = - x, modifier + member _.Run x = x, modifier [] 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}" - | Pipeline.ShellScript(script, 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) -> + | 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.Sequence(previous, second) -> + | Pipeline.Sequence (previous, second) -> let previous = previous |> List.map (fun (previous, modifier) -> @@ -178,6 +167,7 @@ module Pipeline = $"%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}" @@ -185,8 +175,7 @@ module Pipeline = let empty = Pipeline.Empty - let prependShellScript script andThen = - Pipeline.ShellScript (script, andThen) + let prependShellScript script andThen = Pipeline.ShellScript (script, andThen) let concat (prevStages : (Pipeline * PipelineModifier) list) (final : Pipeline) = Pipeline.Sequence (prevStages, final) @@ -197,8 +186,7 @@ module Pipeline = let toStepDag (p : Pipeline, modifier : PipelineModifier) : SealedStepDag = 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}" + | Some _ -> failwith $"TODO\n%O{modifier}\n%s{toString p}" [] module PipelineBuilder = diff --git a/WoofWorkflows/Program.fs b/WoofWorkflows/Program.fs index 7f8fd22..1fe7c22 100644 --- a/WoofWorkflows/Program.fs +++ b/WoofWorkflows/Program.fs @@ -10,16 +10,21 @@ module Program = 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! + 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 () @@ -27,25 +32,29 @@ module Program = 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 + 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 (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 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")) @@ -57,7 +66,5 @@ module Program = [] let main argv = - foo2 () - |> Pipeline.toStepDag - |> ignore - 0 \ No newline at end of file + foo2 () |> Pipeline.toStepDag |> ignore + 0 diff --git a/WoofWorkflows/StepDag.fs b/WoofWorkflows/StepDag.fs index bb21fe0..2a86c99 100644 --- a/WoofWorkflows/StepDag.fs +++ b/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) [] 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 -