/* ************************************************************************** */ 
/*			Author : Erick ALPHONSE                                        */
/*			         (LIPN, Universite Paris Nord, France)                 */
/*                      (erick.alphonse@lipn.univ-paris13.fr                  */
/*			         partially modified by Dominique BOUTHINON             */
/*                      (db@lipn.univ-paris13.fr)                             */
/*			         (LIPN, Universite Paris Nord, France)                 */
/*			Date   : 03/04/2014                                            */
/* ************************************************************************** */

:- module(options,[
                      parse_options/1, % -LUnparsedArg
                      parse_options/2, % +Args, -LUnparsedArg
                      set_flag_option/3, % +Handler, +InitHandler, +OptionList
                      set_attribute_option/3, % +Handler, +InitHandler, +OptionList
                      set_attribute_option/2, % +Handler, +OptionList
                      set_file_option/3, % +Handler, + InitHandler, + OptionList
                      default_handler/2, % -OldDefaultHandler/1, +NewDefaultHandler/1
                      set_help_header/1, % +Msg
                      print_help/1, %+Stream
                      print_help/0,
                      clear_option/1, % +Option
                      clear_options/0,
                      list_set_options/0,
                      list_set_options/1,
                      % default interface
                      set_option/2,    % +Option, +DefaultValue
                      current_option/2 % +Option, ?Value
                  ]).

:- dynamic parse_user_defined_option/3. % +Option, +Args, -LUnparsedArg
:- dynamic help_header/1. % -Msg
:- dynamic option_help/1. % -Msg
:- dynamic option_not_specified/1. % -NSOption
:- dynamic default_handler/1. % ?DefaultHandler


		% parse_options/1 swi-specific
		% current_prolog_flag(argv,LArg) differs depending on the way
		% the programme is compiled (i.e. static or dynamic)
parse_options(LUnparsed_args) :-
	   current_prolog_flag(argv,LArgs),
        parse_options(LArgs, LUnparsed_args).
            
parse_options(LArg,LUnparsedArg) :-
        once(( % switch
                 (LArg,LUnparsedArg) = ([],[])
             ;
                 LArg = ['--'|LUnparsedArg]
             )),
        !,
        % verify that all mandatory options have been input
        findall(Option,option_not_specified(Option),LOption),
        ( LOption \= [] ->
            forall(member(Option,LOption),(
                    format('mandatory input required:~n'),
                    once(stream_property(OStream,alias(user_output))), %
                         print_option_help(OStream,Option),
                         format(OStream,'~N',[])
                      )),
            halt
        ;
            true
        ).

parse_options(LArg,LUnparsedArg) :-
        once(( % switch
                 parse_predefined_option(LArg,RLArg)
             ;
                 parse_user_defined_option(Option,LArg,RLArg),
                 retractall(option_not_specified(Option))
             ;
                 % invalid option
                 LArg = [Arg|_],
                 atom_concat('-',_,Arg),
                 throw(error(existence_error(option,Arg),
                       context(parse_options/2,
           'Invalid option specified. Type ''--help'' for more information.')))
             ;
                 % default behaviour for unhandled Arg
                 guitracer,
                 trace,
                 LArg = [Arg|RLArg],
                 default_handler(DefaultHandler/1),
                 call(DefaultHandler,Arg)
             )),
        parse_options(RLArg,LUnparsedArg).


% predefined option parsers
% help (-h)
parse_predefined_option(['-h'|_],_) :-
        print_help(user_output),
        halt.

% help (--help)
parse_predefined_option(['--help'|_],_) :-
        print_help(user_output),
        halt.

% read from standard input
parse_predefined_option(['-'|RLArg],RLArg) :-
        default_handler(DefaultHandler,DefaultHandler),
        call(DefaultHandler,user). % compatible with consult/1


set_flag_option(Handler,InitHandler,LOption) :-
                    % a name is given to the option to simplify
       			% retrieval of its specific parsers and helps
        term_to_atom(InitHandler,OptionName), % use InitHandler as unique name
								      %% override previous value
        clear_option(OptionName),
        				   % init and record init call to display on demand
        call(InitHandler),
        assertz(called_option_handler(OptionName,InitHandler)),
								%% process LOption
        ( LOption == [] ->
            % no parsers defined
            true
        ;
            process_flag_option_list(OptionName,Handler,LOption)
        ).


			% mandatory "option": command-line input required
set_attribute_option(Handler,LOption) :-
       gtrace,
        						           % a name is given to the option to simplify
        						           % retrieval of its specific parsers and helps
        term_to_atom(Handler,OptionName),  % use Handler as unique name
								           % override previous value
        clear_option(OptionName),
        						           % init and register init to display later
        assert(option_not_specified(OptionName)), % yet
								                  % process LOption
        ( LOption == [] ->
            % no parsers defined
            true
        ;
            process_attribute_option_list(OptionName,Handler,LOption)
        ).


set_attribute_option(Handler,InitHandler,LOption) :-
        				% a name is given to the option to simplify
       					% retrieval of its specific parsers and helps
        term_to_atom(Handler,OptionName), % use Handler as unique name
						%% override previous value
        clear_option(OptionName),
        				% init and register init to display later
        call(InitHandler),
        assertz(called_option_handler(OptionName,InitHandler)),
						%% process LOption
        ( LOption == [] ->
           				 % no parsers defined
            true
        ;
            process_attribute_option_list(OptionName,Handler,LOption)
        ).
        
        
set_file_option(Handler,InitHandler,LOption) :-
        				% a name is given to the option to simplify
       			   % retrieval of its specific parsers and helps
        term_to_atom(Handler,OptionName), % use Handler as unique name
						%% override previous value
        clear_option(OptionName),
        				% init and register init to display later
        call(InitHandler),
        assertz(called_option_handler(OptionName,InitHandler)),
						%% process LOption
        ( LOption == [] ->
           				 % no parsers defined
            true
        ;
            process_file_option_list(OptionName,Handler,LOption)
        ).        
        


% add new definitions to parse_user_defined_options to parse Option related 
% command-line arguments.
% flag definition
process_flag_option_list(_,_,[]).

process_flag_option_list(Option,Handler,[short(SOption)|RLOption]) :-
        % add a help entry for SOption
        atom_concat('-',SOption,HMsg),
        assertz(option_help(Option,short,HMsg)),
        % preparation of the command line argument
        atom_concat('-',SOption,CLArg),
        assert((
                   parse_user_defined_option(Option,[Arg|LArg],LUnparsedArg) :-
                        atom_concat(CLArg,NCLArg,Arg),
                        !,
                        % call specific handler and record the call
                        call(Handler),
                        assertz(called_option_handler(Option,Handler)),
                        % defined LUnparsedArg
                        ( NCLArg == '' ->
                            % no flag options glued together
                            LUnparsedArg = LArg
                        ;
                            atom_concat('-',NCLArg,NNCLArg),
                            LUnparsedArg = [NNCLArg|LArg]
                        )                            
               )),
        process_flag_option_list(Option,Handler,RLOption).

process_flag_option_list(Option,Handler,[long(LOption)|RLOption]) :-
        % add a help entry for SOption
        atom_concat('--',LOption,HMsg),
        assertz(option_help(Option,long,HMsg)),
        % preparation of the command line argument
        atom_concat('--',LOption,CLArg),
        assert((
                   parse_user_defined_option(Option,[CLArg|LUnparsedArg],LUnparsedArg) :-
                        !,
                        % call specific handler and record the call
                        call(Handler),
                        assertz(called_option_handler(Option,Handler))
               )),
        process_flag_option_list(Option,Handler,RLOption).

process_flag_option_list(Option,Handler,[help(HMsg)|RLOption]) :-
         % add a help entry for HMsg
        assertz(option_help(Option,help,HMsg)),
        process_flag_option_list(Option,Handler,RLOption).


process_attribute_option_list(_,_,[]).

process_attribute_option_list(Option,Handler,[short(SOption)|RLOption]) :-
        % add a help entry for SOption
        atom_concat('-',SOption,HMsg),
        assertz(option_help(Option,short,HMsg)),
        % preparation of the command line argument
        atom_concat('-',SOption,CLArg),
        assert((
                   parse_user_defined_option(Option,[CLArg,CurrentValue|LUnparsedArg],LUnparsedArg) :-
                        !,
                        % call specific handler and record the call
                        call(Handler,CurrentValue),
                        assertz(called_option_handler(Option,call(Handler,CurrentValue)))
               )),
        process_attribute_option_list(Option,Handler,RLOption).

process_attribute_option_list(Option,Handler,[long(LOption)|RLOption]) :-
        % add a help entry for LOption
        concat_atom(['--',LOption,' <value>'],HMsg),
        assertz(option_help(Option,long,HMsg)),
        % preparation of the command line argument
        concat_atom(['--',LOption,'='],CLArg),
        assert((
                   parse_user_defined_option(Option,[CurrentArg|LUnparsedArg],LUnparsedArg) :-
                        atom_concat(CLArg,CurrentValue,CurrentArg),
                        !,
                        % call specific handler and record the call
                        call(Handler,CurrentValue),
                        assertz(called_option_handler(Option,call(Handler,CurrentValue)))
               )),
        process_attribute_option_list(Option,Handler,RLOption).
        
        

process_attribute_option_list(Option,Handler,[help(HMsg)|RLOption]) :-
         % add a help entry for HMsg
        assertz(option_help(Option,help,HMsg)),
        process_attribute_option_list(Option,Handler,RLOption).


	/* deal with options that have a file as argument */
process_file_option_list(_,_,[]).

process_file_option_list(Option,Handler,[short(SOption)|RLOption]) :-
        % add a help entry for SOption
        atom_concat('-',SOption,HMsg),
        assertz(option_help(Option,short,HMsg)),
        % preparation of the command line argument
        atom_concat('-',SOption,CLArg),
        assert((
                   parse_user_defined_option(Option,[CLArg,CurrentValue|LUnparsedArg],LUnparsedArg) :-
                        !,
                        % call specific handler and record the call
                        call(Handler,CurrentValue),
                        assertz(called_option_handler(Option,call(Handler,CurrentValue)))
               )),
        process_file_option_list(Option,Handler,RLOption).

process_file_option_list(Option,Handler,[long(LOption)|RLOption]) :-
        % add a help entry for LOption
        concat_atom(['--',LOption,' <fileName>'],HMsg),
        assertz(option_help(Option,long,HMsg)),
        % preparation of the command line argument
        concat_atom(['--',LOption,'='],CLArg),
        assert((
                   parse_user_defined_option(Option,[CurrentArg|LUnparsedArg],LUnparsedArg) :-
                        atom_concat(CLArg,CurrentValue,CurrentArg),
                        !,
                        % call specific handler and record the call
                        call(Handler,CurrentValue),
                        assertz(called_option_handler(Option,call(Handler,CurrentValue)))
               )),
        process_file_option_list(Option,Handler,RLOption).
        
        
process_file_option_list(Option,Handler,[help(HMsg)|RLOption]) :-
         % add a help entry for HMsg
        assertz(option_help(Option,help,HMsg)),
        process_file_option_list(Option,Handler,RLOption).



clear_option(Option) :-
        ( atom(Option) ->
            					% clear the related option parser
            retractall(parse_user_defined_option(Option,_,_)),
            					% clear option help
            retractall(option_help(Option,_,_)),
            					% clear already set options
            retractall(called_option_handler(Option,_))
        ;
            throw(error(type_error(atom,Option),context(clear_option/1,'Option must be an atom.')))
        ).


clear_options :-
        % clear everything
        setof(Option,A1^A2^(options:parse_user_defined_option(Option,A1,A2)),LOption), % list declared options without redundancy
        forall(member(Option,LOption),clear_option(Option)).
                      

list_set_options :-
        once(stream_property(Stream,alias(user_output))), % only one stream can apply
        list_set_options(Stream).


list_set_options(Stream) :-
        forall(clause(called_option_handler(_,CalledHandler),true),(
                                                                       format(Stream,':- ~q.~n',[CalledHandler])
                                                                   )).

        
%%%%%%%%%%%%%%%%%%%%
%
% help management
%
%%%%%%%%%%%%%%%%%%%%

:- dynamic short_option_position_format/1. % -SOPFormat
:- dynamic long_option_position_format/1. % -LOPFormat
:- dynamic help_position_format/1. % -HPFormat


short_option_position_format('~2|').


long_option_position_format('~4|').


help_position_format('~30|').


set_help_header(HHeader) :-
        retractall(help_header(_)),
        assert(help_header(HHeader)).


print_help :-
        once(stream_property(Stream,alias(user_output))), % only one stream can apply
        print_help(Stream).


print_help(Stream) :-
        % header
        help_header(HHMsg),
        format(Stream,HHMsg,[]),
        % options
        setof(Option,T^H^(options:option_help(Option,T,H)),LOption), % list declared options without redundancy
        forall(member(Option,LOption),(
                                            print_option_help(Stream,Option),
                                            format(Stream,'~N',[])
                                      )).


print_option_help(Stream,Option) :-
        % concat atoms to specify the final format
        % short option
        ( option_help(Option,short,SOMsg) ->
            short_option_position_format(SHPFormat),
            atom_concat(SHPFormat,SOMsg,SFormat)
        ;
            SFormat = ''
        ),
        % long option
        ( option_help(Option,long,LOMsg) ->
            % depends on the short option_help
            long_option_position_format(LHPFormat),
            ( SFormat == '' ->
                % no short option_help
                concat_atom([LHPFormat,' ',LOMsg],LFormat)
            ;
                concat_atom([SFormat,LHPFormat,',',LOMsg],LFormat)
            )
        ;
            LFormat = SFormat
        ),
        % help
        ( option_help(Option,help,HMsg) ->
            % process HMsg to fit on screen
            help_position_format(HPFormat),
            concat_atom(LHMsg,'~n',HMsg),
            atom_concat('~n',HPFormat,NHPFormat),
            concat_atom(LHMsg,NHPFormat,NHMsg),
            % output format
            concat_atom([LFormat,HPFormat,NHMsg],Format)
        ;
            Format = LFormat
        ),
        format(Stream,Format,[]).


default_handler(OldDefaultHandler,NewDefaultHandler) :-
        callable(NewDefaultHandler),
        default_handler(OldDefaultHandler),
        retractall(default_handler(_)),
        assert(default_handler(NewDefaultHandler)).



%%%%%%%%%%%%%%%%%%%%
%
% predefined handlers for default interface
%
%%%%%%%%%%%%%%%%%%%%

% default store and retrieve methods
:- dynamic set_option/2. % +Option, +Value
:- dynamic current_option/2. % +Option, ?Value


% the default initialisation handler
% define current_optiont to retrieve the pair (Option,Value)
set_option(Option,DefaultValue) :-
        % clear current_option
        retractall(current_option(Option,_)),
        assert(current_option(Option,DefaultValue)).


default_handler(consult/1).


%         concat_atom(['The handler of ',Option,' must be a 0-ary or 1-ary callable term.'],Message), 
%         throw(error(type_error(predicate_indicator,HandlerSpecification),context(set_option/3,Message))).
