;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson ;;; Copyright © 2016 Jelle Licht ;;; Copyright © 2018 swedebugia ;;; ;;; 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 . (define-module (guix import npm) #:use-module (ice-9 binary-ports) #:use-module (ice-9 control) #:use-module (ice-9 match) #:use-module (ice-9 receive) #:use-module (ice-9 regex) #:use-module (ice-9 rdelim) #:use-module (ice-9 vlist) #:use-module (gcrypt hash) #:use-module (gnu packages) #:use-module (guix base32) #:use-module (guix build git) #:use-module (guix build-system node) #:use-module ((guix download) #:prefix download:) ;; #:use-module (guix import github) #:use-module (guix import json) #:use-module (guix import utils) #:use-module ((guix licenses) #:select (expat)) #:use-module (guix packages) #:use-module (guix serialization) #:use-module (guix upstream) #:use-module (guix utils) #:use-module (json) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (web uri) #:export (npm->guix-package npm-recursive-import ;; For debugging in the REPL: npm-fetch list-requirements maybe-inputs)) ;;; ;;; Comment: ;;; This is the npm importer. ;;; Native-inputs are not considered by the importer at this stage because the ;;; code is adapted from the pypi importer and because they are for the most ;;; part not needed to build or use the package. ;;; We should compute and include the native-inputs and include them ;;; commented out. To be able to do this we need something (a new ;;; syntax-rule?) to pass comments in the returned sexp like this: ;;; (native-inputs) ;;; `(( ;;; ;;("input" ,input) ;;; )) ;;; We should add a flag to the command line to enable import of ;;; devdependencies aka. native inputs if the user desires. ;;; Perhaps a flag to indicate max levels of recursiveness is also useful to ;;; avoid ending up with 100+ records with one command. ;;; ;;; Code ;;; (define *REGISTRY* "https://registry.npmjs.org/") (define (npm-fetch name) "Return metadata from the npm registry for package NAME." (json-fetch-alist (string-append *REGISTRY* name))) (define (npm-tarball alist version) "Return the *REGISTRY* tarball url for version VERSION of ALIST" (let* ((v (assoc-ref* alist "versions" version)) (d (assoc-ref* v "dist"))) (assoc-ref* d "tarball"))) ;; TODO use this to check the tarball (define (npm-tarball-sha512 alist version) "Return the *REGISTRY* sha512sum for version VERSION of ALIST or #f if not found" (let* ((v (assoc-ref* alist "versions" version)) (d (assoc-ref* v "dist"))) (assoc-ref* d "integrity"))) (define (npm-latest-release alist) "Return a string with the latest released version from ALIST. E.g. '2.1.0'" (assoc-ref* alist "dist-tags" "latest")) (define (npm-package? package) "Return true if PACKAGE is an npm package." (string-prefix? "node-" (package-name package))) (define (node->package-name name) "Given the NAME of a package on npmjs, return a Guix-compliant name for the package. We remove the '@' and keep the '/' in scoped packages. E.g. @mocha/test -> node-mocha/test" (cond ((and (string-prefix? "@" name) (string-prefix? "node-" name)) (snake-case (string-drop name 1))) ((string-prefix? "@" name) (string-append "node-" (snake-case (string-drop name 1)))) ((string-prefix? "node-" name) (snake-case name)) (else (string-append "node-" (snake-case name))))) ;; (define (blacklisted? name) ;; "Check if the string name is blacklisted. RETURN #t if yes, else #f." ;; ;; Split the string to enable ut so blacklist scoped packages like ;; ;; @babel/core and packages like eslint-popup without having to type in ;; ;; every single combination. ;; (if (or ;; ;; Catch @babel/core ;; (member (car (string-split name (char-set #\- #\/))) blacklist) ;; (member (car (string-split name (char-set #\/))) blacklist) ;; ;; Catch eslint-plugin ;; (member (car (string-split name (char-set #\-))) blacklist) ;; (member name blacklist)) ;; #t #f)) (define (extract-npm-dependencies dependencies) "Returns a list of dependencies according to the npm naming scheme, from the npm list of dependencies DEPENDENCIES." (if (not dependencies) '() (map car dependencies))) ;; Needed when adding versioning of package inputs to maybe-inputs. (define (sanitize-npm-version version) "Return version without prefix." ;;FIXME sanitize other common prefixes (cond ((string-prefix? "^" version) (string-drop version 1)) ((string-prefix? "~" version) (string-drop version 1)) ;; Does this work when version="*"? ((string-prefix? "*" version) (string-drop version 1)) ((string-ci? "*" version) ;; Return version ="" (string-drop version 1)) (else version))) (define* (maybe-inputs package-inputs #:optional blacklist native) "Given a list of PACKAGE-INPUTS, tries to generate the 'inputs' field of a package definition. BLACKLIST and NATIVE are booleans and optional." ;; TODO add versions to avoid cyclic deps. (match package-inputs ;; clause1 pat=the empty list (() ;; body '()) ;; clause2 pat=package-inputs zero or more ((package-inputs ...) ;;body `((inputs (,'quasiquote ,package-inputs)))))) (define (list-requirements package-alist) "Return a list of dependencies after blacklisting." (let* ((name (assoc-ref package-alist "name")) (version (npm-latest-release package-alist)) (curr (assoc-ref* package-alist "versions" version)) (dependencies (assoc-ref curr "dependencies"))) ;; Only work with inputs for now. (extract-npm-dependencies dependencies))) (define (compute-inputs package-alist) "Given the PACKAGE-ALIST of an already downloaded TARBALL, return a list of name/variable pairs describing the required inputs of this package. Also return the unaltered list of upstream dependency names." (let ((dependencies (remove (cut string=? "argparse" <>) (list-requirements package-alist)))) (values (sort (map (lambda (input) (let ((guix-name (node->package-name input))) (list guix-name (list 'unquote (string->symbol guix-name))))) dependencies) (lambda args (match args (((a _ ...) (b _ ...)) (string-cipackage-name name)) ) ;; Name package guix-name-version, e.g. node-async-0.8.0 `((define-public ,(string->symbol (string-append guixname "-" version)) (package (name ,guixname) (version ,version) (source (origin (method url-fetch) (uri (npm-uri ,name version)) (sha256 (base32 ,(guix-hash-url temp))))) (build-system node-build-system) ,@(maybe-inputs input-package-names) (synopsis ,description) ; no synopsis field in package.json files (description ,description) (home-page ,home-page) (license ,license))))) upstream-dependency-names)))))) (define (extract-license package-json) (let ((license-entry (assoc-ref package-json "license")) (license-legacy (assoc-ref package-json "licenses"))) (cond ((string? license-entry) (spdx-string->license license-entry)) ((list? license-entry) (spdx-string->license (assoc-ref license-entry "type"))) ((string? license-legacy) (spdx-string->license license-legacy)) ((and license-legacy (positive? (length license-legacy))) `(list ,@(map (lambda (l) (spdx-string->license (assoc-ref l "type"))) license-legacy))) (else #f)))) (define npm->guix-package (memoize (lambda* (package-name) "Fetch the metadata for PACKAGE-NAME from registry.npmjs.com and return the `package' s-expression corresponding to that package, or #f on failure." (let ((package (npm-fetch package-name))) (and package ;; TODO catch errors here and leave with error message. (let* ((name (assoc-ref package "name")) (version (npm-latest-release package)) (curr (assoc-ref* package "versions" version)) (dependencies (assoc-ref curr "dependencies")) (dev-dependencies (assoc-ref curr "devDependencies")) (description (assoc-ref package "description")) (home-page (assoc-ref package "homepage")) (license (extract-license curr)) (source-url (npm-tarball package version))) (make-npm-sexp name version home-page description dependencies dev-dependencies license source-url ;; Pass the whole alist on to compute-inputs from ;; it in the next step. package))))))) (define (npm-recursive-import package-name) (recursive-import package-name #f #:repo->guix-package (lambda (name repo) (npm->guix-package name)) #:guix-name node->package-name)) (define (guix-package->npm-name package) "Given a npm PACKAGE return the name of the package on PyPI." ;; TODO - needed for the updater ;; Inspiration from pypi ;; (define (url->pypi-name url) ;; (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)) ;; From Jelle ;; (define (package->upstream-name package) ;; "Return the upstream name of the PACKAGE." ;; (let* ((properties (package-properties package)) ;; (upstream-name (and=> properties ;; (cut assoc-ref <> 'upstream-name)))) ;; (if upstream-name ;; upstream-name ;; #f))) ;; TODO: Use proper heuristics with package name and what-not ) (define (latest-release package) "Return an for the latest release of PACKAGE." (define upstream-name (package-name package)) (define meta (npm-fetch upstream-name)) (and meta (let ((version (npm-latest-release meta))) (upstream-source (package (package-name package)) (version version) (urls (npm-tarball meta version)))))) (define %npm-updater (upstream-updater (name 'npm) (description "Updater for Node Package Manager packages") (pred npm-package?) (latest latest-release)))