puck/zilch
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(zilch lang go vfs): move to (zilch vfs)

Browse source 
It really wasn't that go-specific anymore.
This commit is contained in:
puck 2024-11-27 15:43:29 +00:00
parent c68f3852e0
commit a008d0c0c2
8 changed files with 28 additions and 113 deletions
Download patch file Download diff file Expand all files Collapse all files

126
lang/go/src/vfs.sld
View file

@ -1,73 +1,22 @@
;; Contains procedures to work with a very simple virtual filesystem,
;; abstracting between local and in-store store paths.
;;
;; A VFS is defined as a vector containing pairs consisting of the directory's
;; name, with a forward slash prefixed and postfixed (e.g. `/` or `/foo/bar/`).
;; Each pair then contains another vector, mapping filename to any value that
;; can be used as a z-expression (e.g. `store-path-for-fod` or `zfile`).
;; Contains go-specific procedures to work with VFSes.
(define-library (zilch lang go vfs)
(import
(scheme base) (scheme write) (scheme read) (scheme file) (scheme process-context) (scheme lazy) (scheme case-lambda)
(scheme base) (scheme write) (scheme file) (scheme process-context) (scheme lazy)
(chicken file)
(zilch magic) (zilch file) (zilch zexpr)
(zilch nix drv) (zilch nix path) (zilch nixpkgs)
(zilch vfs)
(json)
(chicken base) (chicken format) (chicken foreign)
(chicken base) (chicken foreign)
(scheme char)
(srfi 4) (srfi 113) (srfi 128) (srfi 133) (srfi 146) (srfi 152) (srfi 207)
(zilch lang go) (zilch lang go core) (zilch lang go stdlib) (zilch lang go sum) (zilch lang go fetch)
(chicken foreign))
(chicken foreign)
(zilch vfs))
(export vfs? vfs-dir-files vfs-file-ref vfs-dir-filter vfs-dir-filter-all vfs-from-dirhash vfs-from-directory vfs-filter-for-go-package vfs-to-store vfs-to-json)
(export vfs-from-dirhash vfs-filter-for-go-package vfs-to-json)
(begin
;; `contents` is a mapping whose keys are a pair (dir . filename) to file contents (e.g. zfile, or store path).
;; The file contents may be the symbol 'directory to indicate there's a directory.
;;
;; The root directory is specified by `dir` being an empty string. There are no trailing or leading slashes.
(define-record-type <vfs>
(make-vfs contents)
vfs?
(contents vfs-contents))
(define (vfs-dir-files vfs dir)
(mapping-map->list
(lambda (k v) (cons (cdr k) v))
(mapping-filter
(lambda (key val)
(and (not (eq? val 'directory)) (string=? (car key) dir)))
(vfs-contents vfs))))
(define (vfs-file-ref vfs dirname filename)
(mapping-ref/default (vfs-contents vfs) (cons dirname filename) #f))
;; Calls the filter with the dir, filename, and contents, for each file.
;; If filter returns #f, the file in the vfs will be replaced by /dev/null.
(define (vfs-dir-filter vfs filter)
(make-vfs
(mapping-map/monotone
(lambda (key val)
(if (or (eq? val 'directory) (filter (car key) (cdr key) val)) (values key val) (values key "/dev/null")))
(make-default-comparator)
(vfs-contents vfs))))
;; Calls the filter for each directory. If the filter returns #f, the directory's files are replaced with `/dev/null`.
(define (vfs-dir-filter-all filter vfs)
(define to-filter-out (set (make-default-comparator)))
(mapping-for-each
(lambda (key val)
(when (and (eq? val 'directory) (not (filter (string-append (car key) "/" (cdr key)))))
(set! to-filter-out (set-adjoin! to-filter-out (string-append (car key) "/" (cdr key))))))
(vfs-contents vfs))
(define (is-filtered dirname)
(set-any? (lambda (v) (string=? v dirname)) to-filter-out))
(make-vfs
(mapping-map/monotone
(lambda (key val)
(if (or (eq? val 'directory) (not (is-filtered (car key)))) (values key val) (values key "/dev/null")))
(make-default-comparator)
(vfs-contents vfs))))
(define (read-full-file port)
(define buf (make-bytevector 2048 0))
(call-with-port (open-output-bytevector)
@ -76,47 +25,24 @@
(unless (eof-object? read-bytes) (write-bytevector buf outport 0 read-bytes))))))
(foreign-declare "#include \"dirhash_source.h\"")
(define dirhash-generator
(go-package-link
(go-package-compile "main"
(map go-stdlib-ref '("archive/zip" "crypto/sha256" "fmt" "io" "os" "sort"))
(list (cons "main.go" (zfile (foreign-value "dirhash_source" nonnull-c-string)))))))
(delay (go-package-link
(go-package-compile "main"
(map go-stdlib-ref '("archive/zip" "crypto/sha256" "fmt" "io" "os" "sort"))
(list (cons "main.go" (zfile (foreign-value "dirhash_source" nonnull-c-string))))))))
(foreign-declare "#include \"unzip_one_source.h\"")
(define unpack-zip
(go-package-link
(go-package-compile "main"
(map go-stdlib-ref '("archive/zip" "io" "os"))
(list (cons "main.go" (zfile (foreign-value "unzip_one_source" nonnull-c-string)))))))
(delay (go-package-link
(go-package-compile "main"
(map go-stdlib-ref '("archive/zip" "io" "os"))
(list (cons "main.go" (zfile (foreign-value "unzip_one_source" nonnull-c-string))))))))
(define (rewrite-go-package-name-for-url name)
(define out "")
(string-for-each (lambda (ch)
(if (char-upper-case? ch) (set! out (string-append out (string #\! (char-downcase ch)))) (set! out (string-append out (string ch))))) name)
out)
;; Takes a VFS and writes its directory structure into the Nix store,
;; returning a zdir describing the root directory.
(define (vfs-to-store vfs)
(define dirmap (mapping (make-default-comparator)))
(mapping-for-each
(lambda (k contents)
(define dir (car k))
(define fname (cdr k))
(if (eq? contents 'directory)
(set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname 'directory) v)) '()))
(set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname (zsymlink contents)) v)) '()))))
(vfs-contents vfs))
(define (read-dir dirname)
(define contents (mapping-ref/default dirmap dirname '()))
(for-each
(lambda (pair)
(when (eq? (cdr pair) 'directory)
(set-cdr! pair (read-dir (if (string=? dirname "") (car pair) (string-append dirname "/" (car pair)))))))
contents)
(zdir contents))
(read-dir ""))
;; Reads a dirhash from a `go.sum` line. This prefetches the module from
;; the go module proxy, and then generates the dirhash without unpacking
@ -125,7 +51,7 @@
(when (go-sum-path sum-line) (error "go.sum line is invalid for fetch-dirhash-for-sum" sum-line))
(define url (string-append "https://proxy.golang.org/" (rewrite-go-package-name-for-url (go-sum-module sum-line)) "/@v/" (go-sum-version sum-line) ".zip"))
(define known (fetch-with-known-url "module.zip" url))
(store-path-for-fod "module" "x86_64-linux" #~(#$dirhash-generator) #~(("src" . #$known)) "sha256" (go-sum-hash sum-line) #f))
(store-path-for-fod "module" "x86_64-linux" #~(#$(force dirhash-generator)) #~(("src" . #$known)) "sha256" (go-sum-hash sum-line) #f))
;; Generates a full VFS structure from a module as described by a `go.sum`
;; line.
@ -163,7 +89,7 @@
(set! dirname (string-copy file-path 0 last-slash))
(set! filename (string-copy file-path (+ last-slash 1))))
(define file (store-path-for-fod "file" "x86_64-linux" #~(#$unpack-zip #$zip ,(car pair)) '() "sha256" hash #f))
(define file (store-path-for-fod "file" "x86_64-linux" #~(#$(force unpack-zip) #$zip ,(car pair)) '() "sha256" hash #f))
; Skip files we know for sure won't be used.
; TODO(puck): this should be moved to vfs-filter-for-go-package?
@ -173,24 +99,6 @@
lines)
(make-vfs output))
;; Generates a full VFS structure from an on-disk directory.
(define (vfs-from-directory osdir)
(define out (mapping (make-default-comparator)))
(define (iter-dir dirpath)
(define reldir (string-append osdir "/" dirpath))
(define contents (directory reldir))
(for-each
(lambda (name)
(unless (string=? (string-copy name 0 1) ".")
(if (directory-exists? (string-append reldir "/" name))
(begin
(iter-dir (if (string=? dirpath "") name (string-append dirpath "/" name)))
(set! out (mapping-set! out (cons dirpath name) 'directory)))
(set! out (mapping-set! out (cons dirpath name) (zfile #~,(call-with-input-file (string-append reldir "/" name) read-full-file)))))))
contents))
(iter-dir "")
(make-vfs out))
;; List extracted from go src/go/build/build.go.
(define good-extensions '("go" "c" "cc" "cpp" "cxx" "m" "h" "hh" "hpp" "hxx" "f" "F" "for" "f90" "s" "S" "sx" "swig" "swigcxx" "syso"))
(define (extract-extension name i)