|
|
|
@@ -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,61 +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 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 () =
|
|
|
|
|
"<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<AgentUnset> * second : Pipeline<'Agent>
|
|
|
|
|
| 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<AgentUnset> =
|
|
|
|
|
let empty (agent : string Comp option) : PipelineModifier =
|
|
|
|
|
{
|
|
|
|
|
EnvVars = []
|
|
|
|
|
WorkingDir = None
|
|
|
|
|
Agent = AgentUnset
|
|
|
|
|
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
|
|
|
|
@@ -88,16 +90,16 @@ type PipelineBuilder<'plat, 'agentFinal> () =
|
|
|
|
|
[<CustomOperation "withEnv">]
|
|
|
|
|
member _.WithEnv
|
|
|
|
|
(() : unit, (key : string, value : string Comp))
|
|
|
|
|
: PipelineModifier<AgentUnset>
|
|
|
|
|
: 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
|
|
|
|
@@ -106,71 +108,68 @@ type PipelineBuilder<'plat, 'agentFinal> () =
|
|
|
|
|
[<CustomOperation "workingDir">]
|
|
|
|
|
member _.WorkingDir
|
|
|
|
|
(() : unit, dir : DirectoryInfo Comp)
|
|
|
|
|
: PipelineModifier<AgentUnset>
|
|
|
|
|
: PipelineModifier
|
|
|
|
|
=
|
|
|
|
|
{ PipelineModifier.empty with
|
|
|
|
|
{ PipelineModifier.empty agent with
|
|
|
|
|
WorkingDir = Some dir
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
[<CustomOperation "remote">]
|
|
|
|
|
member _.Remote
|
|
|
|
|
(() : unit, image : string Comp)
|
|
|
|
|
: PipelineModifier<AgentIsSet>
|
|
|
|
|
=
|
|
|
|
|
{
|
|
|
|
|
EnvVars = []
|
|
|
|
|
WorkingDir = None
|
|
|
|
|
Agent = AgentIsSet image
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
[<CustomOperation "remote">]
|
|
|
|
|
member _.Remote
|
|
|
|
|
(mods : PipelineModifier<AgentUnset>, image : string Comp)
|
|
|
|
|
: PipelineModifier<AgentIsSet>
|
|
|
|
|
=
|
|
|
|
|
{
|
|
|
|
|
EnvVars = mods.EnvVars
|
|
|
|
|
WorkingDir = mods.WorkingDir
|
|
|
|
|
Agent = AgentIsSet image
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
member _.Return (() : unit) = Pipeline.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 doesn't say where it's going to run; the interpretation is that it'll
|
|
|
|
|
/// run wherever the parent runs.
|
|
|
|
|
member _.Bind (p : Pipeline<AgentUnset>, 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 ())
|
|
|
|
|
// 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<'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<'plat, 'agent> = PipelineBuilder<'plat, '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")
|
|
|
|
|
withEnv ("hi", Comp.make "bye")
|
|
|
|
|
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"
|
|
|
|
|
do! pipeline {
|
|
|
|
|
do! pipelineSameAgent {
|
|
|
|
|
withEnv ("foo", stdout)
|
|
|
|
|
do! "git config --foo"
|
|
|
|
|
return ()
|
|
|
|
|
}
|
|
|
|
|
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
|
|
|
|
|