mirror of
https://github.com/mikpe/pdp10-tools.git
synced 2026-01-23 19:08:00 +00:00
216 lines
8.2 KiB
Erlang
216 lines
8.2 KiB
Erlang
%%% -*- erlang-indent-level: 2 -*-
|
|
%%%
|
|
%%% getopt for Erlang programs
|
|
%%% Copyright (C) 2018-2020 Mikael Pettersson
|
|
%%%
|
|
%%% This file is part of pdp10-tools.
|
|
%%%
|
|
%%% pdp10-tools is free software: you can redistribute it and/or modify
|
|
%%% it under the terms of the GNU General Public License as published by
|
|
%%% the Free Software Foundation, either version 3 of the License, or
|
|
%%% (at your option) any later version.
|
|
%%%
|
|
%%% pdp10-tools is distributed in the hope that it will be useful,
|
|
%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
%%% GNU General Public License for more details.
|
|
%%%
|
|
%%% You should have received a copy of the GNU General Public License
|
|
%%% along with pdp10-tools. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
-module(getopt).
|
|
-export([parse/3, format_error/1]).
|
|
|
|
-define(no, no).
|
|
-define(required, required).
|
|
-define(optional, optional).
|
|
-define(ambiguous, ambiguous).
|
|
-define(invalid, invalid).
|
|
-define(error, error).
|
|
|
|
-type longopt_spec() :: {Name :: string(),
|
|
HasArg :: ?no | ?required | ?optional,
|
|
Val :: term()}.
|
|
|
|
-type longopt() :: term() | {term(), string()}.
|
|
|
|
-spec parse([string()], string(), [longopt_spec()])
|
|
-> {ok, {[longopt()], [string()]}}
|
|
| {error, {module(), term()}}.
|
|
parse(Argv, OptString, LongOpts) ->
|
|
parse_argv(Argv, OptString, LongOpts, [], []).
|
|
|
|
parse_argv([], _OptString, _LongOpts, RevOpts, RevArgv) ->
|
|
finish(RevOpts, RevArgv, []);
|
|
parse_argv(["--" | Argv], OptString, _LongOpts, RevOpts, RevArgv) ->
|
|
case OptString of
|
|
[$- | _] ->
|
|
[] = RevArgv, % assert
|
|
RevOpts2 = lists:foldl(fun(Arg, RevOpts1) -> [{1, Arg} | RevOpts1] end,
|
|
RevOpts, Argv),
|
|
finish(RevOpts2, _RevArgv = [], _RestArgv = []);
|
|
_ ->
|
|
finish(RevOpts, RevArgv, Argv)
|
|
end;
|
|
parse_argv([Arg = "-" | Argv], OptString, LongOpts, RevOpts, RevArgv) ->
|
|
nonoption(Arg, Argv, OptString, LongOpts, RevOpts, RevArgv);
|
|
parse_argv([[$-, $- | Long] | Argv], OptString, LongOpts, RevOpts, RevArgv) ->
|
|
case parse_long(Long, Argv, LongOpts, RevOpts, _IsSingleDash = false) of
|
|
{ok, {Argv1, RevOpts1}} ->
|
|
parse_argv(Argv1, OptString, LongOpts, RevOpts1, RevArgv);
|
|
{error, _Reason} = Error -> Error
|
|
end;
|
|
parse_argv([[$- | Element] | Argv], OptString, LongOpts, RevOpts, RevArgv) ->
|
|
case parse_single_dash(Element, Argv, OptString, LongOpts, RevOpts) of
|
|
{ok, {Argv1, RevOpts1}} ->
|
|
parse_argv(Argv1, OptString, LongOpts, RevOpts1, RevArgv);
|
|
{error, _Reason} = Error -> Error
|
|
end;
|
|
parse_argv([Arg | Argv], OptString, LongOpts, RevOpts, RevArgv) ->
|
|
nonoption(Arg, Argv, OptString, LongOpts, RevOpts, RevArgv).
|
|
|
|
nonoption(Arg, Argv, OptString, LongOpts, RevOpts, RevArgv) ->
|
|
case OptString of
|
|
[$+ | _] -> finish(RevOpts, [Arg | RevArgv], Argv);
|
|
[$- | _] -> parse_argv(Argv, OptString, LongOpts, [{1, Arg} | RevOpts], RevArgv);
|
|
_ -> parse_argv(Argv, OptString, LongOpts, RevOpts, [Arg | RevArgv])
|
|
end.
|
|
|
|
finish(RevOpts, RevArgv, RestArgv) ->
|
|
{ok, {lists:reverse(RevOpts), lists:reverse(RevArgv, RestArgv)}}.
|
|
|
|
%% Short Options ---------------------------------------------------------------
|
|
|
|
parse_element([], Argv, _OptString, RevOpts) ->
|
|
{ok, {Argv, RevOpts}};
|
|
parse_element([OptCh | Element], Argv, OptString, RevOpts) ->
|
|
case optch_argument(OptCh, OptString) of
|
|
?no ->
|
|
parse_element(Element, Argv, OptString, [OptCh | RevOpts]);
|
|
?required ->
|
|
case {Element, Argv} of
|
|
{[_|_], _} ->
|
|
{ok, {Argv, [{OptCh, Element} | RevOpts]}};
|
|
{[], [Arg = [Ch | _] | Argv2]} when Ch =/= $- ->
|
|
{ok, {Argv2, [{OptCh, Arg} | RevOpts]}};
|
|
{_, _} ->
|
|
mkerror(missing_argument, OptCh)
|
|
end;
|
|
?optional ->
|
|
case Element of
|
|
[_|_] ->
|
|
{ok, {Argv, [{OptCh, Element} | RevOpts]}};
|
|
[] ->
|
|
{ok, {Argv, [OptCh | RevOpts]}}
|
|
end;
|
|
?invalid ->
|
|
mkerror(invalid_option, OptCh);
|
|
?error ->
|
|
mkerror(invalid_optstring, OptString)
|
|
end.
|
|
|
|
optch_argument(OptCh, [$+ | OptString]) -> optch_argument2(OptCh, OptString);
|
|
optch_argument(OptCh, [$- | OptString]) -> optch_argument2(OptCh, OptString);
|
|
optch_argument(OptCh, OptString) -> optch_argument2(OptCh, OptString).
|
|
|
|
optch_argument2(_OptCh, []) -> ?invalid;
|
|
optch_argument2(_OptCh, [$: | _]) -> ?error;
|
|
optch_argument2(OptCh, [OptCh, $:, $: | _]) -> ?optional;
|
|
optch_argument2(OptCh, [OptCh, $: | _]) -> ?required;
|
|
optch_argument2(OptCh, [OptCh | _]) -> ?no;
|
|
optch_argument2(OptCh, [_OptCh2, $:, $: | OptString]) -> optch_argument2(OptCh, OptString);
|
|
optch_argument2(OptCh, [_OptCh2, $: | OptString]) -> optch_argument2(OptCh, OptString);
|
|
optch_argument2(OptCh, [_OptCh2 | OptString]) -> optch_argument2(OptCh, OptString).
|
|
|
|
%% Single-Dash Options ---------------------------------------------------------
|
|
|
|
parse_single_dash(Element, Argv, OptString, LongOpts, RevOpts) ->
|
|
case parse_long(Element, Argv, LongOpts, RevOpts, _IsSingleDash = true) of
|
|
{ok, {_Argv1, _RevOpts1}} = Result ->
|
|
case parse_element(Element, Argv, OptString, RevOpts) of
|
|
{error, _Reason} -> Result;
|
|
{ok, {_Argv2, _RevOpts2}} -> mkerror(ambiguous_option, Element)
|
|
end;
|
|
{error, _Reason} -> parse_element(Element, Argv, OptString, RevOpts)
|
|
end.
|
|
|
|
%% Long Options ----------------------------------------------------------------
|
|
|
|
parse_long(Long, Argv, LongOpts, RevOpts, IsSingleDash) ->
|
|
[Prefix | MaybeArg] = string:split(Long, "="),
|
|
case find_longopt(Prefix, LongOpts, IsSingleDash) of
|
|
{_Name, HasArg, Val} ->
|
|
case {HasArg, MaybeArg, Argv} of
|
|
{?no, [], _} ->
|
|
{ok, {Argv, [Val | RevOpts]}};
|
|
{?no, _, _} ->
|
|
mkerror(invalid_argument_long, Prefix);
|
|
{?required, [Arg], _} ->
|
|
{ok, {Argv, [{Val, Arg} | RevOpts]}};
|
|
{?required, [], [Arg = [Ch | _] | Argv2]} when Ch =/= $- ->
|
|
{ok, {Argv2, [{Val, Arg} | RevOpts]}};
|
|
{?required, [], _} ->
|
|
mkerror(missing_argument_long, Prefix);
|
|
{?optional, [Arg], _} ->
|
|
{ok, {Argv, [{Val, Arg} | RevOpts]}};
|
|
{?optional, [], _} ->
|
|
{ok, {Argv, [Val | RevOpts]}};
|
|
{_, _, _} ->
|
|
erlang:error(badarg)
|
|
end;
|
|
?invalid ->
|
|
mkerror(invalid_option_long, Prefix);
|
|
?ambiguous ->
|
|
mkerror(ambiguous_option, Prefix)
|
|
end.
|
|
|
|
find_longopt(Prefix, LongOpts, IsSingleDash) ->
|
|
find_longopt(Prefix, LongOpts, IsSingleDash, ?invalid).
|
|
|
|
find_longopt(_Prefix, [], _IsSingleDash, Candidate) -> Candidate;
|
|
find_longopt(Prefix, [Option = {Name, _HasArg, _Val} | LongOpts], IsSingleDash, Candidate) ->
|
|
case longopt_prefix(Name, Prefix, IsSingleDash) of
|
|
nomatch -> find_longopt(Prefix, LongOpts, IsSingleDash, Candidate);
|
|
[] -> Option;
|
|
_ ->
|
|
case is_unambiguous(Candidate, Option) of
|
|
true -> find_longopt(Prefix, LongOpts, IsSingleDash, Option);
|
|
false -> ?ambiguous
|
|
end
|
|
end;
|
|
find_longopt(_Prefix, _LongOpts, _IsSingleDash, _Candidate) -> erlang:error(badarg).
|
|
|
|
is_unambiguous(?invalid, _Option) -> true;
|
|
is_unambiguous({_Name1, HasArg, Val}, {_Name2, HasArg, Val}) -> true;
|
|
is_unambiguous(_, _) -> false.
|
|
|
|
longopt_prefix([$- | Name], Prefix, _IsSingleDash) -> string:prefix(Name, Prefix);
|
|
longopt_prefix(_Name, _Prefix, _IsSingleDash = true) -> nomatch;
|
|
longopt_prefix(Name, Prefix, _IsSingleDash) -> string:prefix(Name, Prefix).
|
|
|
|
%% Error Formatting ------------------------------------------------------------
|
|
|
|
mkerror(Tag, Data) ->
|
|
{error, {?MODULE, {Tag, Data}}}.
|
|
|
|
-spec format_error(term()) -> io_lib:chars().
|
|
format_error(Reason) ->
|
|
case Reason of
|
|
{missing_argument, OptCh} ->
|
|
io_lib:format("missing argument to -~c", [OptCh]);
|
|
{invalid_option, OptCh} ->
|
|
io_lib:format("invalid option -~c", [OptCh]);
|
|
{invalid_optstring, OptString} ->
|
|
io_lib:format("invalid optstring ~p", [OptString]);
|
|
{invalid_argument_long, Prefix} ->
|
|
io_lib:format("invalid argument to --~s", [Prefix]);
|
|
{missing_argument_long, Prefix} ->
|
|
io_lib:format("missing argument to --~s", [Prefix]);
|
|
{invalid_option_long, Prefix} ->
|
|
io_lib:format("invalid option --~s", [Prefix]);
|
|
{ambiguous_option, Prefix} ->
|
|
io_lib:format("ambiguous option --~s", [Prefix]);
|
|
_ ->
|
|
io_lib:format("~p", [Reason])
|
|
end.
|