(zilch lang go vfs): move to (zilch vfs)
It really wasn't that go-specific anymore.
This commit is contained in:
parent
c68f3852e0
commit
a008d0c0c2
8 changed files with 28 additions and 113 deletions
|
|
@ -5,6 +5,7 @@
|
|||
(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)
|
||||
(scheme char)
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
(scheme base)
|
||||
(zilch file) (zilch magic)
|
||||
(zilch nixpkgs) (zilch zexpr)
|
||||
(zilch vfs)
|
||||
json
|
||||
(chicken foreign)
|
||||
(zilch lang go core) (zilch lang go) (zilch lang go vfs) (zilch lang go stdlib))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue