1		% (c) 2009-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2		% Heinrich Heine Universitaet Duesseldorf
3		% This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5		:- module(uml_generator,[write_uml_sequence_chart/1]).
6
7		:- use_module(probsrc(module_information)).
8		:- module_info(group,dot).
9		:- module_info(description,'This module generates UML diagrams for PlantUML.').
10
11		:- use_module(library(lists)).
12
13		:- use_module(probsrc(specfile)).
14		:- use_module(probsrc(tcltk_interface)).
15		:- use_module(probsrc(state_space), [transition/4, op_trace_ids/1, visited_expression/2]).
16		:- use_module(probsrc(bmachine), [b_definition_prefixed/5, b_get_definition/5, type_with_errors/4]).
17		:- use_module(probsrc(debug), [debug_println/2]).
18		:- use_module(probsrc(translate), [translate_bvalue/2, translate_event_with_limit/3]).
19		:- use_module(probsrc(eval_let_store),[extend_typing_scope_for_stored_lets/2]).
20		:- use_module(probsrc(error_manager),[add_error/3]).
21
22
23		% generate UML sequence chart from history for use with PlantUML
24
25		write_uml_sequence_chart(File) :-
26		open(File,write,Stream),
27		call_cleanup(print_uml_sequence_chart_aux(Stream),
28		close(Stream)).
29
30		print_uml_sequence_chart_aux(Stream) :-
31		get_history_transition_terms(Terms),
32		format(Stream,'@startuml~n',[]),
33		% format(Stream,'autonumber~n',[]),
34		maplist(print_seq_chart_transition(Stream),Terms),
35		format(Stream,'@enduml~n',[]).
36
37		% try to find user-provided SEQUENCE_CHART definition for event, indicating the labels and arrow kind
38		print_seq_chart_transition(Stream,transition_from(CurStateID,Term)) :-
39		specfile:get_operation_name(Term,OpName),
40		b_definition_prefixed(expression,'SEQUENCE_CHART_',OpName,DefName,_Pos),
41		debug_println(19,found_def(DefName)),
42		get_operation_arguments(Term,OpArgs),
43		b_get_definition(DefName,expression,DefArgs,RawSubst,_Deps),
44		arg(1,RawSubst,Pos),
45		length(DefArgs,DefNrArgs),
46		maplist(gen_raw_arg(Pos),OpArgs,RawArgs),
47		(prefix_length(RawArgs,DefRawArgs,DefNrArgs)
48		-> true % we allow the DEFINITION to take fewer arguments; possibly useful when ANY variables lifted to args
49		; add_warning(write_uml_sequence_chart,'DEFINITION has too many arguments: ',DefName/DefNrArgs,Pos),
50		fail
51		),
52		extend_typing_scope_for_stored_lets([prob_ids(visible),variables],Scope),
53		%add_message(seq_chart,'Typing DEFINITION for UML Sequence Chart: ',DefName,Pos),
54		type_with_errors(definition(Pos,DefName,DefRawArgs),Scope,_Type,TypedExpr),
55		visited_expression(CurStateID,State),
56		(state_corresponds_to_set_up_constants(State,BState) -> true
57		; BState=[]
58		),
59		tcltk_interface:b_compute_expression_with_prob_ids(TypedExpr,BState,Value),
60		process_uml_bvalue(Value,Term,Pos,Stream),
61		!.
62		print_seq_chart_transition(Stream,transition_from(_,Term)) :-
63		specfile:get_operation_name(Term,OpName),
64		specfile:get_operation_arguments(Term,OpArgs), length(OpArgs,Len),
65		translate_event_with_limit(Term,100,TS),
66		format('No SEQUENCE_CHART_~w/~w DEFINITION found for transition ~w~n',[OpName,Len,TS]),
67		format(Stream,'main --> main: ~w~n',[TS]).
68
69		% we support ("ActorFrom","ActorTo")
70		% and ("ActorFrom","ArrowStyle","ActorTo") which corresponds to (("ActorFrom","ArrowStyle"),"ActorTo")
71		% and ("ActorFrom","ArrowStyle","ArrowSuffix","ActorTo")
72		process_uml_bvalue((From,ActorTo),Term,_,Stream) :-
73		get_arrow_style(From,ActorFrom,ArrowStyle,Suffix),
74		translate_bvalue(ActorFrom,AF), translate_bvalue(ActorTo,AT),
75		translate_event_with_limit(Term,100,TS), !,
76		format(Stream,'~w ~w ~w ~w : ~w~n',[AF,ArrowStyle,AT, Suffix,TS]).
77		% TODO: allow record with named fields
78		process_uml_bvalue(string(''),_,_,_Stream) :- !. % ignore this event
79		process_uml_bvalue(string(Str),_,_,Stream) :-
80		!,
81		format(Stream, '~w~n', [Str]). % raw print, user has specified the whole line
82		process_uml_bvalue(Value,_,Pos,_) :-
83		add_warning(write_uml_sequence_chart,'Unexpected value for UML sequence chart: ',Value,Pos),
84		fail.
85
86		get_arrow_style(((From,string(Arrow)),string(Suffix)),From,Arrow,Suffix) :-
87		valid_plant_uml_arrow_style(Arrow),
88		valid_plant_uml_arrow_suffix(Suffix),!.
89		get_arrow_style((From,string(Arrow)),From,Arrow,'') :- valid_plant_uml_arrow_style(Arrow),!.
90		get_arrow_style(From,From,'-->','').
91
92
93		% see https://plantuml.com/sequence-diagram
94		valid_plant_uml_arrow_suffix(''). % nothing
95		valid_plant_uml_arrow_suffix('++'). % activate the target; TO DO: can be followed by color
96		valid_plant_uml_arrow_suffix('--'). % deactivate source
97		valid_plant_uml_arrow_suffix('**'). % Create an instance of the target
98		valid_plant_uml_arrow_suffix('!!'). % Destroy an instance of the target
99		valid_plant_uml_arrow_suffix(Arrow) :-
100		add_message(write_uml_sequence_chart,'Unrecognized plantUML arrow suffix (use ++,--,**,!!): ',Arrow).
101
102		valid_plant_uml_arrow_style('-->').
103		valid_plant_uml_arrow_style('->').
104		valid_plant_uml_arrow_style('->x').
105		valid_plant_uml_arrow_style('->>').
106		valid_plant_uml_arrow_style('-\\').
107		valid_plant_uml_arrow_style('\\\\-').
108		valid_plant_uml_arrow_style('//--').
109		valid_plant_uml_arrow_style('->o').
110		valid_plant_uml_arrow_style('o\\\\--').
111		valid_plant_uml_arrow_style('<->').
112		valid_plant_uml_arrow_style('<->o').
113		valid_plant_uml_arrow_style('-[#green]>').
114		valid_plant_uml_arrow_style('-[#green]->').
115		valid_plant_uml_arrow_style('-[#blue]->').
116		valid_plant_uml_arrow_style('-[#red]->'). % TO DO allow more colors? https://plantuml.com/color https://www.w3schools.com/colors/colors_names.asp
117		valid_plant_uml_arrow_style('-[#red]>').
118		valid_plant_uml_arrow_style('-[#0000FF]->').
119		valid_plant_uml_arrow_style('<-').
120		valid_plant_uml_arrow_style('<--'). % TO DO: other reverse arrows
121		valid_plant_uml_arrow_style(Arrow) :- add_message(write_uml_sequence_chart,'Unrecognized plantUML arrow: ',Arrow).
122
123		% gen a raw value argument to pass to a DEFINITION call
124		gen_raw_arg(Pos,Val,value(Pos,Val)).
125
126
127		% get current history as transition terms with starting state id:
128		get_history_transition_terms(Terms) :-
129		op_trace_ids(IDT), reverse(IDT,RIDT),
130		get_transition_terms(RIDT,root,Terms).
131
132		get_transition_terms([],_CurrentState,[]).
133		get_transition_terms([TransId|Rest],CurID,[transition_from(CurID,Term)|TRes]) :-
134		transition(CurID,Term,TransId,DestID),!,
135		get_transition_terms(Rest,DestID,TRes).
136		get_transition_terms([TransId|_],CurrentState,_) :-
137		add_error(get_transition_terms,'Could not execute transition id: ', TransId:from(CurrentState)),fail.