Fix permissions for downloaded source code.

Also switch to using guix build utils for checking and copying the directory of
t he source code.

Run summon through guix style

guix-cantrips/summon.scm

@@ -1,51 +1,78 @@
 (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))
-
+  #:use-module (config)
+  #:use-module (guix build utils)
+  #: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
+  "Options -> Void
 Downloads the source code of a package and extracts it to a directory"
 
-	(define proj-dir (option-ref opts 'project-dir))
+  (define proj-dir
+    (option-ref opts
+                'project-dir))
 
-	(define package-name (option-ref opts '(package)))
+  (define package-name
+    (option-ref opts
+                '(package)))
 
-	(define (tarball? filename)
-		(string-match ".*[.]tar[.](gz|xz|bz2|lz|lzma|lzo|Z|zst)$" filename))
+  (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 (untar! tarball destination)
+    (run "tar"
+         (format #f "--directory=~a" destination) "-xf" tarball))
 
-	(define (zip? filename)
-		(string-match ".*[.]zip$" filename))
+  (define (zip? filename)
+    (string-match ".*[.]zip$" filename))
 
-	(define (unzip! zip destination)
-		(run "unzip" zip "-d" destination))
+  (define (unzip! zip destination)
+    (run "unzip" zip "-d" destination))
 
-	(define (directory? directory)
-		(eq? (stat:type (stat directory)) 'directory))
+  (define (recursively-make-writable! top-level-dir)
+    "String -> List of Strings
+Makes all files in dir writable for the user.
+Returns a list of every filename which has been made writable. "
+    (define (make-writable name stat result)
+      (begin
+        (make-file-writable name)
+        (cons name result)))
+    (define (ignore name stat result)
+      result)
+    (define (warn name stat errno result)
+      (format (current-error-port) "warning:~a: ~a~%" name
+              (strerror errno)) result)
 
-	(define (copy-directory! directory destination)
-		(run "cp" "-r" "--no-clobber" "--preserve=timestamps,links" directory destination))
-	; TODO: Fix permissions when copying directory
+    (file-system-fold ignore ; Just go into every dir
+                      make-writable ; Make files writable
+                      ignore
+                      ignore
+                      ignore ; Ignore dirs
+                      warn ; Show errors
+                      '() ; AND THIS LIST SHALL BE FULL OF FILENAMES <- Magician voice
+                      top-level-dir))
 
-	(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)))))
+  ; Anyway, here is wonderwall
+  (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-exists? package-source-dir)
+      (copy-recursively package-source-dir
+                        (string-append proj-dir "/" package-name)
+                        #:keep-permissions? #f)
+      (format #t "Fixing permissions:~&")
+      (recursively-make-writable! (string-append proj-dir "/" package-name))
+      (format #t "Package ~a extracted to ~a~&" package-name proj-dir))
+     (else (format #t "Unknown format: ~a" package-source-dir)))))