Re: GSoC NPM

[Jan Nieuwenhuizen]

Jelle Licht writes:

Hi Jelle!

> - The ability to parse npm version data
> - An npm backend for ~guix import~
> - Npm modules in guix
> - An actual build system for npm packages

That's amazing.  I played with it today and noticed that it always
downloads devDependencies.  Why is that...I disabled that because
I think I don't need those?

Also, I found that you prefer going through the repository/github
instead of using the dist tarball.  Why is that?  Some packages do not
have a repository field, such as `http'.  I changed that to prefer using
the dist tarball and use repository as fallback.  You probably want to
change that order?

I made some other small changes, see attached patch, to be able to
download all packages that I need, notably: cjson, http and xmldom.

Thanks again for your amazing work, hoping to have this in master soon.

Greetings,
Jan

>From 151f5d338199f94651d499070240ff5f1e75058c Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <address@hidden>
Date: Fri, 2 Sep 2016 16:16:35 +0200
Subject: [PATCH] npm importer: updates; fixes downloading of e.g.: cjson,
 http, xmldom.

* gnu/nmp.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* scripts/npm-import: New file.
* guix/import/npm.scm (gh-fuzzy-tag-match): Add two fallbacks: missing /TAGS
and VERSION mismatch.
(source-uri): Prefer using (dist . tarball) over (repository . url).
(spdx-string->license): Add LGPL.
(package-origin): Handle registry.npmjs.org url.
* (npm->guix-package): Discard devDependencies.
---
 gnu/local.mk         |   1 +
 gnu/packages/npm.scm |  12 +++++
 guix/import/npm.scm  | 125 ++++++++++++++++++++++++++++++++++++---------------
 scripts/npm-import   |  31 +++++++++++++
 4 files changed, 132 insertions(+), 37 deletions(-)
 create mode 100644 gnu/packages/npm.scm
 create mode 100755 scripts/npm-import

diff --git a/gnu/local.mk b/gnu/local.mk
index b9d2a11..4fa94c7 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -255,6 +255,7 @@ GNU_SYSTEM_MODULES =                                \
   %D%/packages/nettle.scm                      \
   %D%/packages/networking.scm                  \
   %D%/packages/ninja.scm                       \
+  %D%/packages/npm.scm                         \
   %D%/packages/node.scm                                \
   %D%/packages/noweb.scm                       \
   %D%/packages/ntp.scm                         \
diff --git a/gnu/packages/npm.scm b/gnu/packages/npm.scm
new file mode 100644
index 0000000..0a483d2
--- /dev/null
+++ b/gnu/packages/npm.scm
@@ -0,0 +1,12 @@
+(define-module (gnu packages npm)
+  #:use-module (guix licenses)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix build-system node))
+
+;; FIXME
+(define npm-license-unknown public-domain)
+
+#!
+scripts/npm-import async-q q cjson http fs-extra  xmldom >> 
gnu/packages/npm.scm
+!#
diff --git a/guix/import/npm.scm b/guix/import/npm.scm
index b6c9120..1e7f2c4 100644
--- a/guix/import/npm.scm
+++ b/guix/import/npm.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <address@hidden>
 ;;; Copyright © 2016 Jelle Licht <address@hidden>
+;;; Copyright © 2016 Jan Nieuwenhuizen <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -187,10 +188,10 @@ GITHUB-REPO"
                       "https://api.github.com/repos/";
                       (github-user-slash-repository github-repo)
                       "/tags"))
-         (json (json-fetch*
-                (if token
-                    (string-append api-url "?access_token=" token)
-                    api-url))))
+         (api-url (if token
+                      (string-append api-url "?access_token=" token)
+                      api-url))
+         (json (json-fetch* api-url)))
     (if (eq? json #f)
         (if token
             (error "Error downloading release information through the GitHub
@@ -208,8 +209,25 @@ api-url))
                     (member name fuzzy-tags)))
                 json)))
           (match proper-release
-            (()                       ;empty release list
-             #f)
+            (()                       ;fuzzy version mismatch
+             (if (pair? json)
+                 (begin
+                   ;;XXX: Just pick first release
+                   ;; e.g.: xmldom 0.1.16 vs 0.1.22
+                   (hash-ref (car json) "name"))
+                 ;;XXX: No tags: Just pick latest commit from master
+                 ;; e.g.: cjson
+                 ;; TODO: iso master, snarf default_branch from /
+                 (let* ((branches-url (string-replace-substring api-url 
"/tags" "/branches"))
+                        (branches (json-fetch* branches-url))
+                        (first-or-master
+                         (or
+                          (find (lambda (x) (equal? (hash-ref x "name") 
"master"))
+                                branches)
+                          (car branches)))
+                        (commit (hash-ref first-or-master "commit"))
+                        (sha (hash-ref commit "sha")))
+                   sha)))
             ((release . rest)         ;one or more releases
              ;;XXX: Just pick the first release
              (let ((tag (hash-ref release "name")))
@@ -265,8 +283,19 @@ GITHUB-URL."
 
 (define (source-uri npm-meta version)
   "Return the repository url for version VERSION of NPM-META"
-  (let* ((v    (assoc-ref* npm-meta "versions" version)))
-    (normalise-url (assoc-ref* v "repository" "url"))))
+  (let* ((v    (assoc-ref* npm-meta "versions" version))
+         (repo (assoc-ref v "repository"))
+         (dist (assoc-ref v "dist")))
+    (or
+     ;; e.g.: http
+     ;; FIXME: this will prefer registry.npmjs.org
+     (and dist
+          (assoc-ref dist "tarball"))
+
+     ;; FIXME: this will prefer github.org
+     (and repo
+          (and=> (assoc-ref repo "url") normalise-url))
+     )))
 
 (define (guix-hash-url path)
   "Return the hash of PATH in nix-base32 format. PATH can be either a file or
@@ -319,6 +348,7 @@ package."
     ("IJG" 'ijg)
     ("Imlib2" 'imlib2)
     ("IPA" 'ipa)
+    ("LGPL" 'lgpl2.0)
     ("LGPL-2.0" 'lgpl2.0)
     ("LGPL-2.0+" 'lgpl2.0+)
     ("LGPL-2.1" 'lgpl2.1)
@@ -359,32 +389,46 @@ command."
 located at REPO-URL. Tries to locate a released tarball before falling back to
 a git checkout."
   (let ((uri (string->uri repo-url)))
-    (if (equal? (uri-host uri) "github.com")
-        (call-with-temporary-output-file
-         (lambda (temp port)
-           (let* ((gh-version (gh-fuzzy-tag-match repo-url version))
-                  (tb (github-release-url repo-url gh-version))
-                  (result (url-fetch tb temp))
-                  (hash (bytevector->nix-base32-string (port-sha256 port))))
-             (close-port port)
-             `(origin
-                (method url-fetch)
-                (uri ,tb)
-                (sha256
-                 (base32
-                  ,hash))))))
-        (call-with-temporary-directory
-         (lambda (temp-dir)
-           (let ((fuzzy-version (generic-fuzzy-tag-match repo-url version)))
-             (and (node-git-fetch repo-url fuzzy-version temp-dir)
-                  `(origin
-                     (method git-fetch)
-                     (uri (git-reference
-                           (url ,repo-url)
-                           (commit ,fuzzy-version)))
-                     (sha256
-                      (base32
-                       ,(guix-hash-url temp-dir)))))))))))
+    (cond
+     ((equal? (uri-host uri) "registry.npmjs.org")
+      (call-with-temporary-output-file
+       (lambda (temp port)
+         (let* ((result (url-fetch repo-url temp))
+                (hash (bytevector->nix-base32-string (port-sha256 port))))
+           (close-port port)
+           `(origin
+              (method url-fetch)
+              (uri ,repo-url)
+              (sha256
+               (base32
+                ,hash)))))))
+     ((equal? (uri-host uri) "github.com")
+      (call-with-temporary-output-file
+       (lambda (temp port)
+         (let* ((gh-version (gh-fuzzy-tag-match repo-url version))
+                (tb (github-release-url repo-url gh-version))
+                (result (url-fetch tb temp))
+                (hash (bytevector->nix-base32-string (port-sha256 port))))
+           (close-port port)
+           `(origin
+              (method url-fetch)
+              (uri ,tb)
+              (sha256
+               (base32
+                ,hash)))))))
+     (else
+      (call-with-temporary-directory
+       (lambda (temp-dir)
+         (let ((fuzzy-version (generic-fuzzy-tag-match repo-url version)))
+           (and (node-git-fetch repo-url fuzzy-version temp-dir)
+                `(origin
+                   (method git-fetch)
+                   (uri (git-reference
+                         (url ,repo-url)
+                         (commit ,fuzzy-version)))
+                   (sha256
+                    (base32
+                     ,(guix-hash-url temp-dir))))))))))))
 
 (define (make-npm-sexp name version home-page description
                        dependencies dev-dependencies license source-url)
@@ -444,11 +488,16 @@ npm list of dependencies DEPENDENCIES."
       (spdx-string->license (assoc-ref license-entry "type")))
      ((string? license-legacy)
       (spdx-string->license license-legacy))
+     ((and (pair? license-legacy) (string? (car license-legacy)))
+      (if (= (length license-legacy) 1)
+          (spdx-string->license (car license-legacy))
+          (map 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
+      (format (current-error-port) "extract-license: no license found: ~a\n" 
package-json)
       #f))))
 
 (define (npm->guix-package package-name)
@@ -460,7 +509,9 @@ npm list of dependencies DEPENDENCIES."
                (version (latest-source-release package))
                (curr (assoc-ref* package "versions" version))
                (raw-dependencies (assoc-ref curr "dependencies"))
-               (raw-dev-dependencies (assoc-ref curr "devDependencies"))
+               ;; TODO: do not recurse into devDependencies
+               (raw-dev-dependencies #f;;(assoc-ref curr "devDependencies")
+                )
                (dependencies (extract-guix-dependencies raw-dependencies))
                (dev-dependencies (extract-guix-dependencies
                                   raw-dev-dependencies))
@@ -469,8 +520,8 @@ npm list of dependencies DEPENDENCIES."
                  (extract-npm-dependencies raw-dependencies)
                  (extract-npm-dependencies raw-dev-dependencies)))
                (description (assoc-ref package "description"))
-               (home-page (assoc-ref package "homepage"))
-               (license (extract-license curr))
+               (home-page (or (assoc-ref package "homepage") 
"http://npmjs.com";))
+               (license (or (extract-license curr) 'npm-license-unknown))
                (source-url (source-uri package version)))
           (values 
            (make-npm-sexp name version home-page description
diff --git a/scripts/npm-import b/scripts/npm-import
new file mode 100755
index 0000000..3f45aa0
--- /dev/null
+++ b/scripts/npm-import
@@ -0,0 +1,31 @@
+#! /bin/sh
+# -*- scheme -*-
+unset LANG LC_ALL
+unset GUILE_AUTO_COMPILE GUILE_LOAD_COMPILED_PATH
+exec ${GUILE-guile} --no-auto-compile -L $PWD -C $PWD -e '(@@ (npm-import) 
main)' -s "$0" ${1+"$@"}
+!#
+
+(define-module (npm-import)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (srfi srfi-26)
+  #:use-module (guix import npm)
+  #:use-module (gnu packages npm))
+
+(define (package->define entry)
+  `(define-public ,(string->symbol (string-append "node-" (car entry)))
+     ,(cadr entry)))
+
+(define (name->node.scm package-name)
+  (format (current-error-port) "package: ~a\n" package-name)
+  (let* ((packages-alist (recursive-import package-name))
+         (defines (map package->define packages-alist))
+         (file (open-file (string-append "node-" package-name ".scm") "w")))
+    (map (cut pretty-print <> file) defines)
+    (close file)))
+
+(define (main args)
+  (let ((files (cdr (command-line))))
+   (when (null? files)
+     (format (current-error-port) "Usage: npm-import NPM-PACKAGE-NAME\n")
+     (exit 1))
+   (for-each name->node.scm files)))
-- 
2.9.3

-- 
Jan Nieuwenhuizen <address@hidden> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl