/* -*- Mode: Prolog -*- */
/** @copyright
  
  This file is part of PrologDoc (http://prologdoc.sourceforge.net/).

  Copyright (C) 2004 by Salvador Fandino (sfandino@@yahoo.com)

  PrologDoc 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 2 of the License, or
  (at your option) any later version.

  PrologDoc 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 PrologDoc; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  
  @/copyright */

:- module(pd_getopts, [get_opts/2,
		       get_opts/3,
		       get_opts_error/1,
		       get_opts_error/2]).

:- use_module(library('prologdoc/pd_files')).

:- multifile check_opt/5.
:- multifile map_error/3.

get_opts(Desc, Rest) :-
	(   current_prolog_flag(argv, AllArgs),
	    append(_, ['--' |Args], AllArgs)
	->  get_opts(Args, Desc, Rest) ).

% Desc = [opt(type, long, s, default, Var), ...]
% type is one of flag, integer, number, string, list(type), file, file([opts]), 

get_opts([--|T], Desc, Rest) :-
	!,
	Rest = T,
	set_defaults(Desc).
get_opts([H|T], Desc, Rest) :-
	(   atom_chars(H, ['-','-'| LongChars])
	->  (   append(Key, ['='|Value], LongChars)
	    ->	atom_chars(Long, Key),
		atom_chars(H1, Value),
		Next = [long(H1)|T]
	    ;	atom_chars(Long, LongChars),
		Next = T )
	;   atom_chars(H, ['-', Short|Value]),
	    (	Value = []
	    ->	Next = T
	    ;	atom_chars(H1, Value),
		Next = [short(H1)|T] ) ),
	!,
	(   select(opt(Type, Long, Short, Def, Var), Desc, Desc1)
	->  (   get_opt(opt(Type, Long, Short, Def, Var), Next, H, Opt1, T1)
	    ->	get_opts(T1, [Opt1|Desc1], Rest)
	    ;	throw(getopts_error(unhandled_type(H, Type))) )
	;   throw(getopts_error(unrecognised_option(H))) ).
get_opts(['-'|_], _, _) :-
	!,
	throw(getopts_error(unrecognised_option(-))).
get_opts(Rest, Desc, Rest) :-
	set_defaults(Desc).

set_defaults([]).
set_defaults([opt(_,_,_,V,V)|T]) :-
	!,
	set_defaults(T).
set_defaults([_|T]) :-
	set_defaults(T).

get_opt(opt(list(Type), Long, Short, _, [V|More]), Args, Name, opt(list(Type), Long, Short, [], More), Args1) :-
	check_opt(Type, Args, Name, V, Args1).
get_opt(opt(Type, Long, Short, _, V), Args, Name, opt(list, Long, Short, _, V), Args1) :-
	(   var(V)
	->  check_opt(Type, Args, Name, V, Args1)
	;   throw(getopts_error(duplicate_option(Name))) ).

check_opt(flag, Args, Name, true, Args1) :-
	!,
	no_next_arg(Args, Name, Args1).
check_opt(number, Args, Name, N, Args1) :-
	!,
	next_arg(Args, Name, V, Args1),
	(   catch(atom_number(V, N),_,fail)
	->  true
	;   throw(getopts_error(bad_type(number, Name, V))) ).
check_opt(integer, Args, Name, N, Args1) :-
	!,
	next_arg(Args, Name, V, Args1),
	(   catch(atom_number(V, N),_,fail),
	    integer(N)
	->  true
	;   throw(getopts_error(bad_type(integer, Name, V))) ).
check_opt(string, Args, Name, V, Args1) :-
	!,
	next_arg(Args, Name, V, Args1).
check_opt(file, Args, Name, V, Args1) :-
	!,
	check_opt(file([]), Args, Name, V, Args1).
check_opt(file(Opts), Args, Name, File, Args1) :-
	!,
	next_arg(Args, Name, V, Args1),
	check_opt_file(Opts, V, Name, File).

check_opt_file([], V, _, V).
check_opt_file([absolute|More], V, Name, File) :-
	check_opt_file([absolute([])|More], V, Name, File).
check_opt_file([absolute(Opts)|More], V, Name, File) :-
	(   absolute_file_name(V, Opts, V1)
	->  check_opt_file(More, V1, Name, File)
	;   throw(error(existence_error(source_sink, V), _)) ).
check_opt_file([exists|More], V, Name, File) :-
	check_out_file([access(exists)|More], V, Name, File).
check_opt_file([access(Mode)|More], V, Name, File) :-
	(   access_file(V, Mode)
	->  check_opt_file(More, V, Name, File)
	;   throw(error(existence_error(source_sink, V), _)) ).
check_opt_file([dereference|More], V, Name, File) :-
	(   read_link(V, _, V1)
	->  true
	;   V1 = V ),
	check_opt_file(More, V1, Name, File).
check_opt_file([type(Type)|More], V, Name, File) :-
	(   file_is(Type, V)
	->  check_opt_file(More, V, Name, File)
	;   throw(error(existence_error(source_sink, V), _)) ).
check_opt_file([mkdir|More], V, Name, File) :-
	make_all_directories(V),
	check_opt_file(More, V, Name, File).

file_is(link, N) :-
	read_link(N, _, _).
file_is(dir, N) :-
	exists_directory(N).
file_is(file, N) :-
	exists_file(N).
file_is(nonexistent, N) :-
	\+ file_is(link, N),
	\+ file_is(dir, N),
	\+ file_is(file, N).

no_next_arg([long(_)|_], Name, _) :-
	!,
	throw(getopts_error(option_does_not_accept_argument(Name))).
no_next_arg([short(A)|M], _, [A1|M]) :-
	!,
	atom_concat('-', A, A1).
no_next_arg(A, _, A).

unpack_arg(short(V), V) :-
	!.
unpack_arg(long(V), V) :-
	!.
unpack_arg(V, V).

next_arg(Args, Name, V, Args1) :-
	(   Args = [V1|Args1]
	->  unpack_arg(V1, V)
	;   throw(getopts_error(option_argument_missing(Name))) ).

get_opts_error(E) :-
	get_opts_error(E, '').
get_opts_error(E, Usage) :-
	format(user_error, 'error: ', []),
	(   map_error(E, Msg, Vars)
	->  format(user_error, Msg, Vars)
	;   format(user_error, 'bad arguments: ~q', [E]) ),
	format(user_error, '.~n~w', [Usage]),
	abort.


map_error(getopts_error(unhandled_type(Name, Type)), 'internal error, unknow type ~q for option ~q', [Type, Name]).
map_error(getopts_error(unrecognised_option(Name)), 'bad argument ~w', [Name]).
map_error(getopts_error(option_argument_missing(Name)), 'option ~w requires an argument', [Name]).
map_error(getopts_error(duplicate_option(Name)), 'argument ~w appears twice', [Name]).
map_error(getopts_error(bad_type(Type, Name, Value)), 'invalid argument "~w" for ~w, ~w expected', [Value, Name, Type]).
map_error(getopts_error(option_does_not_accept_argument(Name)), 'option ~w does not accept argument', [Name]).
map_error(error(existence_error(source_sink, Value), _),
	  'file/directory ~w does not exist, insufficient access rigths or bad type', [Value]).
map_error(error(permission_error(Action, Type, Name), context(_, OS)),
		'insufficient access rights to ~w ~w "~w" (~w)', [Action, Type, Name, OS]).
map_error(error(existence_error(Type, Name), context(_, OS)),
		'wrong type for "~w", ~w expected (~w)', [Name, Type, OS]).