Need help rdelim. Trying to add caching to the npm-explorer

[swedebugia <swedebugia@riseup.net>]

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

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

[-- Attachment #2: npm-explorer.scm --]
[-- Type: text/x-scheme, Size: 4182 bytes --]

(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")))