119 lines
4.2 KiB
Forth
119 lines
4.2 KiB
Forth
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
|