src/SomhairlesDream.Cli/Arguments.fs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

namespace SomhairlesDream.Cli

open System
open SomhairlesDream.Shared

[<CLIMutable>]
type RunOptions =
    { Ids: RunIds
      OutputRoot: string
      StageRoot: string
      Python: string
      Render: bool
      Design: string }

type Command =
    | Run of RunOptions
    | Verify of string
    | Help

module Arguments =
    let usage =
        "usage: dotnet run --project src/SomhairlesDream.Cli -- run [options]\n"
        + "       dotnet run --project src/SomhairlesDream.Cli -- verify <manifest.json>\n"
        + "options: --project-id --run-id --base-id --target-id --output-root --stage-root --python --render --design heritage|probe|ship"

    let private defaultPython () =
        let configured = Environment.GetEnvironmentVariable("SOMHAIRLES_BPYTHON")
        if String.IsNullOrWhiteSpace(configured) then "python3" else configured

    let private heritageIds =
        { ProjectId = "heritage-001"
          RunId = "run-001"
          BaseId = "base-000"
          TargetId = "target-003" }

    let private probeIds =
        { ProjectId = "probe-001"
          RunId = "run-001"
          BaseId = "probe-base-000"
          TargetId = "probe-target-007" }

    let private shipIds =
        { ProjectId = "ship-001"
          RunId = "run-001"
          BaseId = "ship-base-000"
          TargetId = "ship-target-007" }

    let private defaults () =
        { Ids = heritageIds
          OutputRoot = ".artifacts"
          StageRoot = "stage"
          Python = defaultPython ()
          Render = false
          Design = "heritage" }

    let private requiredValue (args: string array) (index: int) (optionName: string) =
        if index + 1 >= args.Length || String.IsNullOrWhiteSpace(args[index + 1]) then
            Error $"{optionName} requires a value"
        else
            Ok args[index + 1]

    let private setValue optionName value (options: RunOptions) =
        match optionName with
        | "--project-id" -> Ok { options with Ids = { options.Ids with ProjectId = value } }
        | "--run-id" -> Ok { options with Ids = { options.Ids with RunId = value } }
        | "--base-id" -> Ok { options with Ids = { options.Ids with BaseId = value } }
        | "--target-id" -> Ok { options with Ids = { options.Ids with TargetId = value } }
        | "--output-root" -> Ok { options with OutputRoot = value }
        | "--stage-root" -> Ok { options with StageRoot = value }
        | "--python" -> Ok { options with Python = value }
        | "--design" -> Ok { options with Design = value }
        | _ -> Error $"unknown option: {optionName}"

    let private resolveIds (options: RunOptions) =
        if options.Design = "heritage" then
            options
        else
            let designIds =
                match options.Design with
                | "probe" -> probeIds
                | "ship" -> shipIds
                | _ -> heritageIds

            let swap heritage design value = if value = heritage then design else value

            let ids =
                { ProjectId = swap heritageIds.ProjectId designIds.ProjectId options.Ids.ProjectId
                  RunId = swap heritageIds.RunId designIds.RunId options.Ids.RunId
                  BaseId = swap heritageIds.BaseId designIds.BaseId options.Ids.BaseId
                  TargetId = swap heritageIds.TargetId designIds.TargetId options.Ids.TargetId }

            { options with Ids = ids }

    let private validateRunOptions (options: RunOptions) =
        if options.Design <> "heritage" && options.Design <> "probe" && options.Design <> "ship" then
            Error $"invalid design: {options.Design}"
        else
            let resolved = resolveIds options

            [| resolved.Ids.ProjectId; resolved.Ids.RunId; resolved.Ids.BaseId; resolved.Ids.TargetId |]
            |> Array.tryFind (Ids.validateResourceId >> Result.isError)
            |> function
                | Some value -> Error $"invalid resource id: {value}"
                | None -> Ok(Run resolved)

    let private parseRun (args: string array) =
        let rec loop (index: int) (options: RunOptions) =
            if index >= args.Length then
                validateRunOptions options
            else
                match args[index] with
                | "--render" -> loop (index + 1) { options with Render = true }
                | "--help" -> Ok Help
                | optionName ->
                    match requiredValue args index optionName with
                    | Error message -> Error message
                    | Ok value ->
                        match setValue optionName value options with
                        | Error message -> Error message
                        | Ok updated -> loop (index + 2) updated

        loop 0 (defaults ())

    let parse (args: string array) =
        match args with
        | [||]
        | [| "--help" |]
        | [| "help" |] -> Ok Help
        | [| "verify" |] -> Error "verify requires a manifest path"
        | [| "verify"; path |] when not (String.IsNullOrWhiteSpace(path)) -> Ok(Verify path)
        | [| "verify"; _ |] -> Error "verify requires a manifest path"
        | values when values.Length > 2 && values[0] = "verify" -> Error "verify accepts exactly one manifest path"
        | values when values.Length > 0 && values[0] = "run" -> parseRun (values |> Array.skip 1)
        | _ -> Error usage