Merge remote-tracking branch 'origin/master' into core-updates-frozen.

7 files changed, 398 insertions, 63 deletions

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 287ffd2536..c76d7e9c1a 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 David Craven <david@craven.ch>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2021 Nicolas Goaziou <mail@nicolasgoaziou.fr>
 ;;;
@@ -79,7 +79,10 @@
   (number        crate-version-number "num")      ;string
   (download-path crate-version-download-path "dl_path") ;string
   (readme-path   crate-version-readme-path "readme_path") ;string
-  (license       crate-version-license "license") ;string
+  (license       crate-version-license "license"  ;string | #f
+                 (match-lambda
+                   ('null #f)
+                   ((? string? str) str)))
   (links         crate-version-links))            ;alist
 
 ;; Crate dependency.  Each dependency (each edge in the graph) is annotated as
@@ -198,6 +201,7 @@ and LICENSE."
                    (description ,(beautify-description description))
                    (license ,(match license
                                (() #f)
+                               (#f #f)
                                ((license) license)
                                (_ `(list ,@license)))))))
          (close-port port)
diff --git a/guix/import/git.scm b/guix/import/git.scm
new file mode 100644
index 0000000000..1eb219f3fe
--- /dev/null
+++ b/guix/import/git.scm
@@ -0,0 +1,225 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(define-module (guix import git)
+  #:use-module (guix build utils)
+  #:use-module (guix diagnostics)
+  #:use-module (guix git)
+  #:use-module (guix git-download)
+  #:use-module (guix i18n)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (%generic-git-updater
+
+            ;; For tests.
+            latest-git-tag-version))
+
+;;; Commentary:
+;;;
+;;; This module provides a generic package updater for packages hosted on Git
+;;; repositories.
+;;;
+;;; It tries to be smart about tag names, but if it is not automatically able
+;;; to parse the tag names correctly, users can set the `release-tag-prefix',
+;;; `release-tag-suffix' and `release-tag-version-delimiter' properties of the
+;;; package to make the updater parse the Git tag name correctly.
+;;;
+;;; Possible improvements:
+;;;
+;;; * More robust method for trying to guess the delimiter.  Maybe look at the
+;;;   previous version/tag combo to determine the delimiter.
+;;;
+;;; * Differentiate between "normal" versions, e.g., 1.2.3, and dates, e.g.,
+;;;   2021.12.31.  Honor a `release-tag-date-scheme?' property?
+;;;
+;;; Code:
+
+;;; Errors & warnings
+
+(define-condition-type &git-no-valid-tags-error &error
+  git-no-valid-tags-error?)
+
+(define (git-no-valid-tags-error)
+  (raise (condition (&message (message "no valid tags found"))
+                    (&git-no-valid-tags-error))))
+
+(define-condition-type &git-no-tags-error &error
+  git-no-tags-error?)
+
+(define (git-no-tags-error)
+  (raise (condition (&message (message "no tags were found"))
+                    (&git-no-tags-error))))
+
+
+;;; Updater
+
+(define %pre-release-words
+  '("alpha" "beta" "rc" "dev" "test" "pre"))
+
+(define %pre-release-rx
+  (map (lambda (word)
+         (make-regexp (string-append ".+" word) regexp/icase))
+       %pre-release-words))
+
+(define* (version-mapping tags #:key prefix suffix delim pre-releases?)
+  "Given a list of Git TAGS, return an association list where the car is the
+version corresponding to the tag, and the cdr is the name of the tag."
+  (define (guess-delimiter)
+    (let ((total (length tags))
+          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
+          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
+          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
+      (cond
+       ((>= dots (* total 0.35)) ".")
+       ((>= dashes (* total 0.8)) "-")
+       ((>= underscores (* total 0.8)) "_")
+       (else ""))))
+
+  (define delim-rx (regexp-quote (or delim (guess-delimiter))))
+  (define suffix-rx  (string-append (or suffix "") "$"))
+  (define prefix-rx (string-append "^" (or prefix "[^[:digit:]]*")))
+  (define pre-release-rx
+    (if pre-releases?
+        (string-append "(.*(" (string-join %pre-release-words "|") ").*)")
+        ""))
+
+  (define tag-rx
+    (string-append prefix-rx "([[:digit:]][^" delim-rx "[:punct:]]*"
+                   "(" delim-rx "[^[:punct:]" delim-rx "]+)"
+                   ;; If there are no delimiters, it could mean that the
+                   ;; version just contains one number (e.g., "2"), thus, use
+                   ;; "*" instead of "+" to match zero or more numbers.
+                   (if (string=? delim-rx "") "*" "+") ")"
+                   ;; We don't want the pre-release stuff (e.g., "-alpha") be
+                   ;; part of the first group; otherwise, the "-" in "-alpha"
+                   ;; might be interpreted as a delimiter, and thus replaced
+                   ;; with "."
+                   pre-release-rx suffix-rx))
+
+
+
+  (define (get-version tag)
+    (let ((tag-match (regexp-exec (make-regexp tag-rx) tag)))
+      (and=> (and tag-match
+                  (regexp-substitute/global
+                   #f delim-rx (match:substring tag-match 1)
+                   ;; If there were no delimiters, don't insert ".".
+                   'pre (if (string=? delim-rx "") "" ".") 'post))
+             (lambda (version)
+               (if pre-releases?
+                   (string-append version (match:substring tag-match 3))
+                   version)))))
+
+  (define (entry<? a b)
+    (eq? (version-compare (car a) (car b)) '<))
+
+  (stable-sort (filter-map (lambda (tag)
+                             (let ((version (get-version tag)))
+                               (and version (cons version tag))))
+                           tags)
+               entry<?))
+
+(define* (latest-tag url #:key prefix suffix delim pre-releases?)
+  "Return the latest version and corresponding tag available from the Git
+repository at URL."
+  (define (pre-release? tag)
+    (any (cut regexp-exec <> tag)
+         %pre-release-rx))
+
+  (let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))
+                    (remote-refs url #:tags? #t)))
+         (versions->tags
+          (version-mapping (if pre-releases?
+                               tags
+                               (filter (negate pre-release?) tags))
+                           #:prefix prefix
+                           #:suffix suffix
+                           #:delim delim
+                           #:pre-releases? pre-releases?)))
+    (cond
+     ((null? tags)
+      (git-no-tags-error))
+     ((null? versions->tags)
+      (git-no-valid-tags-error))
+     (else
+      (match (last versions->tags)
+        ((version . tag)
+         (values version tag)))))))
+
+(define (latest-git-tag-version package)
+  "Given a PACKAGE, return the latest version of it, or #f if the latest version
+could not be determined."
+  (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "~a for ~a~%")
+                      (condition-message c)
+                      (package-name package))
+             #f)
+            ((eq? (exception-kind c) 'git-error)
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "failed to fetch Git repository for ~a~%")
+                      (package-name package))
+             #f))
+    (let* ((source (package-source package))
+           (url (git-reference-url (origin-uri source)))
+           (property (cute assq-ref (package-properties package) <>)))
+      (latest-tag url
+                  #:prefix (property 'release-tag-prefix)
+                  #:suffix (property 'release-tag-suffix)
+                  #:delim (property 'release-tag-version-delimiter)
+                  #:pre-releases? (property 'accept-pre-releases?)))))
+
+(define (git-package? package)
+  "Return true if PACKAGE is hosted on a Git repository."
+  (match (package-source package)
+    ((? origin? origin)
+     (and (eq? (origin-method origin) git-fetch)
+          (git-reference? (origin-uri origin))))
+    (_ #f)))
+
+(define (latest-git-release package)
+  "Return an <upstream-source> for the latest release of PACKAGE."
+  (let* ((name (package-name package))
+         (old-version (package-version package))
+         (url (git-reference-url (origin-uri (package-source package))))
+         (new-version (latest-git-tag-version package)))
+
+    (and new-version
+         (upstream-source
+          (package name)
+          (version new-version)
+          (urls (list url))))))
+
+(define %generic-git-updater
+  (upstream-updater
+   (name 'generic-git)
+   (description "Updater for packages hosted on Git repositories")
+   (pred git-package?)
+   (latest latest-git-release)))
diff --git a/guix/import/go.scm b/guix/import/go.scm
index c6ecdbaffd..26dbc34b63 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -474,13 +474,13 @@ Optionally include a VERSION string to append to the name."
 because goproxy servers don't currently provide all the information needed to
 build a package."
   (define (go-import->module-meta content-text)
-    (match (string-split content-text #\space)
+    (match (string-tokenize content-text char-set:graphic)
       ((root-path vcs repo-url)
        (make-module-meta root-path (string->symbol vcs)
                          (strip-.git-suffix/maybe repo-url)))))
   ;; <meta name="go-import" content="import-prefix vcs repo-root">
   (let* ((meta-data (http-fetch* (format #f "https://~a?go-get=1" module-path)))
-         (select (sxpath `(// head (meta (@ (equal? (name "go-import"))))
+         (select (sxpath `(// (meta (@ (equal? (name "go-import"))))
                               // content))))
     (match (select (html->sxml meta-data #:strict? #t))
       (() #f)                           ;nothing selected
@@ -612,6 +612,8 @@ hint: use one of the following available versions ~a\n"
          (dependencies (if pin-versions?
                            dependencies+versions
                            (map car dependencies+versions)))
+         (module-path-sans-suffix
+          (match:prefix (string-match "([\\./]v[0-9]+)?$" module-path)))
          (guix-name (go-module->guix-package-name module-path))
          (root-module-path (module-path->repository-root module-path))
          ;; The VCS type and URL are not included in goproxy information. For
@@ -619,7 +621,7 @@ hint: use one of the following available versions ~a\n"
          (meta-data (fetch-module-meta-data root-module-path))
          (vcs-type (module-meta-vcs meta-data))
          (vcs-repo-url (module-meta-data-repo-url meta-data goproxy))
-         (synopsis (go-package-synopsis root-module-path))
+         (synopsis (go-package-synopsis module-path))
          (description (go-package-description module-path))
          (licenses (go-package-licenses module-path)))
     (values
@@ -630,7 +632,10 @@ hint: use one of the following available versions ~a\n"
          ,(vcs->origin vcs-type vcs-repo-url version*))
         (build-system go-build-system)
         (arguments
-         '(#:import-path ,root-module-path))
+         '(#:import-path ,module-path
+           ,@(if (string=? module-path-sans-suffix root-module-path)
+                 '()
+                 `(#:unpack-path ,root-module-path))))
         ,@(maybe-propagated-inputs
            (map (match-lambda
                   ((name version)
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 7c6d9d0a22..d73fbe6a81 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -55,8 +55,8 @@
             hackage-package?))
 
 (define ghc-standard-libraries
-  ;; List of libraries distributed with ghc (8.6.5).
-  ;; Contents of ...-ghc-8.6.5/lib/ghc-8.6.5.
+  ;; List of libraries distributed with ghc (as of 8.10.7).
+  ;; Contents of …-ghc-8.10.7/lib/ghc-8.10.7
   '("ghc"
     "cabal" ;; in the output of `ghc-pkg list` Cabal is uppercased, but
             ;; hackage-name->package-name takes this into account.
@@ -68,6 +68,7 @@
     "containers"
     "deepseq"
     "directory"
+    "exceptions"
     "filepath"
     "ghc"
     "ghc-boot"
@@ -121,12 +122,12 @@ version is returned."
       (string-append package-name-prefix (string-downcase name))))
 
 (define guix-package->hackage-name
-  (let ((uri-rx (make-regexp "https?://hackage.haskell.org/package/([^/]+)/.*"))
+  (let ((uri-rx (make-regexp "(https?://hackage.haskell.org|mirror://hackage)/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)))
+             (name (match:substring (regexp-exec uri-rx source-url) 2)))
         (match (regexp-exec name-rx name)
           (#f name)
           (m (match:substring m 1)))))))
@@ -351,7 +352,7 @@ respectively."
                     #:guix-name hackage-name->package-name))
 
 (define hackage-package?
-  (let ((hackage-rx (make-regexp "https?://hackage.haskell.org")))
+  (let ((hackage-rx (make-regexp "(https?://hackage.haskell.org|mirror://hackage/)")))
     (url-predicate (cut regexp-exec hackage-rx <>))))
 
 (define (latest-release package)
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index e1f8487b75..0f3ab473ca 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -25,6 +25,8 @@
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module ((guix packages) #:prefix package:)
+  #:use-module (guix upstream)
   #:use-module (guix utils)
   #:use-module (guix ui)
   #:use-module (guix i18n)
@@ -36,15 +38,19 @@
   #:use-module (json)
   #:use-module (guix base32)
   #:use-module (guix git)
+  #:use-module ((guix git-download) #:prefix download:)
   #:use-module (guix store)
   #:export (%default-sort-key
             %contentdb-api
             json->package
             contentdb-fetch
             elaborate-contentdb-name
+            minetest-package?
+            latest-minetest-release
             minetest->guix-package
             minetest-recursive-import
-            sort-packages))
+            sort-packages
+            %minetest-updater))
 
 ;; The ContentDB API is documented at
 ;; <https://content.minetest.net>.
@@ -203,7 +209,7 @@ raise an exception."
         (match correctly-named
           ((one) (package-keys-full-name one))
           ((too . many)
-           (warning (G_ "~a is ambigious, presuming ~a (other options include: ~a)~%")
+           (warning (G_ "~a is ambiguous, presuming ~a (other options include: ~a)~%")
                     name (package-keys-full-name too)
                     (map package-keys-full-name many))
            (package-keys-full-name too))
@@ -256,7 +262,7 @@ and possibly some other packages as well, or #f on failure."
                                    (order "desc"))
   "Search ContentDB for Q (a string).  Sort by SORT, in ascending order
 if ORDER is \"asc\" or descending order if ORDER is \"desc\".  TYPE must
-be \"mod\", \"game\" or \"txp\", restricting thes search results to
+be \"mod\", \"game\" or \"txp\", restricting the search results to
 respectively mods, games and texture packs.  Limit to at most LIMIT
 results.  The return value is a list of <package-keys> records."
   ;; XXX does Guile have something for constructing (and, when necessary,
@@ -337,6 +343,25 @@ official Minetest forum and the Git repository (if any)."
       (and=> (package-forums package) topic->url-sexp)
       (package-repository package)))
 
+(define (release-version release)
+  "Guess the version of RELEASE from the release title."
+  (define title (release-title release))
+  (if (string-prefix? "v" title)
+      ;; Remove "v" prefix from release titles like ‘v1.0.1’.
+      (substring title 1)
+      title))
+
+(define (version-style version)
+  "Determine the kind of version number VERSION is -- a date, or a conventional
+conventional version number."
+  (define dots? (->bool (string-index version #\.)))
+  (define hyphens? (->bool (string-index version #\-)))
+  (match (cons dots? hyphens?)
+    ((#true . #false) 'regular) ; something like "0.1"
+    ((#false . #false) 'regular) ; single component version number
+    ((#true . #true) 'regular) ; result of 'git-version'
+    ((#false . #true) 'date))) ; something like "2021-01-25"
+
 ;; If the default sort key is changed, make sure to modify 'show-help'
 ;; in (guix scripts import minetest) appropriately as well.
 (define %default-sort-key "score")
@@ -371,7 +396,11 @@ official Minetest forum and the Git repository (if any)."
 DEPENDENCIES as a list of AUTHOR/NAME strings."
   (define dependency-list
     (assoc-ref dependencies author/name))
-  (filter-map
+  ;; A mod can have multiple dependencies implemented by the same mod,
+  ;; so remove duplicate mod names.
+  (define (filter-deduplicate-map f list)
+    (delete-duplicates (filter-map f list)))
+  (filter-deduplicate-map
    (lambda (dependency)
      (and (not (dependency-optional? dependency))
           (not (builtin-mod? (dependency-name dependency)))
@@ -432,7 +461,7 @@ list of AUTHOR/NAME strings."
   (define important-upstream-dependencies
     (important-dependencies dependencies author/name #:sort sort))
   (values (make-minetest-sexp author/name
-                              (release-title release) ; version
+                              (release-version release)
                               (package-repository package)
                               (release-commit release)
                               important-upstream-dependencies
@@ -454,3 +483,37 @@ list of AUTHOR/NAME strings."
   (recursive-import author/name
                     #:repo->guix-package minetest->guix-package*
                     #:guix-name contentdb->package-name))
+
+(define (minetest-package? pkg)
+  "Is PKG a Minetest mod on ContentDB?"
+  (and (string-prefix? "minetest-" (package:package-name pkg))
+       (assq-ref (package:package-properties pkg) 'upstream-name)))
+
+(define (latest-minetest-release pkg)
+  "Return an <upstream-source> for the latest release of the package PKG,
+or #false if the latest release couldn't be determined."
+  (define author/name
+    (assq-ref (package:package-properties pkg) 'upstream-name))
+  (define contentdb-package (contentdb-fetch author/name)) ; TODO warn if #f?
+  (define release (latest-release author/name))
+  (define source (package:package-source pkg))
+  (and contentdb-package release
+       (release-commit release) ; not always set
+       ;; Only continue if both the old and new version number are both
+       ;; dates or regular version numbers, as two different styles confuses
+       ;; the logic for determining which version is newer.
+       (eq? (version-style (release-version release))
+            (version-style (package:package-version pkg)))
+       (upstream-source
+        (package (package:package-name pkg))
+        (version (release-version release))
+        (urls (list (download:git-reference
+                     (url (package-repository contentdb-package))
+                     (commit (release-commit release))))))))
+
+(define %minetest-updater
+  (upstream-updater
+    (name 'minetest)
+    (description "Updater for Minetest packages on ContentDB")
+    (pred minetest-package?)
+    (latest latest-minetest-release)))
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index f3619dcd9e..e2314820d0 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -9,6 +9,7 @@
 ;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org>
 ;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -163,12 +164,13 @@ package on PyPI."
     (hyphen-package-name->name+version
      (basename (file-sans-extension url))))
 
-  (match (and=> (package-source package) origin-uri)
-    ((? string? url)
-     (url->pypi-name url))
-    ((lst ...)
-     (any url->pypi-name lst))
-    (#f #f)))
+  (or (assoc-ref (package-properties package) 'upstream-name)
+      (match (and=> (package-source package) origin-uri)
+        ((? string? url)
+         (url->pypi-name url))
+        ((lst ...)
+         (any url->pypi-name lst))
+        (#f #f))))
 
 (define (wheel-url->extracted-directory wheel-url)
   (match (string-split (basename wheel-url) #\-)
@@ -416,6 +418,11 @@ return the unaltered list of upstream dependency names."
                         description license)
   "Return the `package' s-expression for a python package with the given NAME,
 VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
+  (define (maybe-upstream-name name)
+    (if (string-match ".*\\-[0-9]+" (pk name))
+        `((properties ,`'(("upstream-name" . ,name))))
+        '()))
+  
   (call-with-temporary-output-file
    (lambda (temp port)
      (and (url-fetch source-url temp)
@@ -454,6 +461,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
                       (sha256
                        (base32
                         ,(guix-hash-url temp)))))
+                   ,@(maybe-upstream-name name)
                    (build-system python-build-system)
                    ,@(maybe-inputs required-inputs 'propagated-inputs)
                    ,@(maybe-inputs native-inputs 'native-inputs)
diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm
index bbd903a2cd..f58c6b163d 100644
--- a/guix/import/stackage.scm
+++ b/guix/import/stackage.scm
@@ -2,6 +2,8 @@
 ;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Xinglu Chem <public@yoctocell.xyz>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,9 +22,8 @@
 
 (define-module (guix import stackage)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 regex)
+  #:use-module (json)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (guix import json)
@@ -31,6 +32,8 @@
   #:use-module (guix memoization)
   #:use-module (guix packages)
   #:use-module (guix upstream)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:export (%stackage-url
             stackage->guix-package
             stackage-recursive-import
@@ -44,15 +47,31 @@
 (define %stackage-url
   (make-parameter "https://www.stackage.org"))
 
-;; Latest LTS version compatible with GHC 8.6.5.
-(define %default-lts-version "14.27")
-
-(define (lts-info-packages lts-info)
-  "Returns the alist of packages contained in LTS-INFO."
-  (or (assoc-ref lts-info "packages") '()))
-
-(define (leave-with-message fmt . args)
-  (raise (condition (&message (message (apply format #f fmt args))))))
+;; Latest LTS version compatible with current GHC.
+(define %default-lts-version "18.10")
+
+(define-json-mapping <stackage-lts> make-stackage-lts
+  stackage-lts?
+  json->stackage-lts
+  (snapshot    stackage-lts-snapshot "snapshot" json->snapshot)
+  (packages    stackage-lts-packages "packages"
+               (lambda (vector)
+                 (map json->stackage-package (vector->list vector)))))
+
+(define-json-mapping <snapshot> make-snapshot
+  stackage-snapshot?
+  json->snapshot
+  (name        snapshot-name)
+  (ghc-version snapshot-ghc-version)
+  (compiler    snapshot-compiler))
+
+(define-json-mapping <stackage-package> make-stackage-package
+  stackage-package?
+  json->stackage-package
+  (origin      stackage-package-origin)
+  (name        stackage-package-name)
+  (version     stackage-package-version)
+  (synopsis    stackage-package-synopsis))
 
 (define stackage-lts-info-fetch
   ;; "Retrieve the information about the LTS Stackage release VERSION."
@@ -62,21 +81,15 @@
                                 "/lts-" (if (string-null? version)
                                             %default-lts-version
                                             version)))
-            (lts-info (json-fetch url)))
-       (if lts-info
-           (reverse lts-info)
-           (leave-with-message "LTS release version not found: ~a" version))))))
-
-(define (stackage-package-name pkg-info)
-  (assoc-ref pkg-info "name"))
-
-(define (stackage-package-version pkg-info)
-  (assoc-ref pkg-info "version"))
+            (lts-info (and=> (json-fetch url) json->stackage-lts)))
+       (or lts-info
+           (raise (formatted-message (G_ "LTS release version not found: ~a")
+                                     version)))))))
 
-(define (lts-package-version pkgs-info name)
-  "Return the version of the package with upstream NAME included in PKGS-INFO."
+(define (lts-package-version packages name)
+  "Return the version of the package with upstream NAME included in PACKAGES."
   (let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name))
-                   (vector->list pkgs-info))))
+                   packages)))
     (stackage-package-version pkg)))
 
 
@@ -93,21 +106,22 @@
              #:key
              (include-test-dependencies? #t)
              (lts-version %default-lts-version)
-             (packages-info
-              (lts-info-packages
+             (packages
+              (stackage-lts-packages
                (stackage-lts-info-fetch lts-version))))
      "Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org.  The retrieved
 version corresponds to the version of PACKAGE-NAME specified in the LTS-VERSION
 release at stackage.org.  Return the `package' S-expression corresponding to
 that package, or #f on failure.  PACKAGES-INFO is the alist with the packages
 included in the Stackage LTS release."
-     (let* ((version (lts-package-version packages-info package-name))
+     (let* ((version (lts-package-version packages package-name))
             (name-version (hackage-name-version package-name version)))
        (if name-version
            (hackage->guix-package name-version
                                   #:include-test-dependencies?
                                   include-test-dependencies?)
-           (leave-with-message "~a: Stackage package not found" package-name))))))
+           (raise (formatted-message (G_ "~a: Stackage package not found")
+                                     package-name)))))))
 
 (define (stackage-recursive-import package-name . args)
   (recursive-import package-name
@@ -121,31 +135,46 @@ included in the Stackage LTS release."
 ;;;
 
 (define latest-lts-release
-  (let ((pkgs-info
-        (mlambda () (lts-info-packages
-                     (stackage-lts-info-fetch %default-lts-version)))))
-    (lambda* (package)
+  (let ((packages
+         (mlambda ()
+           (stackage-lts-packages
+            (stackage-lts-info-fetch %default-lts-version)))))
+    (lambda* (pkg)
       "Return an <upstream-source> for the latest Stackage LTS release of
 PACKAGE or #f if the package is not included in the Stackage LTS release."
-      (let* ((hackage-name (guix-package->hackage-name package))
-             (version (lts-package-version (pkgs-info) hackage-name))
+      (let* ((hackage-name (guix-package->hackage-name pkg))
+             (version (lts-package-version (packages) hackage-name))
              (name-version (hackage-name-version hackage-name version)))
         (match (and=> name-version hackage-fetch)
-          (#f (format (current-error-port)
-                      "warning: failed to parse ~a~%"
-                      (hackage-cabal-url hackage-name))
-              #f)
+          (#f
+           (warning (G_ "failed to parse ~a~%")
+                    (hackage-cabal-url hackage-name))
+           #f)
           (_ (let ((url (hackage-source-url hackage-name version)))
                (upstream-source
-                (package (package-name package))
+                (package (package-name pkg))
                 (version version)
-                (urls (list url))))))))))
+                (urls (list url))
+                (input-changes
+                 (changed-inputs
+                  pkg
+                  (stackage->guix-package hackage-name #:packages (packages))))))))))))
+
+(define (stackage-lts-package? package)
+  "Return whether PACKAGE is available on the default Stackage LTS release."
+  (and (hackage-package? package)
+       (let ((packages (stackage-lts-packages
+                        (stackage-lts-info-fetch %default-lts-version)))
+             (hackage-name (guix-package->hackage-name package)))
+         (find (lambda (package)
+                 (string=? (stackage-package-name package) hackage-name))
+               packages))))
 
 (define %stackage-updater
   (upstream-updater
    (name 'stackage)
    (description "Updater for Stackage LTS packages")
-   (pred hackage-package?)
+   (pred stackage-lts-package?)
    (latest latest-lts-release)))
 
 ;;; stackage.scm ends here