>From 8072ee3ac66a71b74e79af4047d4f03bac9fed48 Mon Sep 17 00:00:00 2001 From: Ben Woodcroft Date: Sun, 15 Nov 2015 10:18:05 +1000 Subject: [PATCH] import: Add github-updater. * guix/import/github.scm: New file. * guix/scripts/refresh.scm (%updaters): Add %GITHUB-UPDATER --- guix/import/github.scm | 118 +++++++++++++++++++++++++++++++++++++++++++++++ guix/scripts/refresh.scm | 4 +- 2 files changed, 121 insertions(+), 1 deletion(-) create mode 100644 guix/import/github.scm diff --git a/guix/import/github.scm b/guix/import/github.scm new file mode 100644 index 0000000..2fecb0a --- /dev/null +++ b/guix/import/github.scm @@ -0,0 +1,118 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ben Woodcroft +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +;; TODO: Are all of these imports used? +(define-module (guix import github) + #:use-module (ice-9 binary-ports) + #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) + #:use-module (ice-9 regex) + #:use-module ((ice-9 rdelim) #:select (read-line)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (rnrs bytevectors) + #:use-module (json) + #:use-module (web uri) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module ((guix download) #:prefix download:) + #:use-module (guix import utils) + #:use-module (guix import json) + #:use-module (guix packages) + #:use-module (guix upstream) + #:use-module (gnu packages) + #:export (%github-updater)) + +(define (json-fetch* url) + "Return a list/hash representation of the JSON resource URL, or #f on +failure." + ;; TODO: make silent + (call-with-temporary-output-file + (lambda (temp port) + (and (url-fetch url temp) + (call-with-input-file temp json->scm))))) + +(define (github-package? package) + "Return true if PACKAGE is a package from GitHub." + + ;; TODO: currently requires the standard "v1.0" or "1.0" style tag names + ;; TODO: currently only accepts .tar.gz downloads + ;; TODO: should also accept alternative download URLs of style like + ;; https://github.com/libical/libical/releases/download/v1.0.1/libical-1.0.1.tar.gz + (define (github-url? url) + (and + (string-prefix? "https://github.com/" url) + (or + (string-suffix? + (string-append "/archive/v" (package-version package) ".tar.gz") url) + (string-suffix? + (string-append "/archive/" (package-version package) ".tar.gz") url)))) + + (let ((source-url (and=> (package-source package) origin-uri)) + (fetch-method (and=> (package-source package) origin-method))) + (display (list "testing" source-url)) + (display "\n") + (and (eq? fetch-method download:url-fetch) + (match source-url + ((? string?) + (github-url? source-url)) + ((source-url ...) + (any github-url? source-url)))))) + +(define (github-user-slash-repository url) + "Return a string e.g. arq5x/bedtools2 of the owner and the name of the +repository separated by a forward slash, from a string URL of the form +'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz'" + (let ((splits (string-split url #\/))) + (string-append (list-ref splits 3) "/" (list-ref splits 4)))) + +(define (latest-released-version url) + "Return a string of the newest released version name given a string URL like +'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz', or #f if there +is no releases" + ;; TODO: don't return pre-release versions, can detect this from JSON field + ;; 'prerelease' + (let ((json (json-fetch* + (string-append "https://api.github.com/repos/" + (github-user-slash-repository url) + "/releases" + ;;"?access_token=aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + )))) + (if (eq? (length json) 0) #f + (let ((tag (assoc-ref (hash-table->alist (first json)) "tag_name"))) + (if (eq? (string-ref tag 0) #\v) + (substring tag 1) tag))))) + +(define (latest-release guix-package) + "Return an for the latest release of GUIX-PACKAGE." + (let* ((pkg (specification->package guix-package)) + (source-uri (origin-uri (package-source pkg))) + (version (latest-released-version source-uri))) + (if version + (upstream-source + (package guix-package) + (version version) + (urls (list source-uri))) + #f))) + +(define %github-updater + (upstream-updater + (name 'github) + (description "Updater for GitHub packages") + (pred github-package?) + (latest latest-release))) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 3161aac..f9ac0ed 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2015 Alex Kost +;;; Copyright © 2015 Ben Woodcroft ;;; ;;; This file is part of GNU Guix. ;;; @@ -184,7 +185,8 @@ unavailable optional dependencies such as Guile-JSON." (list-updaters %gnu-updater %elpa-updater %cran-updater - ((guix import pypi) => %pypi-updater))) + ((guix import pypi) => %pypi-updater) + ((guix import github) => %github-updater))) (define (lookup-updater name) "Return the updater called NAME." -- 2.5.0