1:- module(coworkers, [wf_ask_parameter/1, wf_input_parameter/3, wf/3]).    2
    3%
    4% Sample tasks, dialog and workflow
    5%
    6task('sync git repo', [ParentRepoVersions]) :-
    7    writeln('{ Task } Synchronize Git Repo'),
    8    wf_ask_parameter(re(Repo)),
    9    wf_ask_parameter(br(Branch)),
   10    format(string(Message), 'syncing repo ~w branch ~w', [Repo, Branch]),
   11    % will call groovy template
   12    % Temp
   13    ParentRepoVersions = [repo_a_ve("1.0.7"),
   14                          repo_b_ve("3.3.5"),
   15                          repo_c_ve("2.0.11")],
   16    writeln(Message).
   17
   18task('modify parent repo versions', [ParentRepoVersions]) :-
   19    writeln('{ Task } Modify Versions of Parent Git Repos'),
   20    writeln(ParentRepoVersions),
   21    % Temp - these properties come from the sync task as input 
   22    wf_ask_parameter(repo_a_ve(RepoAVersion)),
   23    wf_ask_parameter(repo_b_ve(RepoBVersion)),
   24    wf_ask_parameter(repo_c_ve(RepoCVersion)),
   25    format(string(Message), 'modifying versions = ~w, ~w, ~w', [RepoAVersion,
   26                                                                RepoBVersion,
   27                                                                RepoCVersion]),
   28    % will call groovy template
   29    writeln(Message).
   30
   31dialog('coordinator', PropsDl, Param, PropsDl2) :-
   32    wf_input_parameter(PropsDl, Param, NewDl),
   33    append_dl(NewDl, PropsDl, PropsDl2).
   34
   35%?- workflow('release_project', [ re('coworkers') ]).
   36workflow('release_project', Props) :-
   37    wf(
   38
   39        props( Props ), module(coworkers),
   40
   41        % data exchange between tasks happens through variable unification
   42
   43        node(dialog('coordinator'),
   44             [ node(task('sync git repo', [ParentRepoVersions]), []),
   45               node(task('modify parent repo versions', [ParentRepoVersions]), [])
   46             ])
   47
   48    ).
   49
   50%
   51% worfklow DSL
   52%
   53
   54wf_ask_parameter(P) :-
   55    shift(wf_ask_parameter(P)).
   56
   57wf_input_parameter(PropsDl, Functor, UProps) :-
   58    functor(Functor, Name, 1),
   59    term_variables(Functor, [ ParameterValue ]),
   60    PropsDl = KnownProps-[],
   61    (member(Functor, KnownProps) ->
   62         format(string(Message), '~w = ~w', [Name, ParameterValue]),
   63         writeln(Message),
   64         UProps = L-L
   65    ;
   66         format(string(Message), 'Confirm ~w:', [Name]),
   67         writeln(Message),
   68         read(ParameterValue),
   69         NewProp = Functor,
   70         UProps  = [NewProp|L]-L
   71    ).
   72
   73wf(props(Props), module(WorkflowModule), Tree) :-
   74    init_dl_from_list(Props, PropsDList),
   75    Tree = node(Coordinator, _), % find Coordinator
   76    activities(Tree, Queue-[]),
   77    do_tasks_seq(PropsDList, WorkflowModule, Queue, Coordinator).
   78
   79activities([H|T], L1-L3) :-
   80    activities(H, L1-L2), activities(T, L2-L3), !.
   81activities(node(Act, Children), L1-L3) :-
   82    activities(Act, L1-L2), activities(Children, L2-L3), !.
   83activities(Act, [Act|L]-L) :- Act = task(_,_), !.
   84activities(_, L-L).
   85
   86do_tasks_seq(_, _, [], _) :- !.
   87do_tasks_seq(PropsDl, WorkflowModule, [Act|T], Coordinator) :-
   88    % Act = task(ActIdent,ActVariableList),
   89    % Coordinator/Controller gets called only when required
   90    reset(WorkflowModule:Act, Term1, Act1),
   91    ( Term1 = 0 ->
   92      PropsDl2 = PropsDl,
   93      RestActs = T
   94    ;
   95      Term1 = wf_ask_parameter(Param) ->
   96       call(WorkflowModule:Coordinator, PropsDl, Param, PropsDl2),
   97       [Param|_]-[] = PropsDl2,
   98       RestActs = [Act1|T]
   99    ),
  100    do_tasks_seq(PropsDl2, WorkflowModule, RestActs, Coordinator).
  101
  102%
  103% difference list ops
  104%
  105
  106append_dl(A-B, B-C, A-C).
  107
  108init_dl_from_list([], L-L).
  109init_dl_from_list([H|T], Dlist) :-
  110    HDlist = [H|Z]-Z,
  111    init_dl_from_list(T, TDlist),
  112    append_dl(HDlist, TDlist, Dlist)