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
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
}
[<Sealed ; Class>]
type PipelineBuilder (agent : string Comp option) =
let mutable modifier : PipelineModifier =
PipelineModifier.empty agent
let mutable modifier : PipelineModifier = PipelineModifier.empty agent
[<CustomOperation "labelled">]
member _.WithLabel
(mods : PipelineModifier, label : string)
: PipelineModifier
=
member _.WithLabel (mods : PipelineModifier, label : string) : PipelineModifier =
{ mods with
Labels = label :: mods.Labels
}
[<CustomOperation "labelled">]
member _.WithLabel
(() : unit, label : string)
: PipelineModifier
=
member _.WithLabel (() : unit, label : string) : PipelineModifier =
{ PipelineModifier.empty agent with
Labels = [label]
Labels = [ label ]
}
[<CustomOperation "withEnv">]
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
}
[<CustomOperation "withEnv">]
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 ]
}
[<CustomOperation "workingDir">]
member _.WorkingDir
(mods : PipelineModifier, dir : DirectoryInfo Comp)
: PipelineModifier
=
member _.WorkingDir (mods : PipelineModifier, dir : DirectoryInfo Comp) : PipelineModifier =
{ mods with
WorkingDir = Some dir
}
[<CustomOperation "workingDir">]
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
[<RequireQualifiedAccess>]
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}<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}"
| Pipeline.ShellScriptBind(script, consumeStdout) ->
| 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.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<unit, unit> =
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}"
[<AutoOpen>]
module PipelineBuilder =

69
WoofWorkflows/Program.fs
View File

@@ -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 =
[<EntryPoint>]
let main argv =
foo2 ()
|> Pipeline.toStepDag
|> ignore
0
foo2 () |> Pipeline.toStepDag |> ignore
0

9
WoofWorkflows/StepDag.fs
View File

@@ -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)
[<RequireQualifiedAccess>]
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