Help wanted with recursive npm import returning #f

[swedebugia@riseup.net]

[-- Attachment #1: Type: text/plain, Size: 1345 bytes --]

Hi

Introduction
------------
Inspired by Ricardos commit here I rewrote most of the npm importer.

Added memoization, receive, stream->list, values and rewrote the tarball
fetcher to use only npm-uri and tarballs from the registry. Additionally
I implemented handling of scoped packages (e.g. @babel/core).

It contains less lines of code than Jelles importer.

The single import works and is a lot faster and more reliable than
before when fuzzy matching on github was used. See it in action:
http://paste.debian.net/1054384/

Caveats:
1) we don't know if the registry-tarballs are reproducible.
2) filename is the same as the upstream tarball -> we should convert it
to guix-name.
3) we have to download the tarball because sha256 is not among the
hashes computed by npm. (I emailed npm@npmjs.org to ask for them to
compute it for all their tarballs :) )

Help wanted
-----------

There is a bug which only affects the recursive importer. I tried hard
finding it but I'm in way over my head and my guile-foo does not seem to
cut it with this one. :) 

For recursive output it downloads but outputs #f in the end instead of
the sexps. See example output: http://paste.debian.net/1054383/

Trying to debug via the REPL I met this:
scheme@(guile-user) [1]> (npm-recursive-import "async")
$3 = #<stream ? ...>

Any ideas? 

-- 
Cheers 
Swedebugia

[-- Attachment #2: npm.scm --]
[-- Type: text/plain, Size: 12786 bytes --]

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2018 swedebugia <swedebugia@riseup.net>
;;;
;;; 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 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-ci<? a b)))))
            dependencies)))

(define (make-npm-sexp name version home-page description
                       dependencies dev-dependencies license
		       source-url package-alist)
  "Return the `package' s-expression for a Node package with the given string NAME,
string VERSION, string HOME-PAGE, string DESCRIPTION, alist DEPENDENCIES,
alist DEV-DEPENDENCIES, list LICENSES and string SOURCE-URL. The alists
contain: npm-name . version"
  (call-with-temporary-output-file
   (lambda (temp port)
     (and (url-fetch source-url temp)
          (receive (input-package-names upstream-dependency-names)
	      (compute-inputs package-alist)
	    (values
             (let ((name (string-downcase name))
                   (guixname (node->package-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 <upstream-source> 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)))