| 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_all_states/1, | |
| 6 | write_uml_sequence_chart/1]). | |
| 7 | ||
| 8 | :- use_module(probsrc(module_information)). | |
| 9 | :- module_info(group,dot). | |
| 10 | :- module_info(description,'This module generates UML diagrams for PlantUML.'). | |
| 11 | ||
| 12 | :- use_module(library(lists)). | |
| 13 | ||
| 14 | :- use_module(probsrc(specfile)). | |
| 15 | :- use_module(probsrc(tcltk_interface)). | |
| 16 | :- use_module(probsrc(state_space), [transition/4, op_trace_ids/1, visited_expression/2]). | |
| 17 | :- use_module(probsrc(bmachine), [b_definition_prefixed/5, b_get_definition/5, type_with_errors/4]). | |
| 18 | :- use_module(probsrc(debug), [debug_println/2]). | |
| 19 | :- use_module(probsrc(translate), [translate_bvalue/2, translate_event_with_limit/3]). | |
| 20 | :- use_module(probsrc(eval_let_store),[extend_typing_scope_for_stored_lets/2]). | |
| 21 | :- use_module(probsrc(error_manager),[add_internal_error/2, add_error/3, add_message/4, add_warning/4]). | |
| 22 | :- use_module(probsrc(self_check)). | |
| 23 | ||
| 24 | ||
| 25 | % generate UML sequence chart from history for use with PlantUML | |
| 26 | write_uml_sequence_chart_all_states(Files) :- | |
| 27 | op_trace_ids(TIDs), | |
| 28 | length(Files, FLen), | |
| 29 | length(TIDs, TLen), | |
| 30 | (FLen == TLen -> true | |
| 31 | ; add_internal_error('Number of files does not match trace length.',write_uml_sequence_chart_all_states(Files))), | |
| 32 | write_uml_sequence_chart_all_states(Files,TIDs). | |
| 33 | write_uml_sequence_chart_all_states([],[]). | |
| 34 | write_uml_sequence_chart_all_states([File|T],[ID|IDT]) :- | |
| 35 | write_uml_sequence_chart(File,[ID|IDT]), | |
| 36 | write_uml_sequence_chart_all_states(T,IDT). | |
| 37 | ||
| 38 | write_uml_sequence_chart(File) :- | |
| 39 | op_trace_ids(TIDs), | |
| 40 | write_uml_sequence_chart(File,TIDs). | |
| 41 | write_uml_sequence_chart(File,TIDs) :- | |
| 42 | open(File,write,Stream), | |
| 43 | call_cleanup(print_uml_sequence_chart_aux(TIDs,Stream), | |
| 44 | close(Stream)). | |
| 45 | ||
| 46 | print_uml_sequence_chart_aux(TIDs,Stream) :- | |
| 47 | get_history_transition_terms(TIDs,Terms), | |
| 48 | format(Stream,'@startuml~n',[]), | |
| 49 | % format(Stream,'autonumber~n',[]), | |
| 50 | (last(transition_from(StateId,_),Terms) -> true ; StateId=root), | |
| 51 | print_uml_actors(Stream,StateId), | |
| 52 | maplist(print_seq_chart_transition(Stream),Terms), | |
| 53 | format(Stream,'@enduml~n',[]). | |
| 54 | ||
| 55 | :- use_module(probsrc(bmachine),[b_get_typed_expression_definition/3]). | |
| 56 | :- use_module(probsrc(custom_explicit_sets),[expand_custom_set_to_list/4]). | |
| 57 | :- use_module(probsrc(bsyntaxtree), [get_texpr_pos/2]). | |
| 58 | :- use_module(probsrc(state_space),[visited_expression/2]). | |
| 59 | :- use_module(probsrc(specfile),[expand_const_and_vars_to_full_store/2]). | |
| 60 | ||
| 61 | print_uml_actors(Stream,StateId) :- | |
| 62 | b_get_typed_expression_definition('SEQUENCE_CHART_ACTORS',[variables_and_additional_defs],AExpr), | |
| 63 | % should be constants instead of variables; TODO: evaluate in StateId | |
| 64 | get_texpr_pos(AExpr,Pos), | |
| 65 | visited_expression(StateId,State),expand_const_and_vars_to_full_store(State,BState), | |
| 66 | b_interpreter:b_compute_expression_nowf(AExpr,[],BState,Val,'SEQUENCE_CHART_ACTORS',0), | |
| 67 | expand_custom_set_to_list(Val,ExpandedVal,_Done,'SEQUENCE_CHART_ACTORS'), | |
| 68 | if(get_actor_fields(Fields,ExpandedVal), | |
| 69 | print_uml_actor(Stream,Fields,Pos), | |
| 70 | add_warning(uml_generator,'SEQUENCE_CHART_ACTORS should return set of records {rec(name:"N",kind:"actor",color:"green")}, not: ',Val,Pos)), | |
| 71 | fail. | |
| 72 | print_uml_actors(_,_). | |
| 73 | ||
| 74 | get_actor_fields(Fields,ExpandedVal) :- | |
| 75 | member(rec(Fields),ExpandedVal). | |
| 76 | get_actor_fields(Fields,ExpandedVal) :- | |
| 77 | member((int(_),rec(Fields)),ExpandedVal). % we can influence the order of actors by using a sequence | |
| 78 | ||
| 79 | :- use_module(probsrc(kernel_strings),[to_b_string/2]). | |
| 80 | print_uml_actor(Stream,Fields,Pos) :- | |
| 81 | (member(field(id,NN),Fields) -> true ; member(field(name,NN),Fields) -> true | |
| 82 | ; add_warning(uml_generator,'Missing name field: ',Kind,Pos), fail), | |
| 83 | to_b_string(NN,string(Name)), | |
| 84 | (member(field(color,CC),Fields) -> to_b_string(CC,string(Color)) ; Color=''), | |
| 85 | (member(field(kind,KK),Fields) | |
| 86 | -> to_b_string(KK,string(Kind)), | |
| 87 | (actor_kind(Kind) -> true ; add_warning(uml_generator,'Unknown actor kind: ',Kind,Pos)) | |
| 88 | ; Kind='participant'), | |
| 89 | (Color='' -> format(Stream,'~w ~w~n',[Kind,Name]) | |
| 90 | ; format(Stream,'~w ~w #~w~n',[Kind,Name,Color])). | |
| 91 | ||
| 92 | actor_kind(actor). | |
| 93 | actor_kind(boundary). | |
| 94 | actor_kind(control). | |
| 95 | actor_kind(entity). | |
| 96 | actor_kind(database). | |
| 97 | actor_kind(collections). | |
| 98 | actor_kind(queue). | |
| 99 | ||
| 100 | ||
| 101 | % try to find user-provided SEQUENCE_CHART definition for event, indicating the labels and arrow kind | |
| 102 | print_seq_chart_transition(Stream,transition_from(CurStateID,Term)) :- | |
| 103 | specfile:get_operation_name(Term,OpName), | |
| 104 | b_definition_prefixed(expression,'SEQUENCE_CHART_',OpName,DefName,_Pos), | |
| 105 | debug_println(19,found_def(DefName)), | |
| 106 | get_operation_arguments(Term,OpArgs), | |
| 107 | b_get_definition(DefName,expression,DefArgs,RawSubst,_Deps), | |
| 108 | arg(1,RawSubst,Pos), | |
| 109 | length(DefArgs,DefNrArgs), | |
| 110 | maplist(gen_raw_arg(Pos),OpArgs,RawArgs), | |
| 111 | (prefix_length(RawArgs,DefRawArgs,DefNrArgs) | |
| 112 | -> true % we allow the DEFINITION to take fewer arguments; possibly useful when ANY variables lifted to args | |
| 113 | ; add_warning(write_uml_sequence_chart,'DEFINITION has too many arguments: ',DefName/DefNrArgs,Pos), | |
| 114 | fail | |
| 115 | ), | |
| 116 | extend_typing_scope_for_stored_lets([prob_ids(visible),variables_and_additional_defs],Scope), | |
| 117 | %add_message(seq_chart,'Typing DEFINITION for UML Sequence Chart: ',DefName,Pos), | |
| 118 | type_with_errors(definition(Pos,DefName,DefRawArgs),Scope,_Type,TypedExpr), | |
| 119 | visited_expression(CurStateID,State), | |
| 120 | (state_corresponds_to_set_up_constants(State,BState) -> true | |
| 121 | ; BState=[] | |
| 122 | ), | |
| 123 | tcltk_interface:b_compute_expression_with_prob_ids(TypedExpr,BState,Value), | |
| 124 | process_uml_bvalue(Value,Term,DefName,Pos,Stream), | |
| 125 | !. | |
| 126 | print_seq_chart_transition(Stream,transition_from(_,Term)) :- | |
| 127 | specfile:get_operation_name(Term,OpName), | |
| 128 | specfile:get_operation_arguments(Term,OpArgs), length(OpArgs,Len), | |
| 129 | translate_event_with_limit(Term,100,TS), | |
| 130 | format('No SEQUENCE_CHART_~w/~w DEFINITION found for transition ~w~n',[OpName,Len,TS]), | |
| 131 | format(Stream,'main --> main: ~w~n',[TS]). | |
| 132 | ||
| 133 | % we support ("ActorFrom","ActorTo") | |
| 134 | % and ("ActorFrom","ArrowStyle","ActorTo") which corresponds to (("ActorFrom","ArrowStyle"),"ActorTo") | |
| 135 | % and ("ActorFrom","ArrowStyle","ArrowSuffix","ActorTo") | |
| 136 | % and rec(from:AF, to:AT, arrow:"-->", suffix: "") | |
| 137 | process_uml_bvalue(rec(Fields),OperationTerm,DefName,Pos,Stream) :- | |
| 138 | (select(field(from,ActorFrom),Fields,Fields1) | |
| 139 | -> translate_bvalue(ActorFrom,AF) | |
| 140 | ; add_message(uml_generator,'Record in definition has no \'from\' field: ',DefName,Pos), | |
| 141 | AF = '??', Fields1=Fields), | |
| 142 | (select(field(to,ActorTo),Fields1,Fields2) -> translate_bvalue(ActorTo,AT) | |
| 143 | ; add_message(uml_generator,'Record in definition has no \'to\' field: ',DefName,Pos), | |
| 144 | AT=AF, Fields2=Fields1), | |
| 145 | (member(field(arrow,string(ArrowStyle)),Fields2) | |
| 146 | -> (valid_plant_uml_arrow_style(ArrowStyle,Pos) -> true | |
| 147 | ; add_message(uml_generator,'Unrecognised arrow field: ',ArrowStyle,Pos) | |
| 148 | ) | |
| 149 | ; ArrowStyle='-->'), | |
| 150 | (member(field(suffix,SuffixVal),Fields2) | |
| 151 | -> to_b_string(SuffixVal,string(StrSuffix)), | |
| 152 | check_valid_plant_uml_arrow_suffix(StrSuffix,Suffix,Pos) | |
| 153 | ; Suffix=''), | |
| 154 | translate_event_with_limit(OperationTerm,100,TS), !, | |
| 155 | format(Stream,'~w ~w ~w ~w : ~w~n',[AF,ArrowStyle,AT, Suffix,TS]). | |
| 156 | process_uml_bvalue((From,ActorTo),OperationTerm,_,Pos,Stream) :- | |
| 157 | get_arrow_style(From,ActorFrom,ArrowStyle,Suffix,Pos), | |
| 158 | translate_bvalue(ActorFrom,AF), translate_bvalue(ActorTo,AT), | |
| 159 | translate_event_with_limit(OperationTerm,100,TS), !, | |
| 160 | format(Stream,'~w ~w ~w ~w : ~w~n',[AF,ArrowStyle,AT, Suffix,TS]). | |
| 161 | process_uml_bvalue(string(''),_,_,_,_Stream) :- !. % ignore this event | |
| 162 | process_uml_bvalue(string(Str),_,_,_,Stream) :- | |
| 163 | !, | |
| 164 | format(Stream, '~w~n', [Str]). % raw print, user has specified the whole line | |
| 165 | process_uml_bvalue(Value,_,_DefName,Pos,_) :- | |
| 166 | add_warning(write_uml_sequence_chart,'Unexpected value for UML sequence chart: ',Value,Pos), | |
| 167 | fail. | |
| 168 | ||
| 169 | ||
| 170 | get_arrow_style(((From,string(Arrow)),string(StrSuffix)),From,Arrow,Suffix,Pos) :- | |
| 171 | valid_plant_uml_arrow_style(Arrow,Pos), | |
| 172 | check_valid_plant_uml_arrow_suffix(StrSuffix,Suffix,Pos),!. | |
| 173 | get_arrow_style((From,string(Arrow)),From,Arrow,'',Pos) :- valid_plant_uml_arrow_style(Arrow,Pos),!. | |
| 174 | get_arrow_style(From,From,'-->','',_). | |
| 175 | ||
| 176 | ||
| 177 | % see https://plantuml.com/sequence-diagram | |
| 178 | valid_plant_uml_arrow_suffix(nothing,''). | |
| 179 | valid_plant_uml_arrow_suffix('',''). % nothing | |
| 180 | valid_plant_uml_arrow_suffix(activate,'++'). | |
| 181 | valid_plant_uml_arrow_suffix('++','++'). % activate the target; TO DO: can be followed by color | |
| 182 | valid_plant_uml_arrow_suffix(deactivate,'--'). | |
| 183 | valid_plant_uml_arrow_suffix('--','--'). % deactivate source | |
| 184 | valid_plant_uml_arrow_suffix(create,'**'). | |
| 185 | valid_plant_uml_arrow_suffix('**','**'). % Create an instance of the target | |
| 186 | valid_plant_uml_arrow_suffix(destroy,'!!'). | |
| 187 | valid_plant_uml_arrow_suffix('!!','!!'). % Destroy an instance of the target | |
| 188 | ||
| 189 | ||
| 190 | check_valid_plant_uml_arrow_suffix(Arrow,Res,_) :- valid_plant_uml_arrow_suffix(Arrow,R),!, Res=R. | |
| 191 | check_valid_plant_uml_arrow_suffix(Arrow,Res,Pos) :- | |
| 192 | add_message(write_uml_sequence_chart,'Unrecognized plantUML arrow suffix (use nothing,++,--,**,!!): ',Arrow,Pos), | |
| 193 | Res=Arrow. | |
| 194 | ||
| 195 | :- assert_must_succeed( uml_generator:valid_plant_uml_arrow_style('-[#green]>',unknown) ). | |
| 196 | :- assert_must_succeed( uml_generator:valid_plant_uml_arrow_style('-[#green]->',unknown) ). | |
| 197 | :- assert_must_succeed( uml_generator:valid_plant_uml_arrow_style('-[#blue]>',unknown) ). | |
| 198 | :- assert_must_succeed( uml_generator:valid_plant_uml_arrow_style('-[#red]>',unknown) ). | |
| 199 | :- assert_must_succeed( uml_generator:valid_plant_uml_arrow_style('-[#0000FF]>',unknown) ). | |
| 200 | ||
| 201 | % add a final x to denote a lost message | |
| 202 | % use \ or / instead of < or > to have only the bottom or top part of the arrow | |
| 203 | % repeat the arrow head (for example, >> or //) head to have a thin drawing | |
| 204 | % use -- instead of - to have a dotted arrow | |
| 205 | % add a final "o" at arrow head | |
| 206 | % use bidirectional arrow <-> | |
| 207 | valid_plant_uml_arrow_style('-->',_). | |
| 208 | valid_plant_uml_arrow_style('->',_). | |
| 209 | valid_plant_uml_arrow_style('->x',_). | |
| 210 | valid_plant_uml_arrow_style('->>',_). | |
| 211 | valid_plant_uml_arrow_style('-\\',_). | |
| 212 | valid_plant_uml_arrow_style('\\\\-',_). | |
| 213 | valid_plant_uml_arrow_style('//--',_). | |
| 214 | valid_plant_uml_arrow_style('->o',_). | |
| 215 | valid_plant_uml_arrow_style('o\\\\--',_). | |
| 216 | valid_plant_uml_arrow_style('<->',_). | |
| 217 | valid_plant_uml_arrow_style('<->o',_). | |
| 218 | valid_plant_uml_arrow_style('<-',_). | |
| 219 | valid_plant_uml_arrow_style('<--',_). % TO DO: other reverse arrows | |
| 220 | % TODO: things like o<<--[#green]>o are also allowed | |
| 221 | valid_plant_uml_arrow_style(Arrow,Pos) :- atom_codes(Arrow,Codes), | |
| 222 | % detect patterns like '-[#green]->' | |
| 223 | Codes = [0'-, 0'[ | RestCodes], | |
| 224 | append(ColorCodes,[0']|Rest],RestCodes), | |
| 225 | ? | valid_end_arrow_codes(Rest),!, |
| 226 | ? | (valid_plant_uml_color_codes(ColorCodes) -> true |
| 227 | ; add_message(write_uml_sequence_chart,'Unrecognized plantUML color in arrow: ',Arrow,Pos)). | |
| 228 | valid_plant_uml_arrow_style(Arrow,Pos) :- | |
| 229 | add_message(write_uml_sequence_chart,'Unrecognized plantUML arrow: ',Arrow,Pos). | |
| 230 | ||
| 231 | valid_end_arrow_codes(">"). | |
| 232 | valid_end_arrow_codes("->"). | |
| 233 | ||
| 234 | % from https://plantuml.com/color | |
| 235 | % You can use specify fill and line colors either: | |
| 236 | % with its standard name or CSS name | |
| 237 | % using HEX value (6 digits): #RRGGBB | |
| 238 | % using HEX value (8 digits) with alpha compositing or RGBA color model: #RRGGBBaa | |
| 239 | % using short HEX value (3 digits): #RGB (so #ABC means #AABBCC) | |
| 240 | % using very short HEX value (1 digits): #x which is a shortcut for #xxxxxx (so you get some gray) | |
| 241 | % A special color values: transparent can be used, synonym of transparent black (#00000000). | |
| 242 | % see also https://www.w3schools.com/colors/colors_names.asp | |
| 243 | % TODO: support gradients | |
| 244 | ||
| 245 | :- use_module(probsrc(tools_matching),[is_svg_color_name/1]). | |
| 246 | valid_plant_uml_color_codes([0'#|TC]) :- % accept things like #green | |
| 247 | atom_codes(Color,TC), | |
| 248 | (maplist(hex_code,TC) -> true %we do not check length is 1,3,6,8 | |
| 249 | ; is_svg_color_name(Color) | |
| 250 | ; Color = transparent). | |
| 251 | ||
| 252 | hex_code(C) :- C >= 48, C =< 57, !. | |
| 253 | hex_code(C) :- C >= 97, C =< 102, !. | |
| 254 | hex_code(C) :- C >= 65, C =< 70, !. | |
| 255 | ||
| 256 | ||
| 257 | % gen a raw value argument to pass to a DEFINITION call | |
| 258 | gen_raw_arg(Pos,Val,value(Pos,Val)). | |
| 259 | ||
| 260 | ||
| 261 | % get current history as transition terms with starting state id: | |
| 262 | get_history_transition_terms(IDT,Terms) :- | |
| 263 | reverse(IDT,RIDT), | |
| 264 | get_transition_terms(RIDT,root,Terms). | |
| 265 | ||
| 266 | get_transition_terms([],_CurrentState,[]). | |
| 267 | get_transition_terms([TransId|Rest],CurID,[transition_from(CurID,Term)|TRes]) :- | |
| 268 | transition(CurID,Term,TransId,DestID),!, | |
| 269 | get_transition_terms(Rest,DestID,TRes). | |
| 270 | get_transition_terms([TransId|_],CurrentState,_) :- | |
| 271 | add_error(get_transition_terms,'Could not execute transition id: ', TransId:from(CurrentState)),fail. |