Compare commits

...

2 Commits

Author SHA1 Message Date
Smaug123
64127ef139 How about going without weird typars 2023-12-21 22:32:58 +00:00
Smaug123
04552cb995 wip 2023-12-21 21:06:27 +00:00
2 changed files with 80 additions and 79 deletions

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,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

View File

@@ -3,6 +3,8 @@
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net8.0</TargetFramework>
<TreatWarningsAsErrors>true</TreatWarningsAsErrors>
<WarnOn>FS3559</WarnOn>
</PropertyGroup>
<ItemGroup>