diff cpack/dml/applications/memo_ui.pl @ 0:718306e29690 tip

commiting public release

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cpack/dml/applications/memo_ui.pl	Tue Feb 09 21:05:06 2016 +0100
@@ -0,0 +1,159 @@
+/* Part of DML (Digital Music Laboratory)
+	Copyright 2014-2015 Samer Abdallah, University of London
+	 
+	This program is free software; you can redistribute it and/or
+	modify it under the terms of the GNU General Public License
+	as published by the Free Software Foundation; either version 2
+	of the License, or (at your option) any later version.
+
+	This program is distributed in the hope that it will be useful,
+	but WITHOUT ANY WARRANTY; without even the implied warranty of
+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+	GNU General Public License for more details.
+
+	You should have received a copy of the GNU General Public
+	License along with this library; if not, write to the Free Software
+	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+*/
+
+:- module(memo_ui, []).
+
+/** <module> UI for viewing memoised functions
+*/
+:- use_module(library(http/html_write)).
+:- use_module(library(http/html_head)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(decoration)).
+:- use_module(library(htmlutils)).
+:- use_module(library(memo)).
+:- use_module(library(async)).
+:- use_module(library(listutils)).
+:- use_module(library(httpfiles)).
+:- use_module(components(table)).
+:- use_module(components(icons)).
+:- use_module(cliopatria(hooks)).
+
+:- set_prolog_flag(double_quotes,string).
+
+:- http_handler(root(dml/memo/view), memo_view, []).
+:- http_handler(root(dml/jobs/view), job_view, []).
+:- http_handler(root(dml/jobs/cancel), cancel_job, []).
+
+decoration:resource_view(URI,_) -->
+   { rdf(URI,rdf:type,memo:'Function'), !,
+     uripattern:pattern_uri(\func(Mod,Pred,Arity),URI),
+     format(string(Name),"~w:~w/~d",[Mod,Pred,Arity]),
+     http_link_to_id(pldoc_object,[object=Name],DocLink),
+     http_link_to_id(memo_view,[uri(URI)],ViewURL) 
+   },
+   html_requires(font_awesome),
+   html( [  a(href=ViewURL, [\icon(table)," View"]), '  '
+         ,  a(href=DocLink, [\icon(book)," Documentation"])
+         ]).
+
+decoration:resource_decoration(URI,Link) -->
+   { rdf(URI,rdf:type,memo:'Function'), !,
+     % uripattern:pattern_uri(dml: \func(Mod,Pred,Arity),URI),
+     % format(string(Name),"~w:~w/~d",[Mod,Pred,Arity]),
+     % http_link_to_id(pldoc_object,[object=Name],DocLink),
+     http_link_to_id(memo_view,[uri=URI],ViewLink)
+   },
+   html_requires(font_awesome),
+   html( span( [  a(href(ViewLink),\icon(table)), &(nbsp)
+               % ,  a(href(DocLink),\icon(book)), &(nbsp)
+               ,  \Link ])).
+
+memo_view(Request) :-
+   http_parameters(Request,
+      [  uri(URI,     [ optional(false), description("URI of CSV file")]) 
+      ,  page(Page,   [ nonneg, default(1) ]) 
+      ,  limit(Limit, [ nonneg, default(50) ])
+      ]),
+   format(string(FullTitle),"View for ~w",[URI]),
+   uripattern:pattern_uri(\func(Mod,Pred,Arity),URI),
+   length(Args,Arity),
+   Head =.. [Pred|Args],
+   aggregate_all(count,browse(Mod:Head),Total),
+   (  Total=0
+   -> Content=p("This function has no successful memoised computations.")
+   ;  Offset is Limit*(Page-1),
+      Pages is ceil(Total/Limit),
+      insist(Page=<Pages),
+      % insist(Page=Pages -> Rows1=Rows2; take(Limit,Rows1,Rows2)),
+      Content = [ \paginator(memo_view-[uri(URI),limit(Limit)],Page,Pages)
+                , \table_from_goal(goal_row(limit(Limit,offset(Offset,browse(Mod:Head))),Args),[])
+                , \paginator(memo_view-[uri(URI),limit(Limit)],Page,Pages)
+                ]
+   ),
+   reply_html_page(cliopatria(demo), [title(FullTitle)], [ h1(FullTitle) | Content ], [unstable]).
+
+cancel_job(Request) :-
+   insist(user_db:logged_on(_),not_authorised(cancel_job)),
+   http_parameters(Request,
+      [  pool(Pool,   [ atom, optional(false) ])
+      ,  id(Id,       [ atom, optional(false) ])
+      ,  return_to(ReturnTo, [ atom, default(_) ])
+      ]),
+   async_cancel(Pool,Id), % !!! this could throw an error
+   (var(ReturnTo) -> member(referer(ReturnTo),Request); true),
+   debug(async,'Cancelling job ~w:~w, returning to ~w',[Pool,Id,ReturnTo]),
+   http_redirect(see_other,ReturnTo,Request).
+
+job_view(Request) :-
+   http_parameters(Request, [pool(Pool, [atom, default(vis_cla)])]),
+   format(string(FullTitle),"Current jobs in thread pool ~w",[Pool]),
+   findall(job(Goal,ID,TSub,Status),async_current_job(Pool,Goal,ID,TSub,Status),Jobs),
+   reply_html_page(cliopatria(demo), [title(FullTitle)],
+                   [h1(FullTitle), \job_tables(Pool,Jobs)],
+                   [unstable]).
+
+job_tables(Pool,Jobs) -->
+   {partition(is_waiting, Jobs, Waiting, Running)},
+   (  {Running=[]} -> html(h3("No jobs running."))
+   ;  html( [  h3("Running jobs") 
+            ,  \table_from_goal(running_job(Pool,Running), 
+                                [headings(['Started','Elapsed','Progress','Goal','Actions'])])
+            ])
+   ),
+   (  {Waiting=[]} -> html(h3("No jobs waiting."))
+   ;  html( [  h3("Waiting jobs")
+            ,  \table_from_goal(waiting_job(Pool,Waiting), 
+                                [headings(['Position','Submitted','Goal','Actions'])])
+            ])
+   ).
+
+
+is_waiting(job(_,_,_,waiting(_))).
+
+waiting_job(Pool,Jobs,[Pos,TSubmit,GoalCell,a(href(Cancel),cancel)]) :-
+   member(job(Goal,ID,TSubmit,waiting(Pos)),Jobs), % !!! add submit time to table?
+   http_link_to_id(cancel_job,[pool=Pool,id=ID],Cancel),
+   goal_cell(Goal,GoalCell).
+running_job(Pool,Jobs,[StartS,ElapsedS,ProgressS,GoalCell,a(href(Cancel),cancel)]) :-
+   member(job(Goal,ID,_TSubmit,running(Thread,Start)),Jobs),
+   http_link_to_id(cancel_job,[pool=Pool,id=ID],Cancel),
+   format_time(string(StartS),'%FT%T%:z',Start),
+   debug(async,'Getting running job progress from thread ~w...',[Thread]),
+   catch((  async_thread_progress(Thread,[summary],TNow,[Progress]),
+            progress_string(Progress,ProgressS),
+            Elapsed is TNow-Start, format(string(ElapsedS),'~2f',[Elapsed])
+         ), Ex, ( debug(async,'Failed to get job progress ~q',[Ex]),
+                  ElapsedS="N/A", ProgressS="ENDED")),
+   copy_term(Goal,Goal1),
+   numbervars(Goal1,0,_),
+   goal_cell(Goal1,GoalCell).
+
+goal_cell(Mod:Head,a(href(URL),GoalS)) :-
+   functor(Head,Pred,Arity),
+   uripattern:pattern_uri(\func(Mod,Pred,Arity),URI),
+   http_link_to_id(list_resource,[r(URI)],URL),
+   term_cell(Mod:Head,GoalS).
+
+progress_string(Progress,String) :- memberchk(stepwise(_Desc,Done/Total), Progress), !, format(string(String),'~d/~d',[Done,Total]).
+progress_string(_Terms, "-").
+
+goal_row(Pred,Vals,Cells) :- call(Pred), maplist(term_cell,Vals,Cells).
+term_cell(Term,Cell) :- 
+   with_output_to(string(Cell),write_term(Term,[quoted(true),max_depth(6),numbervars(true)])).
+