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. |