1 files changed, 113 insertions, 0 deletions
diff --git a/disfluid/build/post-commit-hook.scm b/disfluid/build/post-commit-hook.scm
new file mode 100644
index 0000000..4766b9a
--- /dev/null
+++ b/disfluid/build/post-commit-hook.scm
@@ -0,0 +1,113 @@
+(define-module (disfluid build post-commit-hook)
+  #:use-module (disfluid i18n)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 optargs)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:declarative? #t
+  #:export (main))
+
+(define-syntax system**
+  (syntax-rules ()
+    ((system** msg args ...)
+     (unless (zero? (status:exit-val (system* args ...)))
+       (raise
+        (condition
+         (&error)
+         (&message (message msg))))))))
+
+(define source
+  (dirname
+   (dirname (dirname (current-filename)))))
+
+(define* (main #:key
+               (rm "rm")
+               (guix "guix")
+               (git "git"))
+  (guard (exn
+          ((and (error? exn)
+                (message-condition? exn))
+           (format (current-error-port)
+                   (G_ "Cannot update the package: ~a\n")
+                   (condition-message exn))
+           (exit 1)))
+    (system** (G_ "cannot cleanup .last-commit/")
+              rm "-rf" ".last-commit")
+    (system** (G_ "cannot clone the repository to .last-commit/")
+              git "clone" source ".last-commit")
+    (chdir ".last-commit")
+    (system** (G_ "cannot checkout main in .last-commit/")
+              git "checkout" "main")
+    (chdir "..")
+    (let* ((commit-id
+            (receive (from to pids)
+                (pipeline
+                 `((,git "rev-parse" "HEAD")))
+              (match `(,pids ,(read-line from))
+                ((((= waitpid
+                      (_ . (= status:exit-val 0))))
+                  (? string? commit-id))
+                 commit-id)
+                (else
+                 (raise (condition (&error)
+                                   (&message
+                                    (message (G_ "git rev-parse failed")))))))))
+           (hash
+            (receive (from to pids)
+                (pipeline
+                 `((,guix "hash" "-x" "-S" "nar" ".last-commit")))
+              (match `(,pids ,(read-line from))
+                ((((= waitpid
+                      (_ . (= status:exit-val 0))))
+                  (? string? hash))
+                 hash)
+                (else
+                 (raise (condition (&error)
+                                   (&message
+                                    (message (G_ "guix hash failed")))))))))
+           (version
+            (begin
+              (chdir ".last-commit")
+              (receive (from to pids)
+                  (pipeline
+                   `((,git "describe" "--tags" "--dirty" "--broken")))
+                (match `(,pids ,(read-line from))
+                  ((((= waitpid
+                        (_ . (= status:exit-val 0))))
+                    (? string? version))
+                   version)
+                  (else
+                   "UNKNOWN"))))))
+      (system** (G_ "cannot checkout the guix branch")
+                git "checkout" "guix")
+      (guard (exn
+              (#t
+               (raise
+                (condition (&error)
+                           (&message
+                            (message (G_ "cannot create a new release")))))))
+        (call-with-output-file "vkraus/packages/disfluid/release.scm-"
+          (lambda (port)
+            (write `(define-module (vkraus packages disfluid release)
+                      #:declarative? #t
+                      #:export (version commit hash))
+                   port)
+            (newline port)
+            (write `(define version ,version) port)
+            (newline port)
+            (write `(define commit ,commit-id) port)
+            (newline port)
+            (write `(define hash ,hash) port)))
+        (rename-file "vkraus/packages/disfluid/release.scm-"
+                     "vkraus/packages/disfluid/release.scm"))
+      (system** (G_ "cannot commit the new release")
+                git "commit" "-a" "-m" (format #f (G_ "Update disfluid to ~a.") version))
+      (system** (G_ "cannot push the new release")
+                git "push")
+      (chdir "..")
+      (system** (G_ "cannot clean up the last commit files")
+                rm "-rf" ".last-commit"))))