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, add_message/4]).
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,DefName,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		% and rec(from:AF, to:AT, arrow:"-->", suffix: "")
73		process_uml_bvalue(rec(Fields),OperationTerm,DefName,Pos,Stream) :-
74		(select(field(from,ActorFrom),Fields,Fields1)
75		-> translate_bvalue(ActorFrom,AF)
76		; add_message(uml_generator,'Record in definition has no \'from\' field: ',DefName,Pos),
77		AF = '??', Fields1=Fields),
78		(select(field(to,ActorTo),Fields1,Fields2) -> translate_bvalue(ActorTo,AT)
79		; add_message(uml_generator,'Record in definition has no \'to\' field: ',DefName,Pos),
80		AT=AF, Fields2=Fields1),
81		(member(field(arrow,string(ArrowStyle)),Fields2) -> true ; ArrowStyle='-->'),
82		(member(field(suffix,string(Suffix)),Fields2) -> true ; Suffix=''),
83		translate_event_with_limit(OperationTerm,100,TS), !,
84		format(Stream,'~w ~w ~w ~w : ~w~n',[AF,ArrowStyle,AT, Suffix,TS]).
85		process_uml_bvalue((From,ActorTo),OperationTerm,_,_,Stream) :-
86		get_arrow_style(From,ActorFrom,ArrowStyle,Suffix),
87		translate_bvalue(ActorFrom,AF), translate_bvalue(ActorTo,AT),
88		translate_event_with_limit(OperationTerm,100,TS), !,
89		format(Stream,'~w ~w ~w ~w : ~w~n',[AF,ArrowStyle,AT, Suffix,TS]).
90		process_uml_bvalue(string(''),_,_,_,_Stream) :- !. % ignore this event
91		process_uml_bvalue(string(Str),_,_,_,Stream) :-
92		!,
93		format(Stream, '~w~n', [Str]). % raw print, user has specified the whole line
94		process_uml_bvalue(Value,_,_DefName,Pos,_) :-
95		add_warning(write_uml_sequence_chart,'Unexpected value for UML sequence chart: ',Value,Pos),
96		fail.
97
98
99		get_arrow_style(((From,string(Arrow)),string(Suffix)),From,Arrow,Suffix) :-
100		valid_plant_uml_arrow_style(Arrow),
101		valid_plant_uml_arrow_suffix(Suffix),!.
102		get_arrow_style((From,string(Arrow)),From,Arrow,'') :- valid_plant_uml_arrow_style(Arrow),!.
103		get_arrow_style(From,From,'-->','').
104
105
106		% see https://plantuml.com/sequence-diagram
107		valid_plant_uml_arrow_suffix(''). % nothing
108		valid_plant_uml_arrow_suffix('++'). % activate the target; TO DO: can be followed by color
109		valid_plant_uml_arrow_suffix('--'). % deactivate source
110		valid_plant_uml_arrow_suffix('**'). % Create an instance of the target
111		valid_plant_uml_arrow_suffix('!!'). % Destroy an instance of the target
112		valid_plant_uml_arrow_suffix(Arrow) :-
113		add_message(write_uml_sequence_chart,'Unrecognized plantUML arrow suffix (use ++,--,**,!!): ',Arrow).
114
115		valid_plant_uml_arrow_style('-->').
116		valid_plant_uml_arrow_style('->').
117		valid_plant_uml_arrow_style('->x').
118		valid_plant_uml_arrow_style('->>').
119		valid_plant_uml_arrow_style('-\\').
120		valid_plant_uml_arrow_style('\\\\-').
121		valid_plant_uml_arrow_style('//--').
122		valid_plant_uml_arrow_style('->o').
123		valid_plant_uml_arrow_style('o\\\\--').
124		valid_plant_uml_arrow_style('<->').
125		valid_plant_uml_arrow_style('<->o').
126		valid_plant_uml_arrow_style('-[#green]>').
127		valid_plant_uml_arrow_style('-[#green]->').
128		valid_plant_uml_arrow_style('-[#blue]->').
129		valid_plant_uml_arrow_style('-[#red]->'). % TO DO allow more colors? https://plantuml.com/color https://www.w3schools.com/colors/colors_names.asp
130		valid_plant_uml_arrow_style('-[#red]>').
131		valid_plant_uml_arrow_style('-[#0000FF]->').
132		valid_plant_uml_arrow_style('<-').
133		valid_plant_uml_arrow_style('<--'). % TO DO: other reverse arrows
134		valid_plant_uml_arrow_style(Arrow) :- add_message(write_uml_sequence_chart,'Unrecognized plantUML arrow: ',Arrow).
135
136		% gen a raw value argument to pass to a DEFINITION call
137		gen_raw_arg(Pos,Val,value(Pos,Val)).
138
139
140		% get current history as transition terms with starting state id:
141		get_history_transition_terms(Terms) :-
142		op_trace_ids(IDT), reverse(IDT,RIDT),
143		get_transition_terms(RIDT,root,Terms).
144
145		get_transition_terms([],_CurrentState,[]).
146		get_transition_terms([TransId|Rest],CurID,[transition_from(CurID,Term)|TRes]) :-
147		transition(CurID,Term,TransId,DestID),!,
148		get_transition_terms(Rest,DestID,TRes).
149		get_transition_terms([TransId|_],CurrentState,_) :-
150		add_error(get_transition_terms,'Could not execute transition id: ', TransId:from(CurrentState)),fail.