% crochet

open crochet.parsing.combinators;

command cli-app as parser do
  #parser any-of: (for X in self.commands do X as parser end);
end

command cli-command as parser do
  let Args = [self.command-arg as parser | lookahead] ++ (
    (for X in self.arguments do X as parser end)
  );
  #parser sequence: Args
    | map: (#cli-parser-result merge: _)
end

command cli-options as parser do
  #parser any-of: (for X in self.options do X as parser end)
    | many
    | map: { Xs in new cli-record([ [self.name] -> #cli-parser-result merge: Xs ]) }
    | recover: { _ in new cli-record([ [self.name] -> new cli-record([->]) ]) };
end

command cli-positional as parser =
  self.arg-type as parser
    | map: { X in new cli-record([ [self.name] -> X ]) };

command cli-option as parser =
  (#parser equal: self.key) lookahead
    | and-then: (#parser equal: self.key)
    | and-then: (self.arg-type as parser)
    | map: { X in new cli-record([[self.key] -> X]) };

command cli-functor as parser =
  (self.arg as parser) map: (cli-functor-apply apply: self.functor to: _);

local singleton cli-functor-apply;
command cli-functor-apply apply: Fun to: (Res is cli-parser-result) =
  cli-functor-apply wrap: Fun(Res realise);

command cli-functor-apply apply: Fun to: Res =
  cli-functor-apply wrap: Fun(Res);

command cli-functor-apply wrap: (X is cli-parser-result) =
  X;
command cli-functor-apply wrap: (X is record) =
  new cli-record(X);
command cli-functor-apply wrap: X =
  new cli-box(X);


local singleton cli-base-parser;

command cli-base-parser not-option =
  not (#parser any | if: (_ starts-with: "--"));


command cli-arg-exact as parser =
  #parser equal: self.value
    | map: { X in new cli-text(X) };

command cli-arg-text as parser =
  cli-base-parser not-option lookahead
    | and-then: #parser any
    | map: { X in new cli-text(X) };

command cli-arg-boolean as parser do
  #parser 'always map: { _ in cli-trilean-true };
end

command cli-arg parse: (Stream is parser-stream) =
  (self as parser) parse: Stream;

command cli-arg parse: (Args is list) =
  self parse: (Args as parser-stream);

command cli-arg map: (Fun is function-1) =
  new cli-functor(self, Fun);