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)).

GitHub API

You need a personal access token for updates. You do not require them for public access.

author
- Roy Ratcliffe /
   19:- setting(access_token, atom, env('GHAPI_ACCESS_TOKEN', ''),
   20           'GitHub API personal access token').
 ghapi_update_gist(+GistID, +Data, -Reply, +Options) is det
Updates a Gist by its unique identifier. Data is the patch payload as a JSON object, or dictionary if you include 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='{}'
                                             ])
                           ])
              ])), _, []).
See also
- https://docs.github.com/en/rest/reference/gists#update-a-gist
   45ghapi_update_gist(GistID, Data, Reply, Options) :-
   46    ghapi_get([gists, GistID], Reply, [method(patch), post(Data)|Options]).
 ghapi_get(+PathComponents, +Data, +Options) is det
Accesses the GitHub API. Supports JSON terms and dictionaries. For example, the following goal accesses the GitHub Gist API looking for a particular Gist by its identifier and unifies A with a JSON term representing the Gist's current contents and state.
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)