1:- module(
    2  ppm_github,
    3  [
    4    github_uri/3,               % +User, +Repo, -Uri
    5    github_version_latest/3     % +User, +Repo, -Version
    6  ]
    7).

Prolog Package Manager (PPM): Github support

author
- Wouter Beek
version
- 2017-2018 */
   15:- use_module(library(aggregate)).   16:- use_module(library(debug)).   17:- use_module(library(http/http_open)).   18:- use_module(library(http/json)).   19:- use_module(library(lists)).   20:- use_module(library(option)).   21:- use_module(library(readutil)).   22:- use_module(library(uri)).   23
   24:- use_module(library(ppm_generic)).   25%:- use_module(library(ppm_git)).
   26
   27:- debug(ppm(github)).
 github_uri(+User:atom, +Repo:atom, -Uri:atom) is det
   35github_uri(User, Repo, Uri) :-
   36  atomic_list_concat(['',User,Repo], /, Path),
   37  uri_components(Uri, uri_components(https,'github.com',Path,_,_)).
 github_version(+User:atom, +Repo:atom, +Version:compound) is semidet
github_version(+User:atom, +Repo:atom, -Version:compound) is nondet
   44github_version(User, Repo, Version) :-
   45  github_open([repos,User,Repo,tags], [], 200, In),
   46  call_cleanup(
   47    json_read_dict(In, Dicts, [value_string_as(atom)]),
   48    close(In)
   49  ),
   50  member(Dict, Dicts),
   51  atom_phrase(version(Version), Dict.name).
 github_version_latest(+User:atom, +Repo:atom, +Version:compound) is semidet
github_version_latest(+User:atom, +Repo:atom, -Version:compound) is nondet
   58github_version_latest(User, Repo, Version) :-
   59  aggregate_all(set(Version), github_version(User, Repo, Version), Versions),
   60  predsort(compare_version, Versions, SortedVersions),
   61  last(SortedVersions, Version).
   62
   63
   64
   65
   66
   67% HELPERS %
 github_open(+Segments:list(atom), +Options:list(compound), +Status:between(100,599), -In:stream) is det
   72github_open(Segments, Options1, Status, In) :-
   73  atomic_list_concat([''|Segments], /, Path),
   74  uri_components(Uri, uri_components(https,'api.github.com',Path,_,_)),
   75  merge_options(
   76    [
   77      headers(Headers),
   78      request_header('Accept'='application/vnd.github.v3+json'),
   79      status_code(Status)
   80    ],
   81    Options1,
   82    Options2
   83  ),
   84  catch(http_open(Uri, In, Options2), E, true),
   85  (   var(E)
   86  ->  (   debugging(http(receive_reply))
   87      ->  print_http_reply(Status, Headers)
   88      ;   true
   89      )
   90  ;   E = error(permission_error(url,_Uri),context(_,status(403,_)))
   91  ->  % Unfortunately, library(http/http_open) throws away the reply
   92      % body for non-2xx replies.  This may be due to Github rate
   93      % limiting.
   94      ansi_format([bg(red)], "Github operation forbidden.  Maybe rate limiting?"),
   95      nl,
   96      fail
   97  ).
   98
   99print_http_reply(Status, Headers) :-
  100  debug(http(receive_reply), "~a", [Status]),
  101  maplist(print_http_header, Headers),
  102  debug(http(receive_reply), "", []).
  103
  104print_http_header(Header) :-
  105  Header =.. [Key1,Value],
  106  atomic_list_concat(L, '_', Key1),
  107  atomic_list_concat(L, -, Key2),
  108  debug(http(receive_reply), "< ~a: ~a", [Key2,Value])