From 2c3ff4a34e33112684d88c274fff154dd10e478b Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Thu, 7 Oct 2021 14:05:57 +0200 Subject: package: make a package for each public git branch --- update-channel.scm | 206 +++++++++++++++++++++++++++++++++++------------------ 1 file changed, 137 insertions(+), 69 deletions(-) (limited to 'update-channel.scm') diff --git a/update-channel.scm b/update-channel.scm index 55eaa8a..26c0221 100644 --- a/update-channel.scm +++ b/update-channel.scm @@ -27,75 +27,143 @@ (use-modules (guix store)) (use-modules (ice-9 textual-ports)) (use-modules (ice-9 rdelim)) +(use-modules (ice-9 optargs)) +(use-modules (ice-9 match)) +(use-modules (srfi srfi-26)) +(use-modules (oop goops)) + +(define-class () + (branch-name #:init-keyword #:branch-name #:getter branch-name) + (hash #:getter hash) + (version #:getter version) + (release-date #:getter release-date) + (commit-id #:getter commit-id) + (interned-modules #:getter interned-modules)) (unsetenv "GIT_DIR") -(let ((tmp-dirname (tmpnam)) - (git - (run-with-store - (open-connection) - (package-file git "bin/git"))) - (bash - (run-with-store - (open-connection) - (package-file bash "bin/bash"))) - (tar - (run-with-store - (open-connection) - (package-file tar "bin/tar")))) - (format (current-error-port) "Found the required programs: -- git: ~a -- bash: ~a -- tar: ~a -" - git bash tar) - (format (current-error-port) "Using temporary directory ~a\n" tmp-dirname) - (mkdir tmp-dirname) - (mkdir (string-append tmp-dirname "/source")) - (invoke git "archive" "master" "-o" (string-append tmp-dirname "/source/source.tar.gz")) - (with-directory-excursion - (string-append tmp-dirname "/source") - (invoke tar "xf" (string-append tmp-dirname "/source/source.tar.gz")) - (delete-file (string-append tmp-dirname "/source/source.tar.gz"))) - (with-directory-excursion - tmp-dirname - (invoke bash "-c" (format #f "guix hash -r source > hash"))) - (invoke bash "-c" (format #f "~a describe --tags --always > ~a/version" git tmp-dirname)) - (invoke bash "-c" (format #f "~a show -s --format=%cI > ~a/release-date" git tmp-dirname)) - (invoke bash "-c" (format #f "~a rev-parse master > ~a/commit" git tmp-dirname)) - (let ((hash (call-with-input-file (string-append tmp-dirname "/hash") read-line)) - (version (call-with-input-file (string-append tmp-dirname "/version") read-line)) - (release-date (call-with-input-file (string-append tmp-dirname "/release-date") read-line)) - (commit (call-with-input-file (string-append tmp-dirname "/commit") read-line)) - (interned-modules - (run-with-store - (open-connection) - (interned-file (string-append tmp-dirname "/source/guix") "ci-checkout" #:recursive? #t))) - (base-repository (getcwd))) - (delete-file-recursively tmp-dirname) - (invoke git "clone" (format #f "~a/../webid-oidc-channel" base-repository) tmp-dirname) - (with-directory-excursion - tmp-dirname - (invoke git "rm" "-f" "-r" "--ignore-unmatch" ".") - (copy-recursively interned-modules "." #:follow-symlinks? #t) - (chmod "vkraus/packages/disfluid.scm" #o644) - (let ((port (open-file "vkraus/packages/disfluid.scm" "a"))) - (write `(define-public disfluid - (disfluid-release ,version ,release-date ,commit ,hash)) - port) - (display "\n" port) - (write `(define-public disfluid-html - (disfluid-htmlize disfluid)) - port) - (display "\n" port) - (write `(define-public disfluid:website - (make-website disfluid)) - port) - (display "\n" port) - (close-port port)) - (invoke git "add" "-A") - (invoke bash "-c" (format #f "~a diff-index --quiet HEAD || ~a commit -m 'Update package'" - git git)) - (invoke git "push" "origin" "master")))) - -#~(system* #$(file-append hello "/bin/hello")) +(define git + (run-with-store (open-connection) (package-file git "/bin/git"))) + +(define bash + (run-with-store (open-connection) (package-file bash "/bin/bash"))) + +(define tar + (run-with-store (open-connection) (package-file tar "/bin/tar"))) + +(define-method (initialize (branch ) initargs) + (let-keywords + initargs #t + ((branch-name "master")) + (let ((tmp-dirname (tmpnam))) + (mkdir tmp-dirname) + (mkdir (string-append tmp-dirname "/source")) + (invoke git "archive" branch-name "-o" (string-append tmp-dirname "/source/source.tar.gz")) + (with-directory-excursion + (string-append tmp-dirname "/source") + (invoke tar "xf" (string-append tmp-dirname "/source/source.tar.gz")) + (delete-file (string-append tmp-dirname "/source/source.tar.gz"))) + (with-directory-excursion + tmp-dirname + (invoke bash "-c" (format #f "guix hash -r source > hash"))) + (invoke bash "-c" (format #f "~a describe --tags --always ~a > ~a/version" git branch-name tmp-dirname)) + (invoke bash "-c" (format #f "~a show -s --format=%cI ~a > ~a/release-date" git branch-name tmp-dirname)) + (invoke bash "-c" (format #f "~a rev-parse ~a > ~a/commit-id" git branch-name tmp-dirname)) + (slot-set! branch 'branch-name branch-name) + (slot-set! branch 'hash + (call-with-input-file (string-append tmp-dirname "/hash") + read-line)) + (slot-set! branch 'version + (call-with-input-file (string-append tmp-dirname "/version") + read-line)) + (slot-set! branch 'release-date + (call-with-input-file (string-append tmp-dirname "/release-date") + read-line)) + (slot-set! branch 'commit-id + (call-with-input-file (string-append tmp-dirname "/commit-id") + read-line)) + (slot-set! branch 'interned-modules + (run-with-store + (open-connection) + (interned-file (string-append tmp-dirname "/source/guix") + "ci-checkout" + #:recursive? #t))) + (delete-file-recursively tmp-dirname)))) + +(define all-branches + (let ((tmp (tmpnam))) + (invoke bash "-c" (format #f "~a branch -l --format='%(refname:short)' > ~a" git tmp)) + (map + (cute make #:branch-name <>) + (filter + (lambda (s) (not (equal? s ""))) + (string-split (call-with-input-file tmp get-string-all) #\newline))))) + +(define master + (let find-master ((branches all-branches)) + (match branches + (() + (error "No master branch in repo")) + (((and info + (= branch-name (? (cute equal? <> "master")))) + _ ...) + info) + ((_ branches ...) + (find-master branches))))) + +(define-method (package-variable-name (branch )) + (string->symbol (string-append "disfluid-snapshot-" (branch-name branch)))) + +(define-method (code (branch )) + (let ((header + (if (equal? (branch-name branch) "master") + `((define-public disfluid + (disfluid-release + #:version ,(version branch) + #:release-date ,(release-date branch) + #:commit-id ,(commit-id branch) + #:hash ,(hash branch)))) + '()))) + (append + header + `((define-public ,(package-variable-name branch) + (disfluid-branch-snapshot + #:branch-name ,(branch-name branch) + #:version ,(version branch) + #:release-date ,(release-date branch) + #:commit-id ,(commit-id branch) + #:hash ,(hash branch))))))) + +(define all-code + (append + (apply append (map code all-branches)) + `((define-public disfluid:website + (make-website disfluid + (list ,@(map + (lambda (branch) + `(cons ,(branch-name branch) ,(package-variable-name branch))) + all-branches))))))) + +(define clone-dir (tmpnam)) + +(invoke git "clone" "../webid-oidc-channel" clone-dir) + +(with-directory-excursion clone-dir + (invoke git "rm" "-f" "-r" "--ignore-unmatch" ".") + (copy-recursively (interned-modules master) "." #:follow-symlinks? #t) + (chmod "vkraus/packages/disfluid.scm" #o644) + (let ((port (open-file "vkraus/packages/disfluid.scm" "a"))) + (for-each (lambda (code) + (write code port) + (display "\n" port)) + all-code) + (close-port port)) + (invoke git "add" "-A") + (invoke bash "-c" (format #f "~a diff-index --quiet HEAD || ~a commit -m 'Update package'" + git git)) + (invoke git "push" "origin" "master")) + +#~(plain-file + "done" + "Channel updated. +") -- cgit v1.2.3