package: make a package for each public git branch

1 files changed, 54 insertions, 5 deletions

diff --git a/guix/vkraus/packages/disfluid.scm b/guix/vkraus/packages/disfluid.scm
index 38f24ed..d9558ac 100644
--- a/guix/vkraus/packages/disfluid.scm
+++ b/guix/vkraus/packages/disfluid.scm
@@ -35,7 +35,10 @@
   #:use-module (gnu packages man)
   #:use-module (gnu packages tls)
   #:use-module (gnu packages gtk)
-  #:use-module (gnu packages gnome))
+  #:use-module (gnu packages gnome)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 optargs)
+  #:use-module (sxml simple))
 
 (define-public disfluid-snapshot
   (package
@@ -142,7 +145,8 @@
            (variable "LTDL_LIBRARY_PATH")
            (files '("lib")))))))
 
-(define-public (disfluid-release version release-date commit hash)
+(define*-public (disfluid-release
+                 #:key version release-date commit-id hash)
   (package
    (inherit disfluid-snapshot)
    (name "disfluid")
@@ -152,7 +156,7 @@
      (method git-fetch)
      (uri (git-reference
            (url "https://labo.planete-kraus.eu/webid-oidc.git")
-           (commit commit)))
+           (commit commit-id)))
      (sha256 (base32 hash))
      (snippet
       `(begin
@@ -162,6 +166,16 @@
            (lambda _ (format #t "~a~%" ,release-date)))
          #t))))))
 
+(define*-public (disfluid-branch-snapshot
+                 #:key branch-name version release-date commit-id hash)
+  (package
+    (inherit (disfluid-release
+              #:version version
+              #:release-date release-date
+              #:commit-id commit-id
+              #:hash hash))
+    (name (string-append "disfluid-snapshot-" branch-name))))
+
 (define-public (disfluid-htmlize disfluid)
   (package
    (inherit disfluid)
@@ -230,5 +244,40 @@
 file, which is exported to HTML and PDF. Also include the complete
 corresponding source, as an AGPL requirement.")))
 
-(define-public (make-website disfluid)
-  (file-append (disfluid-htmlize disfluid) "/share/doc/disfluid/disfluid.html"))
+(define-public (make-website master-disfluid branch-disfluids)
+  (directory-union
+   "website"
+   `(,(file-append (disfluid-htmlize disfluid) "/share/doc/disfluid/disfluid.html")
+     ,(file-union
+       "branch-subdirectory"
+       `(("refs"
+          ,(file-union
+            "branch-websites"
+            `(("index.html"
+               ,(plain-file
+                 "branch-index"
+                 (call-with-output-string
+                   (lambda (port)
+                     (sxml->xml
+                      `(*TOP*
+                        (html (@ (href "http://www.w3.org/1999/xhtml")
+                                 (xml:lang "en"))
+                              (head (title "Other versions"))
+                              (body
+                               (h1 "Other versions of the manual")
+                               ,@(let ((lis
+                                        (map
+                                         (match-lambda
+                                           ((branch . _)
+                                            `(li (a (@ (href ,branch)) ,branch))))
+                                         branch-disfluids)))
+                                   (if (null? lis)
+                                       `((p "The manual is not available for any branch."))
+                                       `((p "The manual is available for these development branches:")
+                                         (ul ,@lis)))))))
+                      port)))))
+              ,@(map
+                 (match-lambda
+                   ((branch . package)
+                    `(,branch ,(file-append (disfluid-htmlize package) "/share/doc/disfluid/disfluid.html"))))
+                 branch-disfluids)))))))))