1:- module(gh_api, 2 [ ghapi_update_gist/4, % +GistID,+Data,-Reply,+Options 3 ghapi_get/3 % +PathComponents,+Data,+Options 4 ]). 5:- autoload(library(option), [option/2]). 6:- autoload(library(url), [parse_url/2]). 7:- autoload(library(http/http_client), [http_get/3]). 8:- use_module(library(settings), [setting/4, setting/2]). 9:- ensure_loaded(library(http/http_json)).
19:- setting(access_token, atom, env('GHAPI_ACCESS_TOKEN', ''),
20 'GitHub API personal access token').
json_object(dict)
in
Options. Reply is the updated Gist in JSON on success.
The example below illustrates a Gist update using a JSON term.
Notice the doubly-nested json/1 terms. The first sets up the HTTP
request for JSON while the inner term specifies a JSON object
payload. In this example, the update adds or replaces the cov.json
file with content of "{}" as serialised JSON. Update requests for
Gists have a files
object with a nested filename-object comprising
a content string for the new contents of the file.
ghapi_update_gist( ec92ac84832950815861d35c2f661953, json(json([ files=json([ 'cov.json'=json([ content='{}' ]) ]) ])), _, []).
45ghapi_update_gist(GistID, Data, Reply, Options) :-
46 ghapi_get([gists, GistID], Reply, [method(patch), post(Data)|Options]).
ghapi_get([gists, ec92ac84832950815861d35c2f661953], A, []).
Supports all HTTP methods despite the predicate name. The "get" mirrors the underlying http_get/3 method which also supports all methods. POST and PATCH send data using the post/1 option and override the default HTTP verb using the method/1 option. Similarly here.
Handles authentication via settings, and from the system environment indirectly. Option ghapi_access_token/1 overrides both. Order of overriding proceeds as: option, setting, environment, none. Empty atom counts as none.
Abstracts away the path using path components. Argument PathComponents is an atomic list specifying the URL path.
71ghapi_get(PathComponents, Data, Options) :- 72 ghapi_get_options(Options_, Options), 73 atomic_list_concat([''|PathComponents], /, Path), 74 parse_url(URL, [protocol(https), host('api.github.com'), path(Path)]), 75 http_get(URL, Data, 76 [ request_header('Accept'='application/vnd.github.v3+json') 77 | Options_ 78 ]). 79 80ghapi_get_options([ request_header('Authorization'=Authorization) 81 | Options 82 ], Options) :- 83 ghapi_access_token(AccessToken, Options), 84 AccessToken \== '', 85 !, 86 format(atom(Authorization), 'token ~s', [AccessToken]). 87ghapi_get_options(Options, Options). 88 89ghapi_access_token(AccessToken, Options) :- 90 option(ghapi_access_token(AccessToken), Options), 91 !. 92ghapi_access_token(AccessToken, _Options) :- 93 setting(access_token, AccessToken)
GitHub API
You need a personal access token for updates. You do not require them for public access.