[bug#62202] [PATCH v4 2/6] import: Add juliahub importer.

[Nicolas Graves via Guix-patches via <guix-patches@gnu.org>]

---
 doc/guix.texi                    |  27 +++
 guix/import/juliahub.scm         | 309 +++++++++++++++++++++++++++++++
 guix/scripts/import.scm          |   2 +-
 guix/scripts/import/juliahub.scm | 107 +++++++++++
 4 files changed, 444 insertions(+), 1 deletion(-)
 create mode 100644 guix/import/juliahub.scm
 create mode 100644 guix/scripts/import/juliahub.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index c71d7e94cf..6baa726517 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14782,6 +14782,33 @@ guix import hexpm cf@@0.3.0
 
 Additional options include:
 
+@table @code
+@item --recursive
+@itemx -r
+Traverse the dependency graph of the given upstream package recursively
+and generate package expressions for all those packages that are not yet
+in Guix.
+@end table
+
+@item juliahub
+@cindex juliahub
+Import metadata from both the General
+@uref{https://github.com/JuliaRegistries/General} and Juliahub
+@uref{https://juliahub.com} Julia package repositories, as in this
+example:
+
+@example
+guix import juliahub Cthulhu@@2.8.9
+@end example
+
+The supplied package name must have the same case as in the
+aforementioned package repositories, and the version used must be an
+exact version (e.g. @code{2.8.9} instead of @code{2.8}). The command
+will also fail in the case of a Julia package that doesn't use a git
+tag.
+
+Additional options include:
+
 @table @code
 @item --recursive
 @itemx -r
diff --git a/guix/import/juliahub.scm b/guix/import/juliahub.scm
new file mode 100644
index 0000000000..ab838b6035
--- /dev/null
+++ b/guix/import/juliahub.scm
@@ -0,0 +1,309 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
+;;;
+;;; 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 juliahub)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-71)
+  #:use-module (guix http-client)
+  #:use-module (guix git)
+  #:use-module (guix import utils)
+  #:use-module (guix import json)
+  #:use-module (guix base32)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (json)
+  #:use-module ((guix licenses) #:prefix license:)
+
+  #:export (juliahub->guix-package
+            %juliahub-updater
+            juliahub-recursive-import))
+
+
+;; JuliaHub API.
+(define (juliahub-redirect-uri name)
+  (let* ((url (string-append "https://docs.juliahub.com/" name "/"))
+         (port (http-fetch url #:text? #t))
+         (_ (get-line port))
+         (meta (get-line port))
+         (regex "url=[a-zA-Z0-9]{5}\\/[0-9\\.]*")
+         (redirect (match:substring (string-match regex meta))))
+    (close-port port)
+    (string-drop redirect 4)))
+
+(define (juliahub-url name)
+  (let* ((url (string-append "https://docs.juliahub.com/" name "/"))
+         (uri (juliahub-redirect-uri name)))
+    (string-append url uri "/")))
+
+;; General package repository.
+(define %general-base-url
+  "https://raw.githubusercontent.com/JuliaRegistries/General/master/")
+
+(define (general-url package-name file)
+  (let ((folder (string-capitalize (string-take package-name 1))))
+    (string-append
+     %general-base-url folder "/" package-name "/" file)))
+
+(define (ini-line->alist line)
+  (let* ((l (string-split line #\=))
+         (attribute (string->symbol (string-drop-right (car l) 1)))
+         (value (string-drop (string-drop-right (cadr l) 1) 2)))
+    `(,attribute . ,value)))
+
+(define (ini-fetch url)
+  (let* ((port (http-fetch url #:text? #t))
+         (raw (get-string-all port))
+         (lines (drop-right (string-split raw #\newline) 1)))
+    (close-port port)
+    (map ini-line->alist lines)))
+
+;; Filtering out julia-stdlibs.
+;; To update them, see file sysimg.jl.
+(define %julia-stdlibs
+  (list "julia"
+        "ArgTools"
+        "Artifacts"
+        "Base64"
+        "CRC32c"
+        "FileWatching"
+        "Libdl"
+        "Logging"
+        "Mmap"
+        "NetworkOptions"
+        "SHA"
+        "Serialization"
+        "Sockets"
+        "Unicode"
+        "DelimitedFiles"
+        "LinearAlgebra"
+        "Markdown"
+        "Printf"
+        "Random"
+        "Tar"
+        "Dates"
+        "Distributed"
+        "Future"
+        "InteractiveUtils"
+        "LibGit2"
+        "Profile"
+        "SparseArrays"
+        "UUIDs"
+        "REPL"
+        "SharedArrays"
+        "Statistics"
+        "SuiteSparse"
+        "TOML"
+        "Test"
+        "LibCURL"
+        "Downloads"
+        "Pkg"
+        "LazyArtifacts"))
+
+;; Julia package.
+(define-json-mapping <juliahub-package> make-juliahub-package juliahub-package?
+  json->juliahub-package
+  (homepage juliahub-package-homepage) ;string
+  (readme juliahub-package-readme) ;string
+  (version juliahub-package-version) ;string
+  (description juliahub-package-description) ;string
+  (dependencies
+   juliahub-package-dependencies "deps"
+   json->juliahub-dependencies) ;list of <juliahub-dependency>
+  (url juliahub-package-url) ;string
+  (uuid juliahub-package-uuid) ;string
+  (license juliahub-package-license)) ;string
+
+(define-json-mapping <juliahub-dependency>
+  make-juliahub-dependency juliahub-dependency?
+  json->juliahub-dependency
+  (direct? juliahub-dependency-direct? "direct") ;boolean
+  (name juliahub-dependency-name) ;string
+  (uuid juliahub-dependency-uuid) ;string
+  (versions juliahub-dependency-versions "versions" vector->list)) ;list of strings
+
+(define (julia-name->guix-name name)
+  (string-append "julia-" (snake-case name)))
+
+(define* (juliahub-fetch name #:key (version #f))
+  "Return a <juliahub-package> record for package NAME, or #f on failure."
+  (let* ((uri (juliahub-redirect-uri name))
+         (slug (string-take uri 5))
+         (url (if version
+                  (string-append "https://docs.juliahub.com/" name "/"
+                                 slug "/" version "/pkg.json")
+                  (string-append (juliahub-url name) "pkg.json"))))
+    (and=> (json-fetch url) json->juliahub-package)))
+
+(define (make-julia-sexp name version source home-page synopsis description
+                         direct-dependencies test-dependencies-names license)
+  "Return the `package' s-expression for a Julia package with the given NAME,
+VERSION, SOURCE, HOME-PAGE, DESCRIPTION, DIRECT-DEPENDENCIES,
+TEST-DEPENDENCIES-NAMES and LICENSE."
+  `(package
+     (name ,(julia-name->guix-name name))
+     (version ,version)
+     (source ,source)
+     (build-system julia-build-system)
+     ,@(if (null? direct-dependencies)
+           '()
+           `((propagated-inputs
+              (list ,@(map (compose string->symbol
+                                    julia-name->guix-name
+                                    juliahub-dependency-name)
+                           direct-dependencies)))))
+     ,@(if (null? test-dependencies-names)
+           '()
+           `((native-inputs
+              (list ,@(map (compose string->symbol julia-name->guix-name)
+                           test-dependencies-names)))))
+     (synopsis ,synopsis)
+     (description ,description)
+     (home-page ,home-page)
+     (license ,(if license (spdx-string->license license) #f))))
+
+;; Dependencies helpers.
+(define (json->juliahub-dependencies vector)
+  (if (vector? vector)
+      (filter-map
+       (lambda (el)
+         (let ((dep (json->juliahub-dependency el)))
+           (if (and (juliahub-dependency-direct? dep)
+                    (not (member (juliahub-dependency-name dep)
+                                 %julia-stdlibs)))
+               dep
+               #f)))
+       (vector->list vector))))
+
+(define (parse-test-dependencies directory)
+  (let* ((port (open-input-file (string-append directory "/Project.toml")))
+         (project.toml (get-string-all port))
+         (regex "\ntest = \\[.*\\]")
+         (deps (match:substring (string-match regex project.toml)))
+         (pure (string-delete (list->char-set (list #\" #\ )) deps)))
+    (close-port port)
+    (filter (lambda (x) (not (member x %julia-stdlibs)))
+            (string-split (string-drop (string-drop-right pure 1) 7) #\,))))
+
+;; Juliahub may be more up-to-date than the General registry or the actual git
+;; tag (it seems around 6 hours pass between the time a commit is supplied to
+;; JuliaRegistrator as a release, and the time Julia TagBot Github Action makes
+;; the git tag). We have no simple way to get the commit of the latest-version.
+;; Thus the best simple thing we can do is get the latest-git-tag, and import
+;; this version instead. We do this by parsing Package.toml in the General
+;; registry, and then getting the refs of the git repo supplied by this
+;; file. Parsing this file is also necessary if the package is in a subdir of a
+;; git repository, because the information isn't present in Juliahub.
+
+;; There's a last case where some Julia packages are not based on a particular
+;; git tag. In this case, the script fails, but it seems quite rare. We could
+;; introduce the tree-commit which is available in the Versions.toml file in the
+;; General repository. This can be used to identify the state of a repository,
+;; since we have a unique hash of the listing of files and directories.
+
+(define (latest-git-tag repo)
+  (let* ((last-ref (last (remote-refs repo #:tags? #t)))
+         (last-git-tag (last (string-split last-ref #\/))))
+    (string-drop last-git-tag 1)))
+
+(define* (juliahub->guix-package package-name
+                                 #:key version #:allow-other-keys)
+  "Fetch the metadata for PACKAGE-NAME from juliahub.org, and return the
+`package' s-expression corresponding to that package, or #f on failure.
+Optionally include a VERSION string to fetch a specific version juliahub."
+  (let* ((package-toml (ini-fetch (general-url package-name "Package.toml")))
+         (subdir (assoc-ref package-toml 'subdir))
+         (tag (latest-git-tag (assoc-ref package-toml 'repo)))
+         (package (if version
+                      (juliahub-fetch package-name #:version version)
+                      (if tag
+                          (juliahub-fetch package-name #:version tag)
+                          (juliahub-fetch package-name)))))
+    (if package
+        (let* ((source directory
+                       (git->origin
+                        (juliahub-package-url package)
+                        `(tag-or-commit
+                          . ,(string-append
+                              "v" (juliahub-package-version package)))))
+               (direct-dependencies
+                (filter juliahub-dependency-direct?
+                        (juliahub-package-dependencies package)))
+               (dependencies-names (map juliahub-dependency-name
+                                        direct-dependencies))
+               (test-dependencies-names
+                (if subdir
+                    (parse-test-dependencies
+                     (string-append subdir "/" directory))
+                    (parse-test-dependencies directory)))
+               (homepage (juliahub-package-homepage package)))
+          (values (make-julia-sexp
+                   package-name
+                   (juliahub-package-version package)
+                   source
+                   (match homepage
+                     ("" (juliahub-package-url package))
+                     ((? string?) homepage)
+                     (_ (juliahub-package-url package)))
+                   (juliahub-package-description package)
+                   (beautify-description
+                    (juliahub-package-readme package))
+                   direct-dependencies
+                   test-dependencies-names
+                   (juliahub-package-license package))
+                  (append dependencies-names test-dependencies-names)))
+    (values #f '()))))
+
+;; We must use the url to get a name with the true case of juliahub/general.
+(define (guix-package->juliahub-name package)
+  (let* ((url (juliahub-package-url package))
+         (git-name (last (string-split url #\/)))
+         (ungitted-name (if (string-suffix? ".git" git-name)
+                            (string-drop-right git-name 4)
+                            git-name))
+         (package-name (if (string-suffix? ".jl" ungitted-name)
+                           (string-drop-right ungitted-name 4)
+                           ungitted-name)))
+    package-name))
+
+(define* (import-release package #:key (version #f))
+  "Return an <upstream-source> for the latest release of PACKAGE."
+  (let* ((package-name (guix-package->juliahub-name package))
+         (package      (juliahub-fetch package-name))
+         (version  (or version (juliahub-package-version package))))
+    (upstream-source
+     (package (package-name package))
+     (version version)
+     (urls (list (juliahub-package-url package))))))
+
+(define %juliahub-updater
+  (upstream-updater
+   (name 'juliahub)
+   (description "Updater for Juliahub packages")
+   (pred juliahub-package?)
+   (import import-release)))
+
+(define* (juliahub-recursive-import package-name #:optional version)
+  (recursive-import package-name
+                    #:repo '()
+                    #:repo->guix-package juliahub->guix-package
+                    #:guix-name julia-name->guix-name
+                    #:version version))
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index d2a1cee56e..8926c9610f 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -47,7 +47,7 @@ (define %standard-import-options '())
 
 (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa"
                     "gem" "go" "cran" "crate" "texlive" "json" "opam"
-                    "minetest" "elm" "hexpm" "composer"))
+                    "minetest" "elm" "hexpm" "composer" "juliahub"))
 
 (define (resolve-importer name)
   (let ((module (resolve-interface
diff --git a/guix/scripts/import/juliahub.scm b/guix/scripts/import/juliahub.scm
new file mode 100644
index 0000000000..1317c67aa3
--- /dev/null
+++ b/guix/scripts/import/juliahub.scm
@@ -0,0 +1,107 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
+;;;
+;;; 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 scripts import juliahub)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:use-module (guix scripts)
+  #:use-module (guix import juliahub)
+  #:use-module (guix scripts import)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 receive)
+  #:export (guix-import-juliahub))
+
+\f
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  '())
+
+(define (show-help)
+  (display (G_ "Usage: guix import juliahub PACKAGE-NAME[@VERSION] Import and
+convert the Julia package for PACKAGE-NAME.  Optionally, a version can be
+specified after the at-sign (@) character.\n"))
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (display (G_ "
+  -r, --recursive        generate package expressions for all Gem packages\
+ that are not yet in Guix"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specification of the command-line options.
+  (cons* (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix import gem")))
+         (option '(#\r "recursive") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'recursive #t result)))
+         %standard-import-options))
+
+\f
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-import-juliahub . args)
+  (define (parse-options)
+    ;; Return the alist of option values.
+    (parse-command-line args %options (list %default-options)
+                        #:build-options? #f))
+
+  (let* ((opts (parse-options))
+         (args (filter-map (match-lambda
+                             (('argument . value)
+                              value)
+                             (_ #f))
+                           (reverse opts))))
+    (match args
+      ((spec)
+       (receive (package-name package-version)
+           (package-name->name+version spec)
+         (let ((code (if (assoc-ref opts 'recursive)
+                         (map (match-lambda
+                                ((and ('package ('name name) . rest) pkg)
+                                 `(define-public ,(string->symbol name)
+                                    ,pkg))
+                                (_ #f))
+                              (juliahub-recursive-import package-name package-version))
+                         (let ((sexp (juliahub->guix-package package-name #:version package-version)))
+                           (if sexp sexp #f)))))
+           (match code
+             ((or #f '(#f))
+              (leave (G_ "failed to download meta-data for package '~a'~%")
+                     package-name))
+             (_ code)))))
+      (()
+       (leave (G_ "too few arguments~%")))
+      ((many ...)
+       (leave (G_ "too many arguments~%"))))))
-- 
2.41.0