52 lines
1.7 KiB
Scheme
52 lines
1.7 KiB
Scheme
(define-module (guix-cantrips summon)
|
|
#:use-module (config)
|
|
#:use-module (ice-9 ftw)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (ice-9 rdelim)
|
|
#:use-module (ice-9 regex)
|
|
#:use-module (os process)
|
|
#:export (summon))
|
|
|
|
|
|
(define (summon opts)
|
|
"Options -> Void
|
|
Downloads the source code of a package and extracts it to a directory"
|
|
|
|
(define proj-dir (option-ref opts 'project-dir))
|
|
|
|
(define package-name (option-ref opts '(package)))
|
|
|
|
(define (tarball? filename)
|
|
(string-match ".*[.]tar[.](gz|xz|bz2|lz|lzma|lzo|Z|zst)$" filename))
|
|
|
|
(define (untar! tarball destination)
|
|
(run "tar" (format #f "--directory=~a" destination) "-xf" tarball))
|
|
|
|
(define (zip? filename)
|
|
(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-name proj-dir))
|
|
((zip? package-source-dir)
|
|
(unzip! package-source-dir proj-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)))))
|
|
|