From 42efe27a30b1f0981b69336089b42afa3537fcc7 Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@member.fsf.org>
Date: Tue, 22 Mar 2016 22:44:51 -0500
Subject: [PATCH] import: Add Hackage updater.

* guix/import/hackage.scm (guix-package->hackage-name, hackage-package?)
  (latest-release): New procedures.
  (%hackage-updater): New variable.
* guix/scripts/refresh.scm (%updaters): Add it.
* doc/guix.texi (Invoking guix refresh): Mention it.
---
 doc/guix.texi            |  2 ++
 guix/import/hackage.scm  | 64 ++++++++++++++++++++++++++++++++++++++--
 guix/scripts/refresh.scm |  2 ++
 3 files changed, 65 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 3eb25adec8..c5b13e0572 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4792,6 +4792,8 @@ the updater for @uref{https://pypi.python.org, PyPI} packages.
 the updater for @uref{https://rubygems.org, RubyGems} packages.
 @item github
 the updater for @uref{https://github.com, GitHub} packages.
+@item hackage
+the updater for @uref{https://hackage.haskell.org, Hackage} packages.
 @end table
 
 For instance, the following command only checks for updates of Emacs
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 4f14df4d61..640ead24f3 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -19,20 +19,25 @@
 
 (define-module (guix import hackage)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-1)
-  #:use-module ((guix download) #:select (download-to-store))
+  #:use-module (gnu packages)
+  #:use-module ((guix download) #:select (download-to-store url-fetch))
   #:use-module ((guix utils) #:select (package-name->name+version
                                        canonical-newline-port))
-  #:use-module (guix import utils)
   #:use-module (guix http-client)
+  #:use-module ((guix import utils) #:select (factorize-uri))
   #:use-module (guix import cabal)
   #:use-module (guix store)
   #:use-module (guix hash)
   #:use-module (guix base32)
+  #:use-module (guix upstream)
+  #:use-module (guix packages)
   #:use-module ((guix utils) #:select (call-with-temporary-output-file))
-  #:export (hackage->guix-package))
+  #:export (hackage->guix-package
+            %hackage-updater))
 
 (define ghc-standard-libraries
   ;; List of libraries distributed with ghc (7.10.2). We include GHC itself as
@@ -89,6 +94,17 @@ version is returned."
       (string-downcase name)
       (string-append package-name-prefix (string-downcase name))))
 
+(define guix-package->hackage-name
+  (let ((uri-rx (make-regexp "https?://hackage.haskell.org/package/([^/]+)/.*"))
+        (name-rx (make-regexp "(.*)-[0-9\\.]+")))
+    (lambda (package)
+      "Given a Guix package name, return the corresponding Hackage name."
+      (let* ((source-url (and=> (package-source package) origin-uri))
+             (name (match:substring (regexp-exec uri-rx source-url) 1)))
+        (match (regexp-exec name-rx name)
+          (#f name)
+          (m (match:substring m 1)))))))
+
 (define (hackage-fetch name-version)
   "Return the Cabal file for the package NAME-VERSION, or #f on failure.  If
 the version part is omitted from the package name, then return the latest
@@ -236,4 +252,46 @@ respectively."
                                     include-test-dependencies?)
                                (cut eval-cabal <> cabal-environment)))))
 
+(define (hackage-package? package)
+  "Return #t if PACKAGE is a Haskell package from Hackage."
+
+  (define haskell-url?
+    (let ((hackage-rx (make-regexp "https?://hackage.haskell.org")))
+      (lambda (url)
+        (regexp-exec hackage-rx url))))
+
+  (let ((source-url (and=> (package-source package) origin-uri))
+        (fetch-method (and=> (package-source package) origin-method)))
+    (and (eq? fetch-method url-fetch)
+         (match source-url
+           ((? string?)
+            (haskell-url? source-url))
+           ((source-url ...)
+            (any haskell-url? source-url))))))
+
+(define (latest-release guix-package)
+  "Return an <upstream-source> for the latest release of GUIX-PACKAGE."
+  (let* ((hackage-name (guix-package->hackage-name
+                        (specification->package guix-package)))
+         (cabal-meta (hackage-fetch hackage-name)))
+    (match cabal-meta
+      (#f
+       (format (current-error-port)
+               "warning: failed to parse ~a~%"
+               (hackage-cabal-url hackage-name))
+       #f)
+      ((_ *** ("version" (version)))
+       (let ((url (hackage-source-url hackage-name version)))
+         (upstream-source
+          (package guix-package)
+          (version version)
+          (urls (list url))))))))
+
+(define %hackage-updater
+  (upstream-updater
+   (name 'hackage)
+   (description "Updater for Hackage packages")
+   (pred hackage-package?)
+   (latest latest-release)))
+
 ;;; cabal.scm ends here
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index e541138682..0efc190b22 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -35,6 +35,7 @@
                 #:select (%gnu-updater %gnome-updater %xorg-updater))
   #:use-module (guix import elpa)
   #:use-module (guix import cran)
+  #:use-module (guix import hackage)
   #:use-module (guix gnupg)
   #:use-module (gnu packages)
   #:use-module ((gnu packages commencement) #:select (%final-inputs))
@@ -198,6 +199,7 @@ unavailable optional dependencies such as Guile-JSON."
                  %elpa-updater
                  %cran-updater
                  %bioconductor-updater
+                 %hackage-updater
                  ((guix import pypi) => %pypi-updater)
                  ((guix import gem) => %gem-updater)
                  ((guix import github) => %github-updater)))