uml_generator

actor_kind(actor).

actor_kind(boundary).

actor_kind(control).

actor_kind(entity).

actor_kind(database).

actor_kind(collections).

actor_kind(queue).

check_valid_plant_uml_arrow_suffix(Arrow,Res,_) :- valid_plant_uml_arrow_suffix(Arrow,R),!, Res=R.

check_valid_plant_uml_arrow_suffix(Arrow,Res,Pos) :-
    add_message(write_uml_sequence_chart,'Unrecognized plantUML arrow suffix (use nothing,++,--,**,!!): ',Arrow,Pos),
    Res=Arrow.

gen_raw_arg(Pos,Val,value(Pos,Val)).

get_actor_fields(Fields,ExpandedVal) :-
    member(rec(Fields),ExpandedVal).

get_actor_fields(Fields,ExpandedVal) :-
    member((int(_),rec(Fields)),ExpandedVal). % we can influence the order of actors by using a sequence

get_arrow_style(((From,string(Arrow)),string(StrSuffix)),From,Arrow,Suffix,Pos) :-
    valid_plant_uml_arrow_style(Arrow,Pos),
    check_valid_plant_uml_arrow_suffix(StrSuffix,Suffix,Pos),!.

get_arrow_style((From,string(Arrow)),From,Arrow,'',Pos) :- valid_plant_uml_arrow_style(Arrow,Pos),!.

get_arrow_style(From,From,'-->','',_).

get_history_transition_terms(IDT,Terms) :-
    reverse(IDT,RIDT),
    get_transition_terms(RIDT,root,Terms).

get_transition_terms([],_CurrentState,[]).

get_transition_terms([TransId|Rest],CurID,[transition_from(CurID,Term)|TRes]) :-
    transition(CurID,Term,TransId,DestID),!,
    get_transition_terms(Rest,DestID,TRes).

get_transition_terms([TransId|_],CurrentState,_) :-
    add_error(get_transition_terms,'Could not execute transition id: ', TransId:from(CurrentState)),fail.

hex_code(C) :- C >= 48, C =< 57, !.

hex_code(C) :- C >= 97, C =< 102, !.

hex_code(C) :- C >= 65, C =< 70, !.

print_seq_chart_transition(Stream,transition_from(CurStateID,Term)) :-
    specfile:get_operation_name(Term,OpName),
    b_definition_prefixed(expression,'SEQUENCE_CHART_',OpName,DefName,_Pos),
    debug_println(19,found_def(DefName)),
    get_operation_arguments(Term,OpArgs),
    b_get_definition(DefName,expression,DefArgs,RawSubst,_Deps),
    arg(1,RawSubst,Pos),
    length(DefArgs,DefNrArgs),
    maplist(gen_raw_arg(Pos),OpArgs,RawArgs),
    (prefix_length(RawArgs,DefRawArgs,DefNrArgs)
    -> true % we allow the DEFINITION to take fewer arguments; possibly useful when ANY variables lifted to args
    ; add_warning(write_uml_sequence_chart,'DEFINITION has too many arguments: ',DefName/DefNrArgs,Pos),
    fail
    ),
    extend_typing_scope_for_stored_lets([prob_ids(visible),variables],Scope),
    %add_message(seq_chart,'Typing DEFINITION for UML Sequence Chart: ',DefName,Pos),
    type_with_errors(definition(Pos,DefName,DefRawArgs),Scope,_Type,TypedExpr),
    visited_expression(CurStateID,State),
    (state_corresponds_to_set_up_constants(State,BState) -> true
    ; BState=[]
    ),
    tcltk_interface:b_compute_expression_with_prob_ids(TypedExpr,BState,Value),
    process_uml_bvalue(Value,Term,DefName,Pos,Stream),
    !.

print_seq_chart_transition(Stream,transition_from(_,Term)) :-
    specfile:get_operation_name(Term,OpName),
    specfile:get_operation_arguments(Term,OpArgs), length(OpArgs,Len),
    translate_event_with_limit(Term,100,TS),
    format('No SEQUENCE_CHART_~w/~w DEFINITION found for transition ~w~n',[OpName,Len,TS]),
    format(Stream,'main --> main: ~w~n',[TS]).

print_uml_actor(Stream,Fields,Pos) :-
    (member(field(id,NN),Fields) -> true ; member(field(name,NN),Fields) -> true
    ; add_warning(uml_generator,'Missing name field: ',Kind,Pos), fail),
    to_b_string(NN,string(Name)),
    (member(field(color,CC),Fields) -> to_b_string(CC,string(Color)) ; Color=''),
    (member(field(kind,KK),Fields)
    -> to_b_string(KK,string(Kind)),
    (actor_kind(Kind) -> true ; add_warning(uml_generator,'Unknown actor kind: ',Kind,Pos))
    ; Kind='participant'),
    (Color='' -> format(Stream,'~w ~w~n',[Kind,Name])
    ; format(Stream,'~w ~w #~w~n',[Kind,Name,Color])).

print_uml_actors(Stream,StateId) :-
    b_get_typed_expression_definition('SEQUENCE_CHART_ACTORS',[constants],AExpr),
    get_texpr_pos(AExpr,Pos),
    visited_expression(StateId,State),expand_const_and_vars_to_full_store(State,BState),
    b_interpreter:b_compute_expression_nowf(AExpr,[],BState,Val,'SEQUENCE_CHART_ACTORS',0),
    expand_custom_set_to_list(Val,ExpandedVal,_Done,'SEQUENCE_CHART_ACTORS'),
    if(get_actor_fields(Fields,ExpandedVal),
    print_uml_actor(Stream,Fields,Pos),
    add_warning(uml_generator,'SEQUENCE_CHART_ACTORS should return set of records {rec(name:"N",kind:"actor",color:"green")}, not: ',Val,Pos)),
    fail.

print_uml_actors(_,_).

print_uml_sequence_chart_aux(TIDs,Stream) :-
    get_history_transition_terms(TIDs,Terms),
    format(Stream,'@startuml~n',[]),
    % format(Stream,'autonumber~n',[]),
    (last(transition_from(StateId,_),Terms) -> true ; StateId=root),
    print_uml_actors(Stream,StateId),
    maplist(print_seq_chart_transition(Stream),Terms),
    format(Stream,'@enduml~n',[]).

process_uml_bvalue(rec(Fields),OperationTerm,DefName,Pos,Stream) :-
    (select(field(from,ActorFrom),Fields,Fields1)
    -> translate_bvalue(ActorFrom,AF)
    ; add_message(uml_generator,'Record in definition has no \'from\' field: ',DefName,Pos),
    AF = '??', Fields1=Fields),
    (select(field(to,ActorTo),Fields1,Fields2) -> translate_bvalue(ActorTo,AT)
    ; add_message(uml_generator,'Record in definition has no \'to\' field: ',DefName,Pos),
    AT=AF, Fields2=Fields1),
    (member(field(arrow,string(ArrowStyle)),Fields2)
    -> (valid_plant_uml_arrow_style(ArrowStyle,Pos) -> true
    ; add_message(uml_generator,'Unrecognised arrow field: ',ArrowStyle,Pos)
    )
    ; ArrowStyle='-->'),
    (member(field(suffix,SuffixVal),Fields2)
    -> to_b_string(SuffixVal,string(StrSuffix)),
    check_valid_plant_uml_arrow_suffix(StrSuffix,Suffix,Pos)
    ; Suffix=''),
    translate_event_with_limit(OperationTerm,100,TS), !,
    format(Stream,'~w ~w ~w ~w : ~w~n',[AF,ArrowStyle,AT, Suffix,TS]).

process_uml_bvalue((From,ActorTo),OperationTerm,_,Pos,Stream) :-
    get_arrow_style(From,ActorFrom,ArrowStyle,Suffix,Pos),
    translate_bvalue(ActorFrom,AF), translate_bvalue(ActorTo,AT),
    translate_event_with_limit(OperationTerm,100,TS), !,
    format(Stream,'~w ~w ~w ~w : ~w~n',[AF,ArrowStyle,AT, Suffix,TS]).

process_uml_bvalue(string(''),_,_,_,_Stream) :- !. % ignore this event

process_uml_bvalue(string(Str),_,_,_,Stream) :-
    !,
    format(Stream, '~w~n', [Str]). % raw print, user has specified the whole line

process_uml_bvalue(Value,_,_DefName,Pos,_) :-
    add_warning(write_uml_sequence_chart,'Unexpected value for UML sequence chart: ',Value,Pos),
    fail.

valid_end_arrow_codes(">").

valid_end_arrow_codes("->").

valid_plant_uml_arrow_style('-->',_).

valid_plant_uml_arrow_style('->',_).

valid_plant_uml_arrow_style('->x',_).

valid_plant_uml_arrow_style('->>',_).

valid_plant_uml_arrow_style('-\\',_).

valid_plant_uml_arrow_style('\\\\-',_).

valid_plant_uml_arrow_style('//--',_).

valid_plant_uml_arrow_style('->o',_).

valid_plant_uml_arrow_style('o\\\\--',_).

valid_plant_uml_arrow_style('<->',_).

valid_plant_uml_arrow_style('<->o',_).

valid_plant_uml_arrow_style('<-',_).

valid_plant_uml_arrow_style('<--',_). % TO DO: other reverse arrows

valid_plant_uml_arrow_style(Arrow,Pos) :- atom_codes(Arrow,Codes),
    % detect patterns like '-[#green]->'
    Codes = [0'-, 0'[ | RestCodes],
    append(ColorCodes,[0']|Rest],RestCodes),
    valid_end_arrow_codes(Rest),!,
    (valid_plant_uml_color_codes(ColorCodes) -> true
    ; add_message(write_uml_sequence_chart,'Unrecognized plantUML color in arrow: ',Arrow,Pos)).

valid_plant_uml_arrow_style(Arrow,Pos) :-
    add_message(write_uml_sequence_chart,'Unrecognized plantUML arrow: ',Arrow,Pos).

valid_plant_uml_arrow_suffix(nothing,'').

valid_plant_uml_arrow_suffix('',''). % nothing

valid_plant_uml_arrow_suffix(activate,'++').

valid_plant_uml_arrow_suffix('++','++'). % activate the target; TO DO: can be followed by color

valid_plant_uml_arrow_suffix(deactivate,'--').

valid_plant_uml_arrow_suffix('--','--'). % deactivate source

valid_plant_uml_arrow_suffix(create,'**').

valid_plant_uml_arrow_suffix('**','**'). % Create an instance of the target

valid_plant_uml_arrow_suffix(destroy,'!!').

valid_plant_uml_arrow_suffix('!!','!!'). % Destroy an instance of the target

valid_plant_uml_color_codes([0'#|TC]) :- % accept things like #green
    atom_codes(Color,TC),
    (maplist(hex_code,TC) -> true %we do not check length is 1,3,6,8
    ; is_svg_color_name(Color)
    ; Color = transparent).

write_uml_sequence_chart(File) :-
    op_trace_ids(TIDs),
    write_uml_sequence_chart(File,TIDs).

write_uml_sequence_chart(File,TIDs) :-
    open(File,write,Stream),
    call_cleanup(print_uml_sequence_chart_aux(TIDs,Stream),
    close(Stream)).

write_uml_sequence_chart_all_states(Files) :-
    op_trace_ids(TIDs),
    length(Files, FLen),
    length(TIDs, TLen),
    (FLen == TLen -> true
    ; add_internal_error('Number of files does not match trace length.',write_uml_sequence_chart_all_states(Files))),
    write_uml_sequence_chart_all_states(Files,TIDs).

write_uml_sequence_chart_all_states([],[]).

write_uml_sequence_chart_all_states([File|T],[ID|IDT]) :-
    write_uml_sequence_chart(File,[ID|IDT]),
    write_uml_sequence_chart_all_states(T,IDT).