woofworkflows-poc/WoofWorkflows/Pipeline.fs

namespace WoofWorkflows

open System.IO

type Stdout = Stdout of string Comp

type PipelineModifier<'Agent> =
    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
        }
    override this.ToString () =
        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
        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> =
    | 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>

[<RequireQualifiedAccess>]
module Pipeline =
    let rec private toStringInner<'A> (bindCount : int) (indentCount : int) (this : Pipeline<'A>) : 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.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}"

    let toString (p : Pipeline<'A>) = toStringInner 0 0 p

[<RequireQualifiedAccess>]
module private PipelineModifier =
    let empty : PipelineModifier<SameAgent> =
        {
            EnvVars = []
            WorkingDir = None
            Agent = SameAgent
        }

[<Sealed ; Class>]
type PipelineBuilder<'plat, 'agentFinal> () =
    [<CustomOperation "withEnv">]
    member _.WithEnv
        (mods : PipelineModifier<'Agent>, (key : string, value : string Comp))
        : PipelineModifier<'Agent>
        =
        { mods with
            EnvVars = (key, value) :: mods.EnvVars
        }

    [<CustomOperation "withEnv">]
    member _.WithEnv
        (() : unit, (key : string, value : string Comp))
        : PipelineModifier<SameAgent>
        =
        { PipelineModifier.empty with
            EnvVars = [key, value]
        }

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

    [<CustomOperation "workingDir">]
    member _.WorkingDir
        (() : unit, dir : DirectoryInfo Comp)
        : PipelineModifier<SameAgent>
        =
        { PipelineModifier.empty 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

    /// For running a script, capturing stdout
    member _.Bind (toRun : string, cont : Stdout -> Pipeline<'Agent>) : Pipeline<'Agent> =
        Pipeline.ShellScriptBind (toRun, cont)
    /// 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> =
        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)

[<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 foo () : SealedStepDag<unit, unit> =
        pipeline {
            remote (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> {
                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")
                return ()
            }
            do! "a shell script"
            return ()
        }
        |> toStepDag