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

(zilch lang go vfs): create multiple parent directories

Browse source
This commit is contained in:
puck 2024-11-16 16:44:32 +00:00
parent fe53998fcc
commit a2bae93771
1 changed files with 7 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -144,6 +144,12 @@
(set! file (string-copy line 66)) (set! file (string-copy line 66))
(set! lines (cons (cons file hash) lines)))))) (set! lines (cons (cons file hash) lines))))))
(define output (mapping (make-default-comparator))) (define output (mapping (make-default-comparator)))
(define (create-parent-dirs dirname)
(define second-to-last-slash (string-index-right dirname (lambda (c) (char=? c #\/))))
(when second-to-last-slash
(set! output (mapping-set! output (cons (string-copy dirname 0 second-to-last-slash) (string-copy dirname (+ second-to-last-slash 1))) 'directory))
(create-parent-dirs (string-copy dirname 0 second-to-last-slash)))
(unless (or second-to-last-slash (string=? dirname "")) (set! output (mapping-set! output (cons "" dirname) 'directory))))
(for-each (for-each
; (path . hash) ; (path . hash)
(lambda (pair) (lambda (pair)
@ -157,18 +163,12 @@
(set! dirname (string-copy file-path 0 last-slash)) (set! dirname (string-copy file-path 0 last-slash))
(set! filename (string-copy file-path (+ last-slash 1)))) (set! filename (string-copy file-path (+ last-slash 1))))
; Record directory name in the parent directory.
(unless last-slash
(let ((second-to-last-slash (string-index-right dirname (lambda (c) (char=? c #\/)))))
(if second-to-last-slash
(set! output (mapping-set! output (cons (string-copy dirname 0 second-to-last-slash) (string-copy dirname (+ second-to-last-slash 1))) 'directory))
(unless (string=? dirname "") (set! output (mapping-set! output (cons "" dirname) 'directory))))))
(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" #~(#$unpack-zip #$zip ,(car pair)) '() "sha256" hash #f))
; Skip files we know for sure won't be used. ; Skip files we know for sure won't be used.
; TODO(puck): this should be moved to vfs-filter-for-go-package? ; TODO(puck): this should be moved to vfs-filter-for-go-package?
(unless (or (string-contains dirname "/_") (string-contains dirname "/.") (string-contains dirname "/testdata/") (char=? #\. (string-ref filename 0)) (char=? #\_ (string-ref filename 0))) (unless (or (string-contains dirname "/_") (string-contains dirname "/.") (string-contains dirname "/testdata/") (char=? #\. (string-ref filename 0)) (char=? #\_ (string-ref filename 0)))
(create-parent-dirs dirname)
(set! output (mapping-set! output (cons dirname filename) file)))) (set! output (mapping-set! output (cons dirname filename) file))))
lines) lines)
(make-vfs output)) (make-vfs output))