patrick/woofworkflows-poc
1
0
Fork 0
Code Issues Pull Requests 2 Packages Releases Activity

Format

Browse Source
This commit is contained in:
Smaug123
2023-12-22 12:38:35 +00:00
parent 7bbb0cbdef
commit 00a360a2dc
3 changed files with 79 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files

88
WoofWorkflows/Pipeline.fs
View File

@@ -2,7 +2,7 @@ namespace WoofWorkflows
open System.IO open System.IO
type Stdout = Stdout of string Comp type Stdout = | Stdout of string Comp
type PipelineModifier = type PipelineModifier =
private private
@@ -13,17 +13,19 @@ type PipelineModifier =
AgentModifier : string Comp option AgentModifier : string Comp option
Labels : string list Labels : string list
} }
override this.ToString () = override this.ToString () =
let agent = let agent =
match this.AgentModifier with match this.AgentModifier with
| None -> "(same agent)" | None -> "(same agent)"
| Some c -> | Some c -> "New agent with image: " + Comp.force c
"New agent with image: " + Comp.force c
let labels = let labels =
this.Labels this.Labels
|> String.concat ", " |> String.concat ", "
|> function | "" -> "" | s -> $"; Labels: %s{s}" |> function
| "" -> ""
| s -> $"; Labels: %s{s}"
let envVars = let envVars =
if this.EnvVars.IsEmpty then if this.EnvVars.IsEmpty then
@@ -33,6 +35,7 @@ type PipelineModifier =
|> Seq.map (fun (k, v) -> k + ":" + Comp.force v) |> Seq.map (fun (k, v) -> k + ":" + Comp.force v)
|> String.concat ", " |> String.concat ", "
|> fun s -> "; Env vars: " + s |> fun s -> "; Env vars: " + s
let workingDir = let workingDir =
match this.WorkingDir with match this.WorkingDir with
| None -> "" | None -> ""
@@ -63,113 +66,99 @@ module private PipelineModifier =
} }
let replaceWorkingDir (newDir : DirectoryInfo Comp) (existing : PipelineModifier) = let replaceWorkingDir (newDir : DirectoryInfo Comp) (existing : PipelineModifier) =
{ existing with WorkingDir = Some newDir } { existing with
WorkingDir = Some newDir
}
let addLabel (label : string) (existing : PipelineModifier) = let addLabel (label : string) (existing : PipelineModifier) =
{ existing with Labels = label :: existing.Labels } { existing with
Labels = label :: existing.Labels
}
[<Sealed ; Class>] [<Sealed ; Class>]
type PipelineBuilder (agent : string Comp option) = type PipelineBuilder (agent : string Comp option) =
let mutable modifier : PipelineModifier = let mutable modifier : PipelineModifier = PipelineModifier.empty agent
PipelineModifier.empty agent
[<CustomOperation "labelled">] [<CustomOperation "labelled">]
member _.WithLabel member _.WithLabel (mods : PipelineModifier, label : string) : PipelineModifier =
(mods : PipelineModifier, label : string)
: PipelineModifier
=
{ mods with { mods with
Labels = label :: mods.Labels Labels = label :: mods.Labels
} }
[<CustomOperation "labelled">] [<CustomOperation "labelled">]
member _.WithLabel member _.WithLabel (() : unit, label : string) : PipelineModifier =
(() : unit, label : string)
: PipelineModifier
=
{ PipelineModifier.empty agent with { PipelineModifier.empty agent with
Labels = [label] Labels = [ label ]
} }
[<CustomOperation "withEnv">] [<CustomOperation "withEnv">]
member _.WithEnv member _.WithEnv (mods : PipelineModifier, (key : string, value : string Comp)) : PipelineModifier =
(mods : PipelineModifier, (key : string, value : string Comp))
: PipelineModifier
=
{ mods with { mods with
EnvVars = (key, value) :: mods.EnvVars EnvVars = (key, value) :: mods.EnvVars
} }
[<CustomOperation "withEnv">] [<CustomOperation "withEnv">]
member _.WithEnv member _.WithEnv (() : unit, (key : string, value : string Comp)) : PipelineModifier =
(() : unit, (key : string, value : string Comp))
: PipelineModifier
=
{ PipelineModifier.empty agent with { PipelineModifier.empty agent with
EnvVars = [key, value] EnvVars = [ key, value ]
} }
[<CustomOperation "workingDir">] [<CustomOperation "workingDir">]
member _.WorkingDir member _.WorkingDir (mods : PipelineModifier, dir : DirectoryInfo Comp) : PipelineModifier =
(mods : PipelineModifier, dir : DirectoryInfo Comp)
: PipelineModifier
=
{ mods with { mods with
WorkingDir = Some dir WorkingDir = Some dir
} }
[<CustomOperation "workingDir">] [<CustomOperation "workingDir">]
member _.WorkingDir member _.WorkingDir (() : unit, dir : DirectoryInfo Comp) : PipelineModifier =
(() : unit, dir : DirectoryInfo Comp)
: PipelineModifier
=
{ PipelineModifier.empty agent with { PipelineModifier.empty agent with
WorkingDir = Some dir WorkingDir = Some dir
} }
member _.Return (() : unit) : Pipeline = member _.Return (() : unit) : Pipeline = Pipeline.Empty
Pipeline.Empty
/// For running a script, capturing stdout /// For running a script, capturing stdout
member _.Bind (toRun : string, cont : Stdout -> Pipeline) : Pipeline = member _.Bind (toRun : string, cont : Stdout -> Pipeline) : Pipeline =
let go stdout = let go stdout =
let subsequent = cont stdout let subsequent = cont stdout
subsequent subsequent
Pipeline.ShellScriptBind (toRun, go) Pipeline.ShellScriptBind (toRun, go)
/// For running a script, without capturing stdout /// For running a script, without capturing stdout
member _.Bind (toRun : string, cont : unit -> Pipeline) : Pipeline = 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, // Things later in the pipeline can't alter the modifiers that were specified earlier in the pipeline,
// so throw those modifications away. // so throw those modifications away.
let subsequent = cont () let subsequent = cont ()
Pipeline.ShellScript (toRun, subsequent) Pipeline.ShellScript (toRun, subsequent)
/// Bind in another pipeline, perhaps on a different agent /// Bind in another pipeline, perhaps on a different agent
member _.Bind (p : Pipeline * PipelineModifier, cont : unit -> Pipeline) : Pipeline = member _.Bind (p : Pipeline * PipelineModifier, cont : unit -> Pipeline) : Pipeline =
Pipeline.Sequence ([p], cont ()) Pipeline.Sequence ([ p ], cont ())
member _.Yield (x : unit) : unit = () member _.Yield (x : unit) : unit = ()
member _.For
(expr : PipelineModifier, cont : unit -> Pipeline) member _.For (expr : PipelineModifier, cont : unit -> Pipeline) : Pipeline =
: Pipeline
=
modifier <- expr modifier <- expr
let pipeline = cont () let pipeline = cont ()
pipeline pipeline
member _.Run x = member _.Run x = x, modifier
x, modifier
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Pipeline = module Pipeline =
let rec private toStringInner (bindCount : int) (indentCount : int) (this : Pipeline) : string = let rec private toStringInner (bindCount : int) (indentCount : int) (this : Pipeline) : string =
let indent = String.replicate indentCount " " let indent = String.replicate indentCount " "
match this with match this with
| Pipeline.Empty -> $"%s{indent}<nothing>" | Pipeline.Empty -> $"%s{indent}<nothing>"
| Pipeline.ShellScript(script, andThen) -> | Pipeline.ShellScript (script, andThen) ->
$"%s{indent}Run: %s{script}\n%s{indent}Then\n%s{toStringInner bindCount (indentCount + 2) 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 = $"<stdout-%i{bindCount}>" let outputDummy = $"<stdout-%i{bindCount}>"
let dummyPipeline = consumeStdout (Stdout (Comp.make 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}" $"%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 = let previous =
previous previous
|> List.map (fun (previous, modifier) -> |> List.map (fun (previous, modifier) ->
@@ -178,6 +167,7 @@ module Pipeline =
$"%s{firstMod}%s{first}" $"%s{firstMod}%s{first}"
) )
|> String.concat $"\n%s{indent}-----\n" |> String.concat $"\n%s{indent}-----\n"
let second = $"%s{toStringInner bindCount (indentCount + 2) second}" let second = $"%s{toStringInner bindCount (indentCount + 2) second}"
$"%s{previous}%s{indent}----\n%s{second}" $"%s{previous}%s{indent}----\n%s{second}"
@@ -185,8 +175,7 @@ module Pipeline =
let empty = Pipeline.Empty let empty = Pipeline.Empty
let prependShellScript script andThen = let prependShellScript script andThen = Pipeline.ShellScript (script, andThen)
Pipeline.ShellScript (script, andThen)
let concat (prevStages : (Pipeline * PipelineModifier) list) (final : Pipeline) = let concat (prevStages : (Pipeline * PipelineModifier) list) (final : Pipeline) =
Pipeline.Sequence (prevStages, final) Pipeline.Sequence (prevStages, final)
@@ -197,8 +186,7 @@ module Pipeline =
let toStepDag (p : Pipeline, modifier : PipelineModifier) : SealedStepDag<unit, unit> = let toStepDag (p : Pipeline, modifier : PipelineModifier) : SealedStepDag<unit, unit> =
match modifier.AgentModifier with match modifier.AgentModifier with
| None -> failwith "Pipeline must run on an agent, but no agent was specified" | None -> failwith "Pipeline must run on an agent, but no agent was specified"
| Some _ -> | Some _ -> failwith $"TODO\n%O{modifier}\n%s{toString p}"
failwith $"TODO\n%O{modifier}\n%s{toString p}"
[<AutoOpen>] [<AutoOpen>]
module PipelineBuilder = module PipelineBuilder =

69
WoofWorkflows/Program.fs
View File

@@ -10,16 +10,21 @@ module Program =
withEnv ("foo", Comp.make "bar") withEnv ("foo", Comp.make "bar")
withEnv ("hi", Comp.make "bye") withEnv ("hi", Comp.make "bye")
let! (Stdout stdout) = "sh script here" let! (Stdout stdout) = "sh script here"
do! pipelineSameAgent {
withEnv ("foo", stdout) do!
do! "git config --foo" pipelineSameAgent {
return () withEnv ("foo", stdout)
} do! "git config --foo"
do! pipeline (Comp.make "another-image") { return ()
labelled "label 2" }
let! (Stdout stdout) = "maybe run a formatter"
return () do!
} pipeline (Comp.make "another-image") {
labelled "label 2"
let! (Stdout stdout) = "maybe run a formatter"
return ()
}
do! "a shell script" do! "a shell script"
let! (Stdout stdout) = "another shell script" let! (Stdout stdout) = "another shell script"
return () return ()
@@ -27,25 +32,29 @@ module Program =
let foo2 () = let foo2 () =
let pl = let pl =
Pipeline.bindShellScript "sh script here" (fun (Stdout stdout) -> Pipeline.bindShellScript
Pipeline.concat "sh script here"
[ (fun (Stdout stdout) ->
let modifier = PipelineModifier.empty None |> PipelineModifier.withEnv "foo" stdout Pipeline.concat
let pl = Pipeline.empty |> Pipeline.prependShellScript "git config --foo" [
yield pl, modifier 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 modifier =
let pl = Pipeline.bindShellScript "maybe run a formatter" (fun _ -> Pipeline.empty) PipelineModifier.empty (Some (Comp.make "another-image"))
yield pl, modifier |> 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 = let modifier =
PipelineModifier.empty (Some (Comp.make "some-image")) PipelineModifier.empty (Some (Comp.make "some-image"))
|> PipelineModifier.replaceWorkingDir (Comp.make (DirectoryInfo "code root here")) |> PipelineModifier.replaceWorkingDir (Comp.make (DirectoryInfo "code root here"))
@@ -57,7 +66,5 @@ module Program =
[<EntryPoint>] [<EntryPoint>]
let main argv = let main argv =
foo2 () foo2 () |> Pipeline.toStepDag |> ignore
|> Pipeline.toStepDag 0
|> ignore
0

9
WoofWorkflows/StepDag.fs
View File

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