TakeV
/
guix-cantrips
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Implement directory copying

This commit is contained in:
TakeV 2023-07-08 21:36:23 -07:00
parent 10ff6eaeef
commit eae81890ad
Signed by: TakeV
GPG Key ID: A64F41345C7400AF
1 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
guix-cantrips/summon.scm
View File

@ -23,20 +23,29 @@ Downloads the source code of a package and extracts it to a directory"
(run "tar" (format #f "--directory=~a" destination) "-xf" tarball))
(define (zip? filename)
(string-match ".*[.]zip$"))
(string-match ".*[.]zip$" filename))
(define (unzip! zip destination)
(run "unzip" zip "-d" destination))
(define (directory? directory)
(eq? (stat:type (stat directory)) 'directory))
(define (copy-directory! directory destination)
(run "cp" "-r" "--no-clobber" "--preserve=timestamps,links" directory destination))
; TODO: Fix permissions when copying directory
(let* ((package-build-out (run-with-pipe "r" "guix" "build" "--source" package-name))
(package-source-dir (read-line (cdr package-build-out))))
(cond
((tarball? package-source-dir)
(untar! package-source-dir proj-dir)
(format #t "Package ~a extracted to ~a~&" package-source-dir proj-dir))
(format #t "Package ~a extracted to ~a~&" package-name proj-dir))
((zip? package-source-dir)
(unzip! package-source-dir proj-dir)
(format #t "Package ~a extracted to ~a~&" package-source-dir proj-dir))
((directory-exists? package-source-dir)
(format #t "Directories are currently unsupported: Tried to read ~a" package-source-dir))
(format #t "Package ~a extracted to ~a~&" package-name proj-dir))
((directory? package-source-dir)
(copy-directory! package-source-dir (format #f "~a/~a" proj-dir package-name))
(format #t "Package ~a extracted to ~a~&" package-name proj-dir))
(else (format #t "Unknown format: ~a" package-source-dir)))))