I'm trying hard to improve the npm-explorer[1] with a semver-parser.
I get this error when testing in the REPL:
sdb@antelope ~/src/guile-npm-explorer$ guile -s npm-explorer.scm
>test.dot
;;; note: source file /home/sdb/src/guile-npm-explorer/npm-explorer.scm
;;; newer than compiled
/home/sdb/.cache/guile/ccache/2.2-LE-4-3.A/home/sdb/src/guile-npm-explorer/npm-explorer.scm.go
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;; or pass the --no-auto-compile argument to disable.
;;; compiling /home/sdb/src/guile-npm-explorer/npm-explorer.scm
;;; compiled
/home/sdb/.cache/guile/ccache/2.2-LE-4-3.A/home/sdb/src/guile-npm-explorer/npm-explorer.scm.go
Backtrace:
7 (apply-smob/1 #<catch-closure 88f83a0>)
In ice-9/boot-9.scm:
705:2 6 (call-with-prompt _ _ #<procedure default-prompt-handle…>)
In ice-9/eval.scm:
619:8 5 (_ #(#(#<directory (guile-user) 88e9910>)))
In ice-9/boot-9.scm:
2312:4 4 (save-module-excursion _)
3831:12 3 (_)
In /home/sdb/src/guile-npm-explorer/npm-explorer.scm:
345:29 2 (generate-dot "mocha" () 0 _)
199:8 1 (choose-version #<hash-table 8918540 18/31> #<procedure…>)
In unknown file:
0 (string-prefix? "*" #<procedure version ()> #<undefined> …)
ERROR: In procedure string-prefix?:
In procedure string-prefix?: Wrong type argument in position 2
(expecting string): #<procedure version ()>
The offending lambda is this one:
(define (parse-semver hashtable version)
"return the newest version within the same major or minor version"
(define (split list)
(string-split list #\.))
(define (version-list hashtable)
(map split
(map first
(hash-table->alist (hash-ref hashtable "versions")))))
(define (major list)
(first list))
(define (minor list)
(second list))
(define (minor->number list)
(string->number (minor (split list))))
;; Return latest minor with same major version.
;; e.g. ^1.1.0 -> 1.4.0 even though 2.0.0 is availiable
(let* ((version (split (string-drop version 1)))
(version-list
(map first
(hash-table->alist (hash-ref hashtable "versions"))))
(same-major
(if (equal? 3 (length version))
(fold
;; recurse through version-list
(lambda (ver lst)
(if (string-prefix? (major version) ver)
(cons ver lst)
lst))
'()
version-list)
;; not a version triplet
#f)))
... (se the rest of the sexp in the file attached.
Any ideas whats wrong? I'm still new to lambdas.
--
Cheers
Swedebugia
[1]
https://gitlab.com/swedebugia/guile-npm-explorer/blob/master/npm-explorer.scm;;; Copyright © 2018 Julien Lepiller <jul...@lepiller.eu>
;;; Copyright © 2018 swedebugia <swedebu...@riseup.net>
;;;
;;; This file is part of guile-npm-explorer.
;;;
;;; guile-npm-explorer 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.
;;;
;;; guile-npm-explorer 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 guile-npm-explorer. If not, see <http://www.gnu.org/licenses/>.
;; Usage:
;; $guile -s npm-explorer.scm >mocha.dot (later you pipe these
;; dot-files into graphviz to produce the actual graph.
;;
;; or
;;
;; Do it all at once:
;; guile -s npm-explorer.scm |dot -Tsvg > mocha.svg
;;
;; or
;;
;; Do it all at once and show it with no nonsense in between:
;; guile -s npm-explorer.scm |dot -Tsvg > mocha.svg && eog mocha.svg
(define-module (npm-explorer)
#:use-module (guix import json)
#:use-module (guix build utils)
#:use-module (guix import utils)
#:use-module (guix http-client)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (ice-9 textual-ports)
#:use-module (json)
#:export (output-dot
;; for debugging:
parse-semver
cache-handler
generate-dot))
;; from
;;
https://gitlab.com/swedebugia/guix/blob/08fc0ec6fa76d95f4b469aa85033f1b0148f7fa3/guix/import/npm.scm
;; imported here unchanged because it is not avaliable in upstream guix yet.
(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)
"Sanitize slashes to avoid cli-problems"
(if (string-match "[/]" name)
(regexp-substitute #f (string-match "/+" name)
'pre "_slash_" 'post)
;;else
name))
;; FIXME this does not return #f if the file is empty.
(define (read-file file)
"RETURN hashtable from JSON-file in cache."
(if (< (stat:size (stat file)) 10)
;; size is less than 10 bytes, return #f
#f
;; return file parsed to hashtables with (json)
(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* (npm-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. RETURN direct from cache or fetch and return
from cache."
(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
;;check if empty
(if (read-file filename)
(read-file filename)
;;file empty
(begin
(format
(current-error-port)
"cache for ~a was empty, trying to download again..." name)
(delete-file filename)
;; call handler again to try fetching again
(cache-handler name)))
;;no
(begin
(when (not (directory-exists? cache-dir))
(mkdir-p cache-dir))
;; port closes when this closes
(call-with-output-file filename
(lambda (port)
(format port "~a"
;; this gives os the result-closure and we write it out
(npm-http-fetch
(string-append
"https://registry.npmjs.org/";
name)))))
;; get the content and close
(read-file filename)))))
;; FIXME consider even the patch versions.
;; See
https://stackoverflow.com/questions/22343224/whats-the-difference-between-tilde-and-caret-in-package-json
(define (parse-semver hashtable version)
"return the newest version within the same major or minor version"
(define (split list)
(string-split list #\.))
(define (version-list hashtable)
(map split
(map first
(hash-table->alist (hash-ref hashtable "versions")))))
(define (major list)
(first list))
(define (minor list)
(second list))
(define (minor->number list)
(string->number (minor (split list))))
;; Return latest minor with same major version.
;; e.g. ^1.1.0 -> 1.4.0 even though 2.0.0 is availiable
(let* ((version (split (string-drop version 1)))
(version-list
(map first
(hash-table->alist (hash-ref hashtable "versions"))))
(same-major
(if (equal? 3 (length version))
(fold
;; recurse through version-list
(lambda (ver lst)
(if (string-prefix? (major version) ver)
(cons ver lst)
lst))
'()
version-list)
;; not a version triplet
#f)))
;; From
;;
https://www.gnu.org/software/guile/manual/html_node/SRFI_002d1-Fold-and-Map.html#SRFI_002d1-Fold-and-Map
(fold-right
(lambda (str prev)
(if (> (minor->number str) (minor->number prev))
str
prev))
;;init with 0.0.0 work with minor->number
"0.0.0"
same-major)))
;;debug
;; (display (parse-semver (cache-handler "request") "~1.87.0"))
;; (display (parse-semver (cache-handler "request") "^1.1.0"))
(define (choose-version hashtable version)
(cond
((or (string-prefix? "*" version)
(string-prefix? "~" version))
"latest")
;; Specific version needed. This is rare...
((string-prefix? "=" version)
(string-drop version 1))
;; Conditionally later versions
((string-prefix? "^" version)
(if (parse-semver hashtable version)
(parse-semver hashtable version)
;; could not parse
(error (string-append "parse-semver: could not parse" version))))
(else
;; FIXME: could this default to "latest"?
;; No recognized prefix. Return the version specified.
version)))
(define (lookup-latest hashtable)
"RETURN string with the latest release version."
(hash-ref (hash-ref hashtable "dist-tags") "latest"))
(define (extract-version hashtable version)
"Return extract from hashtable corresponding to version or #f if not
found."
(cond
((string-prefix? "^" version)
(parse-semver hashtable version))
((or
(equal? version "latest")
(equal? version "*"))
(let ((latest (hash-ref (hash-ref hashtable "dist-tags") "latest")))
(hash-ref (hash-ref hashtable "versions") latest)))
(else
;;extract the version specified
(hash-ref (hash-ref hashtable "versions") version))))
(define (extract-deps hashtable version)
"Return extract of dependencies from hashtable corresponding to
version or #f if none."
(cond
((or
(equal? version "latest")
(equal? version "*"))
(let* ((latest (lookup-latest hashtable))
(data (hash-ref (hash-ref hashtable "versions") latest)))
(hash-ref data "dependencies")))
(else
;;extract the version specified
(let ((data (hash-ref (hash-ref hashtable "versions") version)))
(hash-ref data "dependencies")))))
(define* (output-dot name
#:optional
(version "latest"))
(begin
(format #t "digraph dependencies {~%")
(format #t "overlap=false;~%")
(format #t "splines=true;~%")
(generate-dot name '() 0 version)
(format (current-error-port) "~%")
(format #t "}~%")))
;;test
;;(output-dot "mocha") ;broken
;; Originally from Julien.
;; This is
;; Heavily modified to get specific version.
(define* (generate-dot name done level
#:optional
(version "latest"))
"RETURN package count and level to std-error and dot-formatted data
to std-out."
;;
;; Internal definitions
;;
(define (status-line level acc)
(format
(current-error-port)
"level ~a: ~a packages \r" level (length acc)))
(define (dot-line name version key value)
(format #t
"\"~a@~a\" -> \"~a@~a\";~%"
name version key value))
;; Note, this was factored out because it got too hard to overview
;; given the limitations on line length.
(define (my-catch package-hashtable wanted-version)
"Extract the version from the hashtable and recurse through the
dependencies calling generate-dot each time until done. The output
from format are sent to current-error-port (status information) and
current-output (dot-line)."
(catch #t
;; Thunk
(lambda ()
(let* ( ;; Extract dependencies corresponding to version
(dependencies (extract-deps package-hashtable wanted-version)))
(if dependencies
;; Fold through all the elements in the
;; hashtable
(hash-fold
(lambda (key value acc)
;; key value = name and version-string
;; directly from the hashtable
(begin
(status-line level acc)
(if (equal? "latest" wanted-version)
;; lookup latest
(let ((latest
(lookup-latest package-hashtable)))
(dot-line name latest key value))
;; no lookups needed
(dot-line name wanted-version key value)))
;; call recursively with the version
;; of the dep from the hashtable
(generate-dot ;closure of lambda
key acc (+ 1 level) value))
;; fold recursive - closure of hash-fold
(cons name done) dependencies)
;; else, add to done
(cons name done))))
;; Handler if thunk throws #t
;; not found!
(lambda _
(error
(string-append
"something went wrong. please report an issue here:
https://gitlab.com/swedebugia/guile-npm-explorer/issues";)))))
;;
;; Entry
;;
(if (member name done)
done
;; Convert return from cache to hashtable instead of fetching
;; everything multiple times for packages with shared dependency
;; tails. This results in a significant speedup when file is in
;; the cache.
;; NOTE: The cache has no TTL implemented yet so you should
;; clear it from to time manually if you want newer versions to appear.
(let* ((package-hashtable (cache-handler name))
;; Choose latest version
(wanted-version (choose-version package-hashtable version))
;; Extract hashtable corresponding to version
(extracted-version (extract-version package-hashtable
wanted-version)))
;; Process the version specified if found
(if extracted-version
(my-catch package-hashtable wanted-version)
;; else
(cons name done)))))
;; (format #t "digraph dependencies {~%")
;; (format #t "overlap=false;~%")
;; (format #t "splines=true;~%")
(generate-dot "mocha" '() 0 version)
;; (format (current-error-port) "~%")
;; (format #t "}~%")
