From mboxrd@z Thu Jan 1 00:00:00 1970 From: swedebugia Subject: Need help rdelim. Trying to add caching to the npm-explorer Date: Thu, 13 Dec 2018 13:15:09 +0100 Message-ID: <72291bb2-4f56-f73f-d07d-ac27b7a50f9e@riseup.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------849808A95B5D3ABAED020023" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:37385) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gXPto-0005iy-L2 for guix-devel@gnu.org; Thu, 13 Dec 2018 07:15:31 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gXPtk-0005T9-Ew for guix-devel@gnu.org; Thu, 13 Dec 2018 07:15:28 -0500 Received: from mx1.riseup.net ([198.252.153.129]:59884) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1gXPtg-0004ik-Ev for guix-devel@gnu.org; Thu, 13 Dec 2018 07:15:21 -0500 Content-Language: en-US List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel , Julien Lepiller This is a multi-part message in MIME format. --------------849808A95B5D3ABAED020023 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Hi I get this error when I run the script testing the http-fetch proc. sdb@komputilo ~/guile-npm-explorer$ guile -s npm-explorer.scm fetching allocate_stack failed: Cannot allocate memory Any ideas what is wrong? I think the error is on line 57. I tried with get-char/get-string-all and both fail the same way. Maybe this is because I have to read with a loop and rdelim? Does anyone have a simple example of that? The manual is very terse on this subject unfortunately and a quick search did not help. -- Cheers Swedebugia --------------849808A95B5D3ABAED020023 Content-Type: text/x-scheme; name="npm-explorer.scm" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="npm-explorer.scm" (use-modules (guix import json) (guix build utils) (guix import utils) (guix http-client) (srfi srfi-34) (ice-9 regex) (ice-9 textual-ports) (json)) ;; from https://gitlab.com/swedebugia/guix/blob/08fc0ec6fa76d95f4b469aa85033f1b0148f7fa3/guix/import/npm.scm (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 (slash->_ name) (if (string-match "[/]" name) (regexp-substitute #f (string-match "/+" name) 'pre "_slash_" 'post) ;;else name)) (define (read-file file) (call-with-input-file file (lambda (port) (json->scm port)))) ;; from ;; http://git.savannah.gnu.org/cgit/guix.git/tree/guix/import/json.scm ;; adapted to return unaltered JSON (define* (http-fetch url ;; Note: many websites returns 403 if we omit a ;; 'User-Agent' header. #:key (headers `((user-agent . "GNU Guile") (Accept . "application/json")))) "Return a JSON resource URL, or #f if URL returns 403 or 404. HEADERS is a list of HTTP headers to pass in the query." (guard (c ((and (http-get-error? c) (let ((error (http-get-error-code c))) (or (= 403 error) (= 404 error)))) #f)) (let* ((port (http-fetch url #:headers headers)) ;; changed the upstream here to return unaltered json: (result (get-string-all port))) (close-port port) result))) (define (cache-handler name) ;;check if cached in cache-dir (let* ((cache-dir (string-append (getenv "HOME") "/.cache/npm-explorer")) ;; sanitize name to fit in cli-context on disk ;; it can contain @ and / (cache-name (slash->_ (node->package-name name))) (filename (string-append cache-dir "/" cache-name ".package.json"))) (if (file-exists? filename) ;;yes (read-file filename) ;;no (begin (when (not (directory-exists? cache-dir)) (mkdir-p cache-dir)) ;; port closes when this closes (call-with-output-file filename (lambda (port) (display ;; this gives os the result-closure and we write it out (http-fetch (string-append "https://registry.npmjs.org/" name)) port))) ;; get the content and close (read-file filename))))) (define (get-npm-module-dot name done level) (if (member name done) done ;; convert return from cache to hashtable (let ((descr (cache-handler name))) (if descr (catch #t (lambda () (let* ((latest (hash-ref (hash-ref descr "dist-tags") "latest")) (descr (hash-ref (hash-ref descr "versions") latest)) (devdeps (hash-ref descr "devDependencies")) (deps (hash-ref descr "dependencies"))) (if deps (hash-fold (lambda (key value acc) (begin (format (current-error-port) "level ~a: ~a packages \r" level (length acc)) (format #t "\"~a\" -> \"~a\";~%" name key) (get-npm-module-dot key acc (+ 1 level)))) (cons name done) deps) (cons name done)))) (lambda _ (format #t "~a [color=red];~%" name) (cons name done))) (cons name done))))) ;; (format #t "digraph dependencies {~%") ;; (format #t "overlap=false;~%") ;; (format #t "splines=true;~%") ;; (get-npm-module-dot "mocha" '() 0) ;; (format (current-error-port) "~%") ;; (format #t "}~%") ;;test ;;(display (slash->_ "babel/mocha")) ;works ;;(cache-handler "@babel/core") ;no errors but does not write to file. hmm.. (display "fetching") (newline) (display ;fails in a weird way... (http-fetch (string-append "https://registry.npmjs.org/" "mocha"))) --------------849808A95B5D3ABAED020023--