woofworkflows-poc/WoofWorkflows/Pipeline.fs

namespace WoofWorkflows

open System.IO

type Stdout = Stdout of string Comp

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
            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
                ""
            else
                this.EnvVars
                |> Seq.map (fun (k, v) -> k + ":" + Comp.force v)
                |> String.concat ", "
                |> fun s -> "; Env vars: " + s
        let workingDir =
            match this.WorkingDir with
            | None -> ""
            | Some dir -> "; Working dir: " + (Comp.force dir).FullName

        agent + envVars + workingDir

type Pipeline =
    | Empty
    | 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 (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 =
                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) = toStringInner 0 0 p

[<RequireQualifiedAccess>]
module private PipelineModifier =
    let empty (agent : string Comp option) : PipelineModifier =
        {
            EnvVars = []
            WorkingDir = None
            AgentModifier = agent
        }

[<Sealed ; Class>]
type PipelineBuilder (agent : string Comp option) =
    let mutable modifier : PipelineModifier =
        PipelineModifier.empty agent

    [<CustomOperation "withEnv">]
    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
        =
        { PipelineModifier.empty agent with
            EnvVars = [key, value]
        }

    [<CustomOperation "workingDir">]
    member _.WorkingDir
        (mods : PipelineModifier, dir : DirectoryInfo Comp)
        : PipelineModifier
        =
        { mods with
            WorkingDir = Some dir
        }

    [<CustomOperation "workingDir">]
    member _.WorkingDir
        (() : unit, dir : DirectoryInfo Comp)
        : PipelineModifier
        =
        { PipelineModifier.empty agent with
            WorkingDir = Some dir
        }

    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 option, cont : unit -> Pipeline) : Pipeline =
        Pipeline.Sequence (p, cont ())
    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 : 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 (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