Rejig
This commit is contained in:
Smaug123
@@ -11,6 +11,7 @@ type PipelineModifier =
|
||||
// TODO: does this stack the right way? Does last win or first win?
|
||||
WorkingDir : DirectoryInfo Comp option
|
||||
AgentModifier : string Comp option
|
||||
Labels : string list
|
||||
}
|
||||
override this.ToString () =
|
||||
let agent =
|
||||
@@ -19,6 +20,11 @@ type PipelineModifier =
|
||||
| Some c ->
|
||||
"New agent with image: " + Comp.force c
|
||||
|
||||
let labels =
|
||||
this.Labels
|
||||
|> String.concat ", "
|
||||
|> function | "" -> "" | s -> $"; Labels: %s{s}"
|
||||
|
||||
let envVars =
|
||||
if this.EnvVars.IsEmpty then
|
||||
""
|
||||
@@ -32,48 +38,59 @@ type PipelineModifier =
|
||||
| None -> ""
|
||||
| Some dir -> "; Working dir: " + (Comp.force dir).FullName
|
||||
|
||||
agent + envVars + workingDir
|
||||
agent + labels + envVars + workingDir
|
||||
|
||||
type Pipeline =
|
||||
private
|
||||
| Empty
|
||||
| ShellScript of script : string * andThen : (Pipeline)
|
||||
| ShellScript of script : string * andThen : Pipeline
|
||||
| ShellScriptBind of script : string * consumeStdout : (Stdout -> Pipeline)
|
||||
| Sequence of first : (Pipeline * PipelineModifier) * second : (Pipeline)
|
||||
|
||||
[<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)) ->
|
||||
$"%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.Sequence((first, modifier), second) ->
|
||||
let firstMod = $"%s{indent} %O{modifier}\n"
|
||||
let first = $"%s{toStringInner bindCount (indentCount + 2) first}"
|
||||
let second = $"%s{toStringInner bindCount (indentCount + 2) second}"
|
||||
$"%s{firstMod}%s{first}\n%s{indent}----\n%s{second}"
|
||||
|
||||
let toString (p : Pipeline) = toStringInner 0 0 p
|
||||
| Sequence of previous : (Pipeline * PipelineModifier) list * final : Pipeline
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module private PipelineModifier =
|
||||
let empty (agent : string Comp option) : PipelineModifier =
|
||||
let empty (newAgent : string Comp option) : PipelineModifier =
|
||||
{
|
||||
EnvVars = []
|
||||
WorkingDir = None
|
||||
AgentModifier = agent
|
||||
AgentModifier = newAgent
|
||||
Labels = []
|
||||
}
|
||||
|
||||
let withEnv (key : string) (value : string Comp) (existing : PipelineModifier) =
|
||||
{ existing with
|
||||
EnvVars = (key, value) :: existing.EnvVars
|
||||
}
|
||||
|
||||
let replaceWorkingDir (newDir : DirectoryInfo Comp) (existing : PipelineModifier) =
|
||||
{ existing with WorkingDir = Some newDir }
|
||||
|
||||
let addLabel (label : string) (existing : PipelineModifier) =
|
||||
{ existing with Labels = label :: existing.Labels }
|
||||
|
||||
[<Sealed ; Class>]
|
||||
type PipelineBuilder (agent : string Comp option) =
|
||||
let mutable modifier : PipelineModifier =
|
||||
PipelineModifier.empty agent
|
||||
|
||||
[<CustomOperation "labelled">]
|
||||
member _.WithLabel
|
||||
(mods : PipelineModifier, label : string)
|
||||
: PipelineModifier
|
||||
=
|
||||
{ mods with
|
||||
Labels = label :: mods.Labels
|
||||
}
|
||||
|
||||
[<CustomOperation "labelled">]
|
||||
member _.WithLabel
|
||||
(() : unit, label : string)
|
||||
: PipelineModifier
|
||||
=
|
||||
{ PipelineModifier.empty agent with
|
||||
Labels = [label]
|
||||
}
|
||||
|
||||
[<CustomOperation "withEnv">]
|
||||
member _.WithEnv
|
||||
(mods : PipelineModifier, (key : string, value : string Comp))
|
||||
@@ -127,7 +144,7 @@ type PipelineBuilder (agent : string Comp option) =
|
||||
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)
|
||||
@@ -140,33 +157,50 @@ type PipelineBuilder (agent : string Comp option) =
|
||||
member _.Run x =
|
||||
x, modifier
|
||||
|
||||
[<AutoOpen>]
|
||||
module PipelineBuilder =
|
||||
let pipeline (agent : string Comp) = PipelineBuilder (Some agent)
|
||||
let pipelineSameAgent = PipelineBuilder None
|
||||
[<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) ->
|
||||
$"%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.Sequence(previous, second) ->
|
||||
let previous =
|
||||
previous
|
||||
|> List.map (fun (previous, modifier) ->
|
||||
let firstMod = $"%s{indent} %O{modifier}\n"
|
||||
let first = $"%s{toStringInner bindCount (indentCount + 2) previous}"
|
||||
$"%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}"
|
||||
|
||||
let toString (p : Pipeline) = toStringInner 0 0 p
|
||||
|
||||
let empty = Pipeline.Empty
|
||||
|
||||
let prependShellScript script andThen =
|
||||
Pipeline.ShellScript (script, andThen)
|
||||
|
||||
let concat (prevStages : (Pipeline * PipelineModifier) list) (final : Pipeline) =
|
||||
Pipeline.Sequence (prevStages, final)
|
||||
|
||||
let bindShellScript script andThen =
|
||||
Pipeline.ShellScriptBind (script, andThen)
|
||||
|
||||
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{Pipeline.toString p}"
|
||||
failwith $"TODO\n%O{modifier}\n%s{toString p}"
|
||||
|
||||
let foo () : SealedStepDag<unit, unit> =
|
||||
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! 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
|
||||
[<AutoOpen>]
|
||||
module PipelineBuilder =
|
||||
let pipeline (agent : string Comp) = PipelineBuilder (Some agent)
|
||||
let pipelineSameAgent = PipelineBuilder None
|
||||
|
||||
@@ -1,8 +1,63 @@
|
||||
namespace WoofWorkflows
|
||||
|
||||
open System.IO
|
||||
|
||||
module Program =
|
||||
let foo () =
|
||||
pipeline (Comp.make "some-image") {
|
||||
workingDir (Comp.make (DirectoryInfo "code root here"))
|
||||
labelled "label 1"
|
||||
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! "a shell script"
|
||||
let! (Stdout stdout) = "another shell script"
|
||||
return ()
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
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 (Some (Comp.make "some-image"))
|
||||
|> PipelineModifier.replaceWorkingDir (Comp.make (DirectoryInfo "code root here"))
|
||||
|> PipelineModifier.addLabel "label 1"
|
||||
|> PipelineModifier.withEnv "foo" (Comp.make "bar")
|
||||
|> PipelineModifier.withEnv "hi" (Comp.make "bye")
|
||||
|
||||
pl, modifier
|
||||
|
||||
[<EntryPoint>]
|
||||
let main argv =
|
||||
PipelineBuilder.foo ()
|
||||
foo2 ()
|
||||
|> Pipeline.toStepDag
|
||||
|> ignore
|
||||
0
|
||||
Reference in New Issue
Block a user