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

How about going without weird typars

Browse Source
This commit is contained in:
Smaug123
2023-12-21 22:32:58 +00:00
parent 04552cb995
commit 64127ef139
1 changed files with 75 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files

158
WoofWorkflows/Pipeline.fs
View File

@@ -4,15 +4,21 @@ open System.IO
type Stdout = Stdout of string Comp
type PipelineModifier<'Agent> =
type PipelineModifier =
private
{
EnvVars : (string * string Comp) list
// TODO: does this stack the right way? Does last win or first win?
WorkingDir : DirectoryInfo Comp option
Agent : 'Agent
AgentModifier : string Comp option
}
override this.ToString () =
let agent =
match this.AgentModifier with
| None -> "(same agent)"
| Some c ->
"New agent with image: " + Comp.force c
let envVars =
if this.EnvVars.IsEmpty then
""
@@ -25,62 +31,57 @@ type PipelineModifier<'Agent> =
match this.WorkingDir with
| None -> ""
| Some dir -> "; Working dir: " + (Comp.force dir).FullName
let agent = this.Agent.ToString ()
agent + envVars + workingDir
type NewAgent =
private
| NewAgent of image : string Comp
override this.ToString () =
match this with
| NewAgent comp -> "Image: " + Comp.force comp
type SameAgent =
private | SameAgent
override this.ToString () =
"<no image specified>"
type Pipeline<'Agent> =
type Pipeline =
| Empty
| 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<SameAgent> * second : Pipeline<'Agent>
| ChangeAgent of first : Pipeline<NewAgent> * second : Pipeline<NewAgent>
| ShellScript of script : string * andThen : (Pipeline)
| ShellScriptBind of script : string * consumeStdout : (Stdout -> Pipeline)
| Sequence of first : (Pipeline * PipelineModifier option) * second : (Pipeline)
[<RequireQualifiedAccess>]
module Pipeline =
let rec private toStringInner<'A> (bindCount : int) (indentCount : int) (this : Pipeline<'A>) : string =
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) -> $"%s{indent}Run: %s{script}\n%s{indent}Then\n%s{toStringInner bindCount (indentCount + 2) 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) ->
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}"
| Pipeline.Sequence((first, modifier), second) ->
let firstMod =
match modifier with
| None -> ""
| Some modifier ->
$"%O{modifier}"
let first = $"%s{toStringInner bindCount (indentCount + 2) first}"
let second = $"%s{toStringInner bindCount (indentCount + 2) second}"
$"%s{indent} {firstMod}\n%s{first}\n%s{indent}----\n%s{second}"
let toString (p : Pipeline<'A>) = toStringInner 0 0 p
let toString (p : Pipeline) = toStringInner 0 0 p
[<RequireQualifiedAccess>]
module private PipelineModifier =
let empty : PipelineModifier<SameAgent> =
let empty (agent : string Comp option) : PipelineModifier =
{
EnvVars = []
WorkingDir = None
Agent = SameAgent
AgentModifier = agent
}
[<Sealed ; Class>]
type PipelineBuilder<'plat, 'agentFinal> () =
type PipelineBuilder (agent : string Comp option) =
let mutable modifier : PipelineModifier =
PipelineModifier.empty agent
[<CustomOperation "withEnv">]
member _.WithEnv
(mods : PipelineModifier<'Agent>, (key : string, value : string Comp))
: PipelineModifier<'Agent>
(mods : PipelineModifier, (key : string, value : string Comp))
: PipelineModifier
=
{ mods with
EnvVars = (key, value) :: mods.EnvVars
@@ -89,16 +90,16 @@ type PipelineBuilder<'plat, 'agentFinal> () =
[<CustomOperation "withEnv">]
member _.WithEnv
(() : unit, (key : string, value : string Comp))
: PipelineModifier<SameAgent>
: PipelineModifier
=
{ PipelineModifier.empty with
{ PipelineModifier.empty agent with
EnvVars = [key, value]
}
[<CustomOperation "workingDir">]
member _.WorkingDir
(mods : PipelineModifier<'Agent>, dir : DirectoryInfo Comp)
: PipelineModifier<'Agent>
(mods : PipelineModifier, dir : DirectoryInfo Comp)
: PipelineModifier
=
{ mods with
WorkingDir = Some dir
@@ -107,77 +108,68 @@ type PipelineBuilder<'plat, 'agentFinal> () =
[<CustomOperation "workingDir">]
member _.WorkingDir
(() : unit, dir : DirectoryInfo Comp)
: PipelineModifier<SameAgent>
: PipelineModifier
=
{ PipelineModifier.empty with
{ PipelineModifier.empty agent with
WorkingDir = Some dir
}
[<CustomOperation "remote">]
member _.Remote
(() : unit, image : string Comp)
: PipelineModifier<NewAgent>
=
{
EnvVars = []
WorkingDir = None
Agent = NewAgent image
}
[<CustomOperation "remote">]
member _.Remote
(mods : PipelineModifier<SameAgent>, image : string Comp)
: PipelineModifier<NewAgent>
=
{
EnvVars = mods.EnvVars
WorkingDir = mods.WorkingDir
Agent = NewAgent image
}
member _.Return<'Agent> (() : unit) = Pipeline<'Agent>.Empty
member _.Return (() : unit) : Pipeline =
Pipeline.Empty
/// For running a script, capturing stdout
member _.Bind (toRun : string, cont : Stdout -> Pipeline<'Agent>) : Pipeline<'Agent> =
Pipeline.ShellScriptBind (toRun, cont)
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<'Agent>) : Pipeline<'Agent> =
Pipeline.ShellScript (toRun, cont ())
/// We can bind any pipeline which runs on the "same agent".
member _.Bind (p : Pipeline<SameAgent>, cont : unit -> Pipeline<'Agent>) : Pipeline<'Agent> =
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 option, cont : unit -> Pipeline) : Pipeline =
Pipeline.Sequence (p, cont ())
/// We can also bind in any pipeline to run on a different agent.
member _.Bind (p : Pipeline<NewAgent>, cont : unit -> Pipeline<NewAgent>) : Pipeline<'Agent> =
Pipeline.ChangeAgent (p, cont ())
member _.Yield (() : unit) : unit = ()
member _.For (expr : PipelineModifier<'Agent>, cont : unit -> Pipeline<'Agent>) : Pipeline<'Agent> =
Pipeline.WithModifier (cont (), expr)
member _.Yield (x : unit) : unit = ()
member _.For
(expr : PipelineModifier, cont : unit -> Pipeline)
: Pipeline
=
modifier <- expr
let pipeline = cont ()
pipeline
member _.Run x = x, Some modifier
[<AutoOpen>]
module PipelineBuilder =
let pipeline<'agent> = PipelineBuilder<unit, 'agent> ()
let toStepDag<'Agent> (p : Pipeline<'Agent>) : SealedStepDag<unit, unit> = failwith $"TODO\n%s{Pipeline.toString p}"
let pipeline (agent : string Comp) = PipelineBuilder (Some agent)
let pipelineSameAgent = PipelineBuilder None
let toStepDag (p : Pipeline, modifier : PipelineModifier option) : SealedStepDag<unit, unit> =
match modifier with
| None -> failwith "Pipeline must run on an agent, but no agent was specified"
| Some modifier ->
failwith $"TODO\n%O{modifier}\n%s{Pipeline.toString p}"
let foo () : SealedStepDag<unit, unit> =
pipeline {
remote (Comp.make "some-image")
pipeline (Comp.make "some-image") {
workingDir (Comp.make (DirectoryInfo "code root here"))
withEnv ("foo", Comp.make "bar")
withEnv ("hi", Comp.make "bye")
let! (Stdout stdout) = "sh script here"
// type annotation is not necessary here but makes the location explicit
do! pipeline<SameAgent> {
do! pipelineSameAgent {
withEnv ("foo", stdout)
do! "git config --foo"
return ()
}
// again, type annotation is not necessary here but makes it explicit that this is running somewhere
// else
do! pipeline {
// remote (Comp.make "another-image")
do! pipeline (Comp.make "another-image") {
let! (Stdout stdout) = "maybe run a formatter"
return ()
}
do! "a shell script"
let! (Stdout stdout) = "another shell script"
return ()
}
|> toStepDag