diff mbox series

[bug#62202,01/21] import: juliahub: first script draft.

Message ID 20230315125130.23041-1-ngraves@ngraves.fr
State New
Headers show
Series Juliahub import script. | expand

Commit Message

Nicolas Graves March 15, 2023, 12:51 p.m. UTC
---
 guix/import/go.scm               |   6 +-
 guix/import/juliahub.scm         | 183 +++++++++++++++++++++++++++++++
 guix/scripts/import.scm          |   2 +-
 guix/scripts/import/juliahub.scm | 107 ++++++++++++++++++
 4 files changed, 295 insertions(+), 3 deletions(-)
 create mode 100644 guix/import/juliahub.scm
 create mode 100644 guix/scripts/import/juliahub.scm
diff mbox series

Patch

diff --git a/guix/import/go.scm b/guix/import/go.scm
index 69937f8a4d..f264715fbd 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -503,9 +503,11 @@  (define (transform-version version)
         '(string-append "v" version)
         '(go-version->git-ref version))))
 
-(define (vcs->origin vcs-type vcs-repo-url version)
+(define* (vcs->origin vcs-type vcs-repo-url version
+                      #:optional transform-version)
   "Generate the `origin' block of a package depending on what type of source
-control system is being used."
+control system is being used. Optionally use the function TRANSFORM-VERSION
+which takes version as an input."
   (case vcs-type
     ((git)
      (git->origin vcs-repo-url `(tag-or-commit . ,version) transform-version))
diff --git a/guix/import/juliahub.scm b/guix/import/juliahub.scm
new file mode 100644
index 0000000000..efe6abbb24
--- /dev/null
+++ b/guix/import/juliahub.scm
@@ -0,0 +1,183 @@ 
+;;; 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 (ice-9 string-fun)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-1)
+  #:use-module (guix http-client)
+  #:use-module (guix import utils)
+  #:use-module (guix import json)
+  #:use-module (guix base16)
+  #: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))
+
+(define (juliahub-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-uri name)))
+    (string-append url uri "/")))
+
+(define (juliahub-slug-version name)
+  (let* ((uri (juliahub-uri name))
+         (slug (string-take uri 5))
+         (latest-version (string-drop uri 6)))
+    `(,slug ,latest-version)))
+
+(define (json->juliahub-direct-dependencies vector)
+  (if (vector? vector)
+      (filter-map
+       (lambda (el)
+         (let ((dep (json->juliahub-dependency el)))
+           (if (juliahub-dependency-direct? dep)
+               dep
+               #f)))
+       (vector->list vector))))
+
+;; 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
+  ;; (slug juliahub-package-slug) ;string
+  (version juliahub-package-version) ;string
+  (description juliahub-package-description) ;string
+  (dependencies
+   juliahub-package-dependencies "deps"
+   json->juliahub-direct-dependencies) ;list of <juliahub-dependency>
+   ;; (lambda (vector)
+     ;; (map json->juliahub-dependency (vector->list vector))))
+  (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
+  ;; (slug juliahub-dependency-slug) ;string
+
+(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."
+  (and=> (json-fetch (string-append (juliahub-url name) "pkg.json"))
+         json->juliahub-package))
+
+(define (make-julia-sexp name version uri hash home-page synopsis description
+                         dependencies licenses)
+  "Return the `package' s-expression for a Julia package with the given NAME,
+VERSION, URI, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES."
+  `(package
+     (name ,(julia-name->guix-name name))
+     (version ,version)
+     (source (origin
+               (method url-fetch)
+               (uri ,uri)
+               (sha256
+                (base32
+                 "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5"
+                 ;; ,(bytevector->nix-base32-string hash)
+                 ))))
+     (build-system julia-build-system)
+     ,@(if (null? dependencies)
+           '()
+           `((inputs
+              (list ,@(map (compose julia-name->guix-name juliahub-dependency-name)
+                           dependencies)))))
+     (synopsis ,synopsis)
+     (description ,description)
+     (home-page ,home-page)
+     (license ,(match licenses
+                 (() #f)
+                 ((license) (license->symbol license))
+                 (_ `(list ,@(map license->symbol licenses)))))))
+
+(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 (if version
+                      (juliahub-fetch package-name version)
+                      (juliahub-fetch package-name))))
+    (if package
+        (let* ((dependencies-names
+                (map juliahub-dependency-name
+                     (juliahub-package-dependencies package)))
+               (licenses
+                (map spdx-string->license
+                     (list (juliahub-package-license package)))))
+          (values (make-julia-sexp
+                   package-name
+                   (juliahub-package-version package)
+                   (juliahub-package-url package)
+                   "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5"
+                   (juliahub-package-homepage package)
+                   (juliahub-package-description package)
+                   (beautify-description (juliahub-package-readme package))
+                   (juliahub-package-dependencies package)
+                   licenses)
+                  dependencies-names))
+        (values #f '()))))
+
+(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-version gem)))
+         (url      (rubyjuliahubs-uri gem-name version)))
+    (upstream-source
+     (package (package-name package))
+     (version version)
+     (urls (list url)))))
+
+(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 ruby-package-name
+                    #:version version))
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index f84a964a53..ef4e0b9cc6 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"))
+                    "minetest" "elm" "hexpm" "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))
+
+
+;;;
+;;; 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))
+
+
+;;;
+;;; 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~%"))))))