---
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
@@ -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))
new file mode 100644
@@ -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))
@@ -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
new file mode 100644
@@ -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~%"))))))