1:-module(history_parser,
    2	 [translate_history/2,
    3      translate_histories/2]).    4
    5:- use_module(parser_utils).    6:- use_module(debug).    7%:- use_module(library(lists)).
    8:- [apache_log_parser].    9
   10translate_histories(InFiles,OutFile):-
   11    open(OutFile,write,Stream),
   12	write(Stream,':-module(history,[hap/2,history_is_empty/1]).'),nl(Stream),nl(Stream),
   13	translate_histories1(InFiles,Stream,Empty),
   14	write(Stream,'history_is_empty('),
   15    write(Stream,Empty),
   16    write(Stream,').'),nl(Stream),
   17% When the history is empty, SWI complains that the predicate hap/2 is not defined
   18% and raises an error. Thus, I add a definition that is always false 
   19    (Empty=yes -> write(Stream,'hap(whatever,_):- false.'), nl(Stream) ; true),
   20	close(Stream).
   21translate_histories1([],_,yes).
   22translate_histories1([InFile|Rest],Stream,Empty):-
   23    write_debug('Parsing file '), write_debug(InFile),
   24	once(parse_history(InFile,History)),
   25	writeln_debug(' --> OK'),
   26	(History = [] -> Empty=Empty1 ; Empty=no),
   27	nl(Stream),write(Stream,'%%%% '), write(Stream,InFile), write(Stream,' %%%%'), nl(Stream),
   28	write_history_to_stream(History,Stream),
   29    translate_histories1(Rest,Stream,Empty1).
   30
   31translate_history(InFile,OutFile):-
   32	parse_history(InFile,History),
   33	open(OutFile,write,Stream),
   34	write(Stream,':-module(history,[hap/2,history_is_empty/1]).'),nl(Stream),nl(Stream),
   35	write_history_to_stream_1(History,Stream),
   36	close(Stream).
   37
   38
   39parse_history(FileName,History):- % Apache Log File: name ends with "access_log"
   40    atom_concat(_,'access_log',FileName),!, % Does not remove comments, spaces, ...
   41    read_file_to_string(FileName,FileString),
   42    phrase(history(History,1),FileString).
   43parse_history(FileName,History):-
   44	read_file_to_string(FileName,FileString),
   45	drop_comments(FileString,FileString2),
   46	drop_whites(FileString2,NoWhitesString),
   47	phrase(history(History,1),NoWhitesString).
   48
   49history([],_) --> [].
   50
   51history(Events,N) --> [10], history(Events,N). % In the Apache log file case, we cannot remove whites, so we remove them here
   52history(Events,N) --> [-1], history(Events,N). % In the Apache log file case, we cannot remove whites, so we remove them here
   53history([Event|MoreEvents],N) -->
   54	event(Event),
   55	!,
   56	{N1 is N+1},
   57	history(MoreEvents,N1).
   58history([_|_],N) -->
   59    {write_error('Error in Event number '), 
   60    write_error(N), write_error(' ***'), nl, 
   61    write('see help(history).'), nl, fail}.
   62
   63event(hap(statePath(Content),Time)) -->
   64	funct('statePath'),
   65	opening_parenthesis,
   66	variable(Content),
   67	comma,
   68	time(Time),
   69	closing_parenthesis,
   70	full_stop,!.
   71
   72event(hap(end,Time)) -->
   73	funct('end'),
   74	opening_parenthesis,
   75	time(Time),
   76	closing_parenthesis,
   77	full_stop,!.
   78
   79% Accepts also events in the form hap(Event,Time)
   80event(hap(Event,Time)) -->
   81	funct('hap'),
   82	opening_parenthesis,
   83	term(Event),
   84	comma,
   85	time(Time),
   86	closing_parenthesis,
   87	full_stop,!.
   88
   89event(hap(Content,Time)) -->
   90    apache_log_hap(Content,Time),!.
   91
   92event(hap(Content,Time)) -->
   93	initial_functor(Act),
   94	society_id,
   95	dialog(Dialog),
   96	sender(Sender),
   97	receiver(Receiver),
   98	performative(Performative),
   99	performative_arguments(Arguments),
  100	event_time(Time),
  101	event_full_stop,
  102	{Content1=..[Performative|Arguments],
  103	 Content=..[Act,Sender,Receiver,Content1,Dialog]}.
  104
  105
  106
  107
  108
  109event_full_stop --> full_stop.
  110event_full_stop -->
  111    {write_error('\n*** Could not find full stop: '), fail}.
  112
  113initial_functor(Act) --> funct(Act), opening_parenthesis, !.
  114initial_functor(_) --> {write_error('\n*** Error in functor: '), fail}.
  115
  116society_id -->	"[",atomic_constant_list(_),"]",comma,!.
  117society_id --> {write_error('\n*** Error in Society ID: should be a list containing an atom'),nl, fail}.
  118
  119dialog(Dialog) --> atomic_constant(Dialog),comma,!.
  120dialog(_) --> {write_error('\n*** Error in Dialog: should be a non compound constant'),nl, fail}.
  121
  122sender(Sender) --> atomic_constant(Sender),comma,!.
  123sender(_) --> {write_error('\n*** Error in Sender: should be a non compound constant'),nl, fail}.
  124
  125receiver(Receiver) --> atomic_constant(Receiver),comma,!.
  126receiver(_) --> {write_error('\n*** Error in Receiver: should be a non compound constant'),nl, fail}.
  127
  128performative(Performative) --> funct(Performative),comma,!.
  129performative(_) --> {write_error('\n*** Error in Performative: should be a non compound constant'),nl, fail}.
  130
  131performative_arguments(Arguments) --> "[",term_list(Arguments),"]",comma,!.
  132performative_arguments(_) --> {write_error('\n*** Error in performative Arguments: should be a list of terms'),nl, fail}.
  133
  134event_time(Time) --> time(Time),closing_parenthesis,!.
  135event_time(_) --> {write_error('\n*** Error in Time: should be an integer'),nl, fail}.
  136
  137write_history_to_file(FileName,History):-
  138	open(FileName,write,Stream),
  139	write_history_to_stream(History,Stream),
  140	close(Stream).
  141
  142write_history_to_stream_1([],Stream):-
  143	!,
  144	write(Stream,'history_is_empty(yes).'),
  145	nl(Stream).
  146write_history_to_stream_1(History,Stream):-
  147	write(Stream,'history_is_empty(no).'),
  148	nl(Stream),
  149	write_history_to_stream(History,Stream).
  150
  151write_history_to_stream([],_).
  152write_history_to_stream([Event|MoreEvents],Stream):-
  153	write(Stream,Event),
  154	write(Stream,'.'),
  155	nl(Stream),
  156	write_history_to_stream(MoreEvents,Stream)