Initial commit

PureGym.App/Program.fs

@@ -0,0 +1,118 @@
+namespace PureGym.App
+
+open System
+open Argu
+
+type Subcommand =
+    | RequiresAuth of (PureGym.Auth -> ArgsCrate)
+    | NoAuth of ArgsCrate
+
+module Program =
+    let subcommands =
+        [|
+            "auth", ("Get an authentication token", NoAuth (ArgsCrate.make GetTokenArg.Parse Authenticate.run))
+
+            "lookup-gym",
+            ("Get information about the physical instantiation of a gym",
+             RequiresAuth (fun auth -> ArgsCrate.make (LookupGymArgs.Parse auth) LookupGym.run))
+
+            "fullness",
+            ("Determine how full a gym is",
+             RequiresAuth (fun auth -> ArgsCrate.make (FullnessArgs.Parse auth) Fullness.run))
+
+            "activity",
+            ("Get information about your gym usage",
+             RequiresAuth (fun auth -> ArgsCrate.make (MemberActivityArgs.Parse auth) MemberActivity.run))
+        |]
+        |> Map.ofArray
+
+    [<EntryPoint>]
+    let main argv =
+        // It looks like Argu doesn't really support the combination of subcommands and read-from-env-vars, so we just
+        // roll our own.
+
+        match Array.tryHead argv with
+        | None
+        | Some "--help" ->
+            subcommands.Keys
+            |> String.concat ","
+            |> eprintfn "Subcommands (try each with `--help`): %s"
+
+            0
+
+        | Some commandName ->
+
+        match Map.tryFind commandName subcommands with
+        | None ->
+            subcommands.Keys
+            |> String.concat ","
+            |> eprintfn "Unrecognised command '%s'. Subcommands (try each with `--help`): %s" commandName
+
+            127
+
+        | Some (_help, command) ->
+
+        let argv = Array.tail argv
+        let config = ConfigurationReader.FromEnvironmentVariables ()
+
+        let argv, command =
+            match command with
+            | RequiresAuth command ->
+                let authParser = ArgumentParser.Create<AuthArg> ()
+
+                let extractedAuthParse, helpRequested =
+                    try
+                        authParser.Parse (argv, config, raiseOnUsage = true, ignoreUnrecognized = true), false
+                    with :? ArguParseException as e ->
+                        if e.Message.StartsWith ("USAGE:", StringComparison.OrdinalIgnoreCase) then
+                            authParser.Parse (argv, config, raiseOnUsage = false, ignoreUnrecognized = true), true
+                        else
+                            reraise ()
+
+                let authArgs, argv =
+                    if helpRequested then
+                        let subcommandArgs =
+                            ("--help" :: extractedAuthParse.GetResults AuthArg.Others) |> List.toArray
+
+                        Unchecked.defaultof<_>, subcommandArgs
+                    else
+                        match AuthArg.Parse extractedAuthParse with
+                        | Ok a -> a
+                        | Error e -> Exception.reraiseWithOriginalStackTrace e
+
+                argv, command authArgs
+            | NoAuth command -> argv, command
+
+        { new ArgsEvaluator<_> with
+            member _.Eval<'a, 'b when 'b :> IArgParserTemplate> (ofResult : ParseResults<'b> -> Result<'a, _>) run =
+                let parser = ArgumentParser.Create<'b> ()
+
+                let parsed =
+                    try
+                        parser.Parse (argv, config, raiseOnUsage = true) |> Ok
+                    with :? ArguParseException as e ->
+                        e.Message.Replace ("PureGym.App ", $"PureGym.App %s{commandName} ")
+                        |> Console.Error.WriteLine
+
+                        if e.Message.StartsWith ("USAGE:", StringComparison.OrdinalIgnoreCase) then
+                            Error true
+                        else
+                            Error false
+
+                match parsed with
+                | Error false -> Error 127
+                | Error true -> Error 0
+                | Ok parsed ->
+
+                match ofResult parsed with
+                | Error e ->
+                    e.Message.Replace ("PureGym.App ", $"PureGym.App %s{commandName} ")
+                    |> Console.Error.WriteLine
+
+                    Error 127
+                | Ok args ->
+
+                run args |> Ok
+        }
+        |> command.Apply
+        |> Result.cata (fun t -> t.Result) id