Implement directory copying

guix-cantrips/summon.scm

@@ -11,22 +11,41 @@
 (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)$" 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$"))
+		(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))
-		 ((zip? package-source-dir) (format #t "Zip!: ~a" package-source-dir))
-		 ((directory-exists? package-source-dir) (format #t "I think this is a directory: ~a" package-source-dir))
-		 (else (format #t "I dunno what this is: ~a" package-source-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)))))