mirror of
https://codeberg.org/hako/Rosenthal.git
synced 2025-06-19 08:55:24 +00:00
maint: Add more manifests.
* etc/committer.scm: New file. * etc/manifests/all-packages.scm: New file. * etc/manifests/auto-update.scm: New file. * etc/manifests/manual-update.scm: New file. * etc/manifest.scm: Delete file.
This commit is contained in:
parent
b9ca1cd567
commit
cba8ab4bfc
477
etc/committer.scm
Executable file
477
etc/committer.scm
Executable file
@ -0,0 +1,477 @@
|
|||||||
|
#!/usr/bin/env -S guix repl
|
||||||
|
!#
|
||||||
|
|
||||||
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
|
;;; Copyright © 2020, 2021, 2022, 2023 Ricardo Wurmus <rekado@elephly.net>
|
||||||
|
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
|
||||||
|
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||||
|
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Guix.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; This script stages and commits changes to package definitions.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(use-modules ((sxml xpath) #:prefix xpath:)
|
||||||
|
(srfi srfi-1)
|
||||||
|
(srfi srfi-2)
|
||||||
|
(srfi srfi-9)
|
||||||
|
(srfi srfi-11)
|
||||||
|
(srfi srfi-26)
|
||||||
|
(ice-9 format)
|
||||||
|
(ice-9 popen)
|
||||||
|
(ice-9 match)
|
||||||
|
(ice-9 rdelim)
|
||||||
|
(ice-9 regex)
|
||||||
|
(ice-9 textual-ports)
|
||||||
|
(guix gexp))
|
||||||
|
|
||||||
|
(define* (break-string str #:optional (max-line-length 70))
|
||||||
|
"Break the string STR into lines that are no longer than MAX-LINE-LENGTH.
|
||||||
|
Return a single string."
|
||||||
|
(define (restore-line words)
|
||||||
|
(string-join (reverse words) " "))
|
||||||
|
(if (<= (string-length str) max-line-length)
|
||||||
|
str
|
||||||
|
(let ((words+lengths (map (lambda (word)
|
||||||
|
(cons word (string-length word)))
|
||||||
|
(string-tokenize str))))
|
||||||
|
(match (fold (match-lambda*
|
||||||
|
(((word . length)
|
||||||
|
(count current lines))
|
||||||
|
(let ((new-count (+ count length 1)))
|
||||||
|
(if (< new-count max-line-length)
|
||||||
|
(list new-count
|
||||||
|
(cons word current)
|
||||||
|
lines)
|
||||||
|
(list length
|
||||||
|
(list word)
|
||||||
|
(cons (restore-line current) lines))))))
|
||||||
|
'(0 () ())
|
||||||
|
words+lengths)
|
||||||
|
((_ last-words lines)
|
||||||
|
(string-join (reverse (cons (restore-line last-words) lines))
|
||||||
|
"\n"))))))
|
||||||
|
|
||||||
|
(define* (break-string-with-newlines str #:optional (max-line-length 70))
|
||||||
|
"Break the lines of string STR into lines that are no longer than
|
||||||
|
MAX-LINE-LENGTH. Return a single string."
|
||||||
|
(string-join (map (cut break-string <> max-line-length)
|
||||||
|
(string-split str #\newline))
|
||||||
|
"\n"))
|
||||||
|
|
||||||
|
(define (read-excursion port)
|
||||||
|
"Read an expression from PORT and reset the port position before returning
|
||||||
|
the expression."
|
||||||
|
(let ((start (ftell port))
|
||||||
|
(result (read port)))
|
||||||
|
(seek port start SEEK_SET)
|
||||||
|
result))
|
||||||
|
|
||||||
|
(define (lines+offsets-with-opening-parens port)
|
||||||
|
"Record all line numbers (and their offsets) where an opening parenthesis is
|
||||||
|
found in column 0. The resulting list is in reverse order."
|
||||||
|
(let loop ((acc '())
|
||||||
|
(number 0))
|
||||||
|
(let ((line (read-line port)))
|
||||||
|
(cond
|
||||||
|
((eof-object? line) acc)
|
||||||
|
((string-prefix? "(" line)
|
||||||
|
(loop (cons (cons number ;line number
|
||||||
|
(- (ftell port)
|
||||||
|
(string-length line) 1)) ;offset
|
||||||
|
acc)
|
||||||
|
(1+ number)))
|
||||||
|
(else (loop acc (1+ number)))))))
|
||||||
|
|
||||||
|
(define (surrounding-sexp port target-line-no)
|
||||||
|
"Return the top-level S-expression surrounding the change at line number
|
||||||
|
TARGET-LINE-NO in PORT."
|
||||||
|
(let* ((line-numbers+offsets
|
||||||
|
(lines+offsets-with-opening-parens port))
|
||||||
|
(closest-offset
|
||||||
|
(or (and=> (list-index (match-lambda
|
||||||
|
((line-number . offset)
|
||||||
|
(< line-number target-line-no)))
|
||||||
|
line-numbers+offsets)
|
||||||
|
(lambda (index)
|
||||||
|
(match (list-ref line-numbers+offsets index)
|
||||||
|
((line-number . offset) offset))))
|
||||||
|
(error "Could not find surrounding S-expression for line"
|
||||||
|
target-line-no))))
|
||||||
|
(seek port closest-offset SEEK_SET)
|
||||||
|
(read port)))
|
||||||
|
|
||||||
|
;;; Whether the hunk contains a newly added package (definition), a removed
|
||||||
|
;;; package (removal) or something else (#false).
|
||||||
|
(define hunk-types '(addition removal #false))
|
||||||
|
|
||||||
|
(define-record-type <hunk>
|
||||||
|
(make-hunk file-name
|
||||||
|
old-line-number
|
||||||
|
new-line-number
|
||||||
|
diff-lines
|
||||||
|
type)
|
||||||
|
hunk?
|
||||||
|
(file-name hunk-file-name)
|
||||||
|
;; Line number before the change
|
||||||
|
(old-line-number hunk-old-line-number)
|
||||||
|
;; Line number after the change
|
||||||
|
(new-line-number hunk-new-line-number)
|
||||||
|
;; The full diff to be used with "git apply --cached"
|
||||||
|
(diff-lines hunk-diff-lines)
|
||||||
|
;; Does this hunk add or remove a package?
|
||||||
|
(type hunk-type)) ;one of 'hunk-types'
|
||||||
|
|
||||||
|
(define* (hunk->patch hunk #:optional (port (current-output-port)))
|
||||||
|
(let ((file-name (hunk-file-name hunk)))
|
||||||
|
(format port
|
||||||
|
"diff --git a/~a b/~a~%--- a/~a~%+++ b/~a~%~a"
|
||||||
|
file-name file-name file-name file-name
|
||||||
|
(string-join (hunk-diff-lines hunk) ""))))
|
||||||
|
|
||||||
|
(define (diff-info)
|
||||||
|
"Read the diff and return a list of <hunk> values."
|
||||||
|
(let ((port (open-pipe* OPEN_READ
|
||||||
|
"git" "diff-files"
|
||||||
|
"--no-prefix"
|
||||||
|
;; Only include one context line to avoid lumping in
|
||||||
|
;; new definitions with changes to existing
|
||||||
|
;; definitions.
|
||||||
|
"--unified=1"
|
||||||
|
"--" "modules/rosenthal")))
|
||||||
|
(define (extract-line-number line-tag)
|
||||||
|
(abs (string->number
|
||||||
|
(car (string-split line-tag #\,)))))
|
||||||
|
(define (read-hunk)
|
||||||
|
(let loop ((lines '())
|
||||||
|
(type #false))
|
||||||
|
(let ((line (read-line port 'concat)))
|
||||||
|
(cond
|
||||||
|
((eof-object? line)
|
||||||
|
(values (reverse lines) type))
|
||||||
|
((or (string-prefix? "@@ " line)
|
||||||
|
(string-prefix? "diff --git" line))
|
||||||
|
(unget-string port line)
|
||||||
|
(values (reverse lines) type))
|
||||||
|
(else
|
||||||
|
(loop (cons line lines)
|
||||||
|
(or type
|
||||||
|
(cond
|
||||||
|
((string-prefix? "+(define" line)
|
||||||
|
'addition)
|
||||||
|
((string-prefix? "-(define" line)
|
||||||
|
'removal)
|
||||||
|
(else #false)))))))))
|
||||||
|
(define info
|
||||||
|
(let loop ((acc '())
|
||||||
|
(file-name #f))
|
||||||
|
(let ((line (read-line port)))
|
||||||
|
(cond
|
||||||
|
((eof-object? line) acc)
|
||||||
|
((string-prefix? "--- " line)
|
||||||
|
(match (string-split line #\space)
|
||||||
|
((_ file-name)
|
||||||
|
(loop acc file-name))))
|
||||||
|
((string-prefix? "@@ " line)
|
||||||
|
(match (string-split line #\space)
|
||||||
|
((_ old-start new-start . _)
|
||||||
|
(let-values
|
||||||
|
(((diff-lines type) (read-hunk)))
|
||||||
|
(loop (cons (make-hunk file-name
|
||||||
|
(extract-line-number old-start)
|
||||||
|
(extract-line-number new-start)
|
||||||
|
(cons (string-append line "\n")
|
||||||
|
diff-lines)
|
||||||
|
type) acc)
|
||||||
|
file-name)))))
|
||||||
|
(else (loop acc file-name))))))
|
||||||
|
(close-pipe port)
|
||||||
|
info))
|
||||||
|
|
||||||
|
(define (lines-to-first-change hunk)
|
||||||
|
"Return the number of diff lines until the first change."
|
||||||
|
(1- (count (lambda (line)
|
||||||
|
((negate char-set-contains?)
|
||||||
|
(char-set #\+ #\-)
|
||||||
|
(string-ref line 0)))
|
||||||
|
(hunk-diff-lines hunk))))
|
||||||
|
|
||||||
|
(define %original-file-cache
|
||||||
|
(make-hash-table))
|
||||||
|
|
||||||
|
(define (read-original-file file-name)
|
||||||
|
"Return the contents of FILE-NAME prior to any changes."
|
||||||
|
(let* ((port (open-pipe* OPEN_READ
|
||||||
|
"git" "cat-file" "-p" (string-append
|
||||||
|
"HEAD:" file-name)))
|
||||||
|
(contents (get-string-all port)))
|
||||||
|
(close-pipe port)
|
||||||
|
contents))
|
||||||
|
|
||||||
|
(define (read-original-file* file-name)
|
||||||
|
"Caching variant of READ-ORIGINAL-FILE."
|
||||||
|
(or (hashv-ref %original-file-cache file-name)
|
||||||
|
(let ((value (read-original-file file-name)))
|
||||||
|
(hashv-set! %original-file-cache file-name value)
|
||||||
|
value)))
|
||||||
|
|
||||||
|
(define (old-sexp hunk)
|
||||||
|
"Using the diff information in HUNK return the unmodified S-expression
|
||||||
|
corresponding to the top-level definition containing the staged changes."
|
||||||
|
;; TODO: We can't seek with a pipe port...
|
||||||
|
(call-with-input-string (read-original-file* (hunk-file-name hunk))
|
||||||
|
(lambda (port)
|
||||||
|
(surrounding-sexp port
|
||||||
|
(+ (lines-to-first-change hunk)
|
||||||
|
(hunk-old-line-number hunk))))))
|
||||||
|
|
||||||
|
(define (new-sexp hunk)
|
||||||
|
"Using the diff information in HUNK return the modified S-expression
|
||||||
|
corresponding to the top-level definition containing the staged changes."
|
||||||
|
(call-with-input-file (hunk-file-name hunk)
|
||||||
|
(lambda (port)
|
||||||
|
(surrounding-sexp port
|
||||||
|
(+ (lines-to-first-change hunk)
|
||||||
|
(hunk-new-line-number hunk))))))
|
||||||
|
|
||||||
|
(define* (change-commit-message file-name old new #:optional (port (current-output-port)))
|
||||||
|
"Print ChangeLog commit message for changes between OLD and NEW."
|
||||||
|
(define (get-values expr field)
|
||||||
|
(match ((xpath:node-or
|
||||||
|
(xpath:sxpath `(*any* *any* package ,field quasiquote *))
|
||||||
|
;; For let binding
|
||||||
|
(xpath:sxpath `(*any* *any* (*any*) package ,field quasiquote *)))
|
||||||
|
(cons '*TOP* expr))
|
||||||
|
(()
|
||||||
|
;; New-style plain lists
|
||||||
|
(match ((xpath:node-or
|
||||||
|
(xpath:sxpath `(*any* *any* package ,field list *))
|
||||||
|
;; For let binding
|
||||||
|
(xpath:sxpath `(*any* *any* (*any*) package ,field list *)))
|
||||||
|
(cons '*TOP* expr))
|
||||||
|
((inner) inner)
|
||||||
|
(_ '())))
|
||||||
|
;; Old-style labelled inputs
|
||||||
|
((first . rest)
|
||||||
|
(map cadadr first))))
|
||||||
|
(define (listify items)
|
||||||
|
(match items
|
||||||
|
((one) one)
|
||||||
|
((one two)
|
||||||
|
(string-append one " and " two))
|
||||||
|
((one two . more)
|
||||||
|
(string-append (string-join (drop-right items 1) ", ")
|
||||||
|
", and " (first (take-right items 1))))))
|
||||||
|
(define variable-name
|
||||||
|
(second old))
|
||||||
|
(define version
|
||||||
|
(and=> ((xpath:node-or
|
||||||
|
(xpath:sxpath '(*any* *any* package version *any*))
|
||||||
|
;; For let binding
|
||||||
|
(xpath:sxpath '(*any* *any* (*any*) package version *any*)))
|
||||||
|
(cons '*TOP* new))
|
||||||
|
first))
|
||||||
|
(format port
|
||||||
|
"rosenthal: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%"
|
||||||
|
variable-name version file-name variable-name version)
|
||||||
|
(for-each (lambda (field)
|
||||||
|
(let ((old-values (get-values old field))
|
||||||
|
(new-values (get-values new field)))
|
||||||
|
(or (equal? old-values new-values)
|
||||||
|
(let ((removed (lset-difference equal? old-values new-values))
|
||||||
|
(added (lset-difference equal? new-values old-values)))
|
||||||
|
(format port
|
||||||
|
"[~a]: ~a~%" field
|
||||||
|
(break-string
|
||||||
|
;; A dependency can be a list of (pkg output).
|
||||||
|
(match (list (map object->string removed)
|
||||||
|
(map object->string added))
|
||||||
|
((() added)
|
||||||
|
(format #f "Add ~a."
|
||||||
|
(listify added)))
|
||||||
|
((removed ())
|
||||||
|
(format #f "Remove ~a."
|
||||||
|
(listify removed)))
|
||||||
|
((removed added)
|
||||||
|
(format #f "Remove ~a; add ~a."
|
||||||
|
(listify removed)
|
||||||
|
(listify added))))))))))
|
||||||
|
'(inputs propagated-inputs native-inputs)))
|
||||||
|
|
||||||
|
(define* (add-commit-message file-name variable-name
|
||||||
|
#:optional (port (current-output-port)))
|
||||||
|
"Print ChangeLog commit message for a change to FILE-NAME adding a
|
||||||
|
definition."
|
||||||
|
(format port "rosenthal: Add ~a.~%~%* ~a (~a): New variable.~%"
|
||||||
|
variable-name file-name variable-name))
|
||||||
|
|
||||||
|
(define* (remove-commit-message file-name variable-name
|
||||||
|
#:optional (port (current-output-port)))
|
||||||
|
"Print ChangeLog commit message for a change to FILE-NAME removing a
|
||||||
|
definition."
|
||||||
|
(format port "rosenthal: Remove ~a.~%~%* ~a (~a): Delete variable.~%"
|
||||||
|
variable-name file-name variable-name))
|
||||||
|
|
||||||
|
(define* (custom-commit-message file-name variable-name message changelog
|
||||||
|
#:optional (port (current-output-port)))
|
||||||
|
"Print custom commit message for a change to VARIABLE-NAME in FILE-NAME, using
|
||||||
|
MESSAGE as the commit message and CHANGELOG as the body of the ChangeLog
|
||||||
|
entry. If CHANGELOG is #f, the commit message is reused. If CHANGELOG already
|
||||||
|
contains ': ', no colon is inserted between the location and body of the
|
||||||
|
ChangeLog entry."
|
||||||
|
(define (trim msg)
|
||||||
|
(string-trim-right (string-trim-both msg) (char-set #\.)))
|
||||||
|
|
||||||
|
(define (changelog-has-location? changelog)
|
||||||
|
(->bool (string-match "^[[:graph:]]+:[[:blank:]]" changelog)))
|
||||||
|
|
||||||
|
(let* ((message (trim message))
|
||||||
|
(changelog (if changelog (trim changelog) message))
|
||||||
|
(message/f (format #f "rosenthal: ~a: ~a." variable-name message))
|
||||||
|
(changelog/f (if (changelog-has-location? changelog)
|
||||||
|
(format #f "* ~a (~a)~a."
|
||||||
|
file-name variable-name changelog)
|
||||||
|
(format #f "* ~a (~a): ~a."
|
||||||
|
file-name variable-name changelog))))
|
||||||
|
(format port
|
||||||
|
"~a~%~%~a~%"
|
||||||
|
(break-string-with-newlines message/f 72)
|
||||||
|
(break-string-with-newlines changelog/f 72))))
|
||||||
|
|
||||||
|
(define (add-copyright-line line)
|
||||||
|
"Add the copyright line on LINE to the previous commit."
|
||||||
|
(let ((author (match:substring
|
||||||
|
(string-match "^\\+;;; Copyright ©[^[:alpha:]]+(.*)$" line)
|
||||||
|
1)))
|
||||||
|
(format
|
||||||
|
(current-output-port) "Amend and add copyright line for ~a~%" author)
|
||||||
|
(system* "git" "commit" "--amend" "--no-edit")))
|
||||||
|
|
||||||
|
(define (group-hunks-by-sexp hunks)
|
||||||
|
"Return a list of pairs associating all hunks with the S-expression they are
|
||||||
|
modifying."
|
||||||
|
(fold (lambda (sexp hunk acc)
|
||||||
|
(match acc
|
||||||
|
(((previous-sexp . hunks) . rest)
|
||||||
|
(if (equal? sexp previous-sexp)
|
||||||
|
(cons (cons previous-sexp
|
||||||
|
(cons hunk hunks))
|
||||||
|
rest)
|
||||||
|
(cons (cons sexp (list hunk))
|
||||||
|
acc)))
|
||||||
|
(_
|
||||||
|
(cons (cons sexp (list hunk))
|
||||||
|
acc))))
|
||||||
|
'()
|
||||||
|
(map new-sexp hunks)
|
||||||
|
hunks))
|
||||||
|
|
||||||
|
(define (new+old+hunks hunks)
|
||||||
|
(map (match-lambda
|
||||||
|
((new . hunks)
|
||||||
|
(cons* new (old-sexp (first hunks)) hunks)))
|
||||||
|
(group-hunks-by-sexp hunks)))
|
||||||
|
|
||||||
|
(define %delay 1000)
|
||||||
|
|
||||||
|
(define (main . args)
|
||||||
|
(define* (change-commit-message* file-name old new #:rest rest)
|
||||||
|
(let ((changelog #f))
|
||||||
|
(match args
|
||||||
|
((or (message changelog) (message))
|
||||||
|
(apply custom-commit-message
|
||||||
|
file-name (second old) message changelog rest))
|
||||||
|
(_
|
||||||
|
(apply change-commit-message file-name old new rest)))))
|
||||||
|
|
||||||
|
(read-disable 'positions)
|
||||||
|
(match (diff-info)
|
||||||
|
(()
|
||||||
|
(display "Nothing to be done.\n" (current-error-port)))
|
||||||
|
(hunks
|
||||||
|
(let-values (((definitions changes) (partition hunk-type hunks)))
|
||||||
|
;; Additions/removals.
|
||||||
|
(for-each
|
||||||
|
(lambda (hunk)
|
||||||
|
(and-let* ((define-line (find (cut string-match "(\\+|-)\\(define" <>)
|
||||||
|
(hunk-diff-lines hunk)))
|
||||||
|
(variable-name (and=> (string-tokenize define-line)
|
||||||
|
second))
|
||||||
|
(commit-message-proc (match (hunk-type hunk)
|
||||||
|
('addition add-commit-message)
|
||||||
|
('removal remove-commit-message))))
|
||||||
|
(commit-message-proc (hunk-file-name hunk) variable-name)
|
||||||
|
(let ((port (open-pipe* OPEN_WRITE
|
||||||
|
"git" "apply"
|
||||||
|
"--cached"
|
||||||
|
"--unidiff-zero")))
|
||||||
|
(hunk->patch hunk port)
|
||||||
|
(unless (eqv? 0 (status:exit-val (close-pipe port)))
|
||||||
|
(error "Cannot apply")))
|
||||||
|
|
||||||
|
(let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
|
||||||
|
(commit-message-proc (hunk-file-name hunk) variable-name port)
|
||||||
|
(usleep %delay)
|
||||||
|
(unless (eqv? 0 (status:exit-val (close-pipe port)))
|
||||||
|
(error "Cannot commit"))))
|
||||||
|
(usleep %delay))
|
||||||
|
definitions)
|
||||||
|
|
||||||
|
;; Changes.
|
||||||
|
(for-each
|
||||||
|
(match-lambda
|
||||||
|
((new old . hunks)
|
||||||
|
(for-each (lambda (hunk)
|
||||||
|
(let ((port (open-pipe* OPEN_WRITE
|
||||||
|
"git" "apply"
|
||||||
|
"--cached"
|
||||||
|
"--unidiff-zero")))
|
||||||
|
(hunk->patch hunk port)
|
||||||
|
(unless (eqv? 0 (status:exit-val (close-pipe port)))
|
||||||
|
(error "Cannot apply")))
|
||||||
|
(usleep %delay))
|
||||||
|
hunks)
|
||||||
|
(define copyright-line
|
||||||
|
(any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line)
|
||||||
|
(const line)))
|
||||||
|
(hunk-diff-lines (first hunks))))
|
||||||
|
(cond
|
||||||
|
(copyright-line
|
||||||
|
(add-copyright-line copyright-line))
|
||||||
|
(else
|
||||||
|
(let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
|
||||||
|
(change-commit-message* (hunk-file-name (first hunks))
|
||||||
|
old new)
|
||||||
|
(change-commit-message* (hunk-file-name (first hunks))
|
||||||
|
old new
|
||||||
|
port)
|
||||||
|
(usleep %delay)
|
||||||
|
(unless (eqv? 0 (status:exit-val (close-pipe port)))
|
||||||
|
(error "Cannot commit")))))))
|
||||||
|
(new+old+hunks (match definitions
|
||||||
|
('() changes) ;reuse
|
||||||
|
(_
|
||||||
|
;; XXX: we recompute the hunks here because previous
|
||||||
|
;; insertions lead to offsets.
|
||||||
|
(let-values (((definitions changes)
|
||||||
|
(partition hunk-type (diff-info))))
|
||||||
|
changes)))))))))
|
||||||
|
|
||||||
|
(apply main (cdr (command-line)))
|
@ -1,35 +0,0 @@
|
|||||||
;; SPDX-FileCopyrightText: 2025 Hilton Chain <hako@ultrarare.space>
|
|
||||||
;;
|
|
||||||
;; SPDX-License-Identifier: CC0-1.0
|
|
||||||
|
|
||||||
(specifications->manifest
|
|
||||||
'(
|
|
||||||
"atuin"
|
|
||||||
"cloudflare-warp-bin"
|
|
||||||
"cloudflared"
|
|
||||||
"dinit"
|
|
||||||
"komga-bin"
|
|
||||||
"mihomo-bin"
|
|
||||||
"navidrome-bin"
|
|
||||||
"niri"
|
|
||||||
"shadow-tls-bin"
|
|
||||||
"sing-box-bin"
|
|
||||||
"tree-sitter-yaml"
|
|
||||||
"wakapi-bin"
|
|
||||||
"wakatime-cli-bin"
|
|
||||||
"xwayland-satellite"
|
|
||||||
|
|
||||||
;; TODO: Updater unavailable.
|
|
||||||
;; "bitwarden-icecat"
|
|
||||||
;; "miniflux-injector-icecat"
|
|
||||||
;; "sidebery-icecat"
|
|
||||||
;; "clash-bin"
|
|
||||||
;; "dnsmasq-china-list"
|
|
||||||
;; "emacs-pcmpl-tailscale"
|
|
||||||
;; "emacs-wakatime-mode"
|
|
||||||
;; "forgejo"
|
|
||||||
;; "grub-efi-luks2"
|
|
||||||
;; "hugo"
|
|
||||||
;; "socks2http"
|
|
||||||
;; "tailscale"
|
|
||||||
))
|
|
8
etc/manifests/all-packages.scm
Normal file
8
etc/manifests/all-packages.scm
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
;; SPDX-FileCopyrightText: 2025 Hilton Chain <hako@ultrarare.space>
|
||||||
|
;;
|
||||||
|
;; SPDX-License-Identifier: CC0-1.0
|
||||||
|
|
||||||
|
(use-modules (guix profiles)
|
||||||
|
(rosenthal packages))
|
||||||
|
|
||||||
|
(manifest (map package->manifest-entry (all-rosenthal-packages)))
|
16
etc/manifests/auto-update.scm
Normal file
16
etc/manifests/auto-update.scm
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
;; SPDX-FileCopyrightText: 2025 Hilton Chain <hako@ultrarare.space>
|
||||||
|
;;
|
||||||
|
;; SPDX-License-Identifier: CC0-1.0
|
||||||
|
|
||||||
|
(use-modules (guix packages)
|
||||||
|
(guix profiles)
|
||||||
|
(rosenthal packages))
|
||||||
|
|
||||||
|
(define (disable-updater? p)
|
||||||
|
(let ((properties (package-properties p)))
|
||||||
|
(and (assq 'rosenthal-update? properties)
|
||||||
|
(not (assq-ref properties 'rosenthal-update?)))))
|
||||||
|
|
||||||
|
(manifest (map package->manifest-entry
|
||||||
|
(filter (negate disable-updater?)
|
||||||
|
(all-rosenthal-packages))))
|
16
etc/manifests/manual-update.scm
Normal file
16
etc/manifests/manual-update.scm
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
;; SPDX-FileCopyrightText: 2025 Hilton Chain <hako@ultrarare.space>
|
||||||
|
;;
|
||||||
|
;; SPDX-License-Identifier: CC0-1.0
|
||||||
|
|
||||||
|
(use-modules (guix packages)
|
||||||
|
(guix profiles)
|
||||||
|
(rosenthal packages))
|
||||||
|
|
||||||
|
(define (disable-updater? p)
|
||||||
|
(let ((properties (package-properties p)))
|
||||||
|
(and (assq 'rosenthal-update? properties)
|
||||||
|
(not (assq-ref properties 'rosenthal-update?)))))
|
||||||
|
|
||||||
|
(manifest (map package->manifest-entry
|
||||||
|
(filter disable-updater?
|
||||||
|
(all-rosenthal-packages))))
|
@ -3,6 +3,7 @@
|
|||||||
;; SPDX-License-Identifier: GPL-3.0-or-later
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||||||
|
|
||||||
(define-module (rosenthal packages binaries)
|
(define-module (rosenthal packages binaries)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module ((guix licenses) #:prefix license:)
|
#:use-module ((guix licenses) #:prefix license:)
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
#:use-module (guix deprecation)
|
#:use-module (guix deprecation)
|
||||||
@ -29,7 +30,7 @@
|
|||||||
(define-public atuin-bin
|
(define-public atuin-bin
|
||||||
(deprecated-package "atuin-bin" atuin))
|
(deprecated-package "atuin-bin" atuin))
|
||||||
|
|
||||||
(define bitwarden
|
(define-public bitwarden
|
||||||
(package
|
(package
|
||||||
(name "bitwarden")
|
(name "bitwarden")
|
||||||
(version "2025.3.1")
|
(version "2025.3.1")
|
||||||
@ -50,10 +51,18 @@
|
|||||||
(description
|
(description
|
||||||
"This package provides browser extension for Bitwarden client.")
|
"This package provides browser extension for Bitwarden client.")
|
||||||
(license license:gpl3)
|
(license license:gpl3)
|
||||||
(properties '((addon-id . "{446900e4-71c2-419f-a6a7-df9c091e268b}")))))
|
(properties
|
||||||
|
'((addon-id . "{446900e4-71c2-419f-a6a7-df9c091e268b}")
|
||||||
|
(hidden? . #t)
|
||||||
|
(rosenthal-update? . #f)))))
|
||||||
|
|
||||||
(define-public bitwarden/icecat
|
(define-public bitwarden/icecat
|
||||||
(make-icecat-extension bitwarden))
|
(let ((base (make-icecat-extension bitwarden)))
|
||||||
|
(package
|
||||||
|
(inherit base)
|
||||||
|
(properties
|
||||||
|
`(,@(alist-delete 'hidden? (package-properties base))
|
||||||
|
(rosenthal-update? . #f))))))
|
||||||
|
|
||||||
(define-public hugo-bin
|
(define-public hugo-bin
|
||||||
(deprecated-package "hugo-bin" hugo))
|
(deprecated-package "hugo-bin" hugo))
|
||||||
@ -180,11 +189,14 @@ eBooks.")
|
|||||||
(license license:expat)
|
(license license:expat)
|
||||||
(properties '((upstream-name . "komga")))))
|
(properties '((upstream-name . "komga")))))
|
||||||
|
|
||||||
(define miniflux-injector
|
(define-public miniflux-injector
|
||||||
(package
|
(package
|
||||||
(name "miniflux-injector")
|
(name "miniflux-injector")
|
||||||
(version "2.3.3")
|
(version "2.3.3")
|
||||||
(properties '((addon-id . "{528ec801-2e29-4cb9-ae71-5a90503138d1}")))
|
(properties
|
||||||
|
'((addon-id . "{528ec801-2e29-4cb9-ae71-5a90503138d1}")
|
||||||
|
(hidden? . #t)
|
||||||
|
(rosenthal-update? . #f)))
|
||||||
(source
|
(source
|
||||||
(origin
|
(origin
|
||||||
(method url-fetch/zipbomb)
|
(method url-fetch/zipbomb)
|
||||||
@ -219,7 +231,12 @@ results are added in a sidebar next to search engine results.")
|
|||||||
(license license:expat)))
|
(license license:expat)))
|
||||||
|
|
||||||
(define-public miniflux-injector/icecat
|
(define-public miniflux-injector/icecat
|
||||||
(make-icecat-extension miniflux-injector))
|
(let ((base (make-icecat-extension miniflux-injector)))
|
||||||
|
(package
|
||||||
|
(inherit base)
|
||||||
|
(properties
|
||||||
|
`(,@(alist-delete 'hidden? (package-properties base))
|
||||||
|
(rosenthal-update? . #f))))))
|
||||||
|
|
||||||
(define-public navidrome-bin
|
(define-public navidrome-bin
|
||||||
(package
|
(package
|
||||||
|
@ -47,4 +47,7 @@
|
|||||||
(delete-file "configure")))))))
|
(delete-file "configure")))))))
|
||||||
(native-inputs
|
(native-inputs
|
||||||
(modify-inputs (package-native-inputs base)
|
(modify-inputs (package-native-inputs base)
|
||||||
(append autoconf automake python-minimal-wrapper))))))
|
(append autoconf automake python-minimal-wrapper)))
|
||||||
|
(properties
|
||||||
|
`(,@(package-properties base)
|
||||||
|
(rosenthal-update? . #f))))))
|
||||||
|
@ -25,4 +25,7 @@
|
|||||||
;; FIXME: All mdev tests fail when building staticly.
|
;; FIXME: All mdev tests fail when building staticly.
|
||||||
(add-before 'check 'disable-failing-tests
|
(add-before 'check 'disable-failing-tests
|
||||||
(lambda _
|
(lambda _
|
||||||
(delete-file "testsuite/mdev.tests"))))))))))
|
(delete-file "testsuite/mdev.tests")))))))
|
||||||
|
(properties
|
||||||
|
`(,@(package-properties base)
|
||||||
|
(rosenthal-update? . #f))))))
|
||||||
|
@ -58,4 +58,6 @@ foreign CDN results so you also get best CDN node for your VPN at the same
|
|||||||
time.
|
time.
|
||||||
@item Block ISP ads on NXDOMAIN result (like 114so).
|
@item Block ISP ads on NXDOMAIN result (like 114so).
|
||||||
@end itemize")
|
@end itemize")
|
||||||
(license license:wtfpl2))))
|
(license license:wtfpl2)
|
||||||
|
(properties
|
||||||
|
'((rosenthal-update? . #f))))))
|
||||||
|
@ -50,7 +50,9 @@ It currently only offers basic highlighting and primitive indentation.")
|
|||||||
(description
|
(description
|
||||||
"This package provides enhanced completions for the tailscale command
|
"This package provides enhanced completions for the tailscale command
|
||||||
and it's subcommands.")
|
and it's subcommands.")
|
||||||
(license license:gpl3+))))
|
(license license:gpl3+)
|
||||||
|
(properties
|
||||||
|
'((rosenthal-update? . #f))))))
|
||||||
|
|
||||||
(define-public emacs-treesit-auto
|
(define-public emacs-treesit-auto
|
||||||
(package
|
(package
|
||||||
@ -73,7 +75,9 @@ and it's subcommands.")
|
|||||||
"@code{treesit-auto} is an Emacs package for automatically using tree-sitter
|
"@code{treesit-auto} is an Emacs package for automatically using tree-sitter
|
||||||
major modes and falling back to the original major mode when its tree-sitter
|
major modes and falling back to the original major mode when its tree-sitter
|
||||||
counterpart is unavailable.")
|
counterpart is unavailable.")
|
||||||
(license license:gpl3+)))
|
(license license:gpl3+)
|
||||||
|
(properties
|
||||||
|
'((rosenthal-update? . #f)))))
|
||||||
|
|
||||||
;; https://issues.guix.gnu.org/59552
|
;; https://issues.guix.gnu.org/59552
|
||||||
(define-public emacs-wakatime-mode
|
(define-public emacs-wakatime-mode
|
||||||
@ -104,4 +108,6 @@ counterpart is unavailable.")
|
|||||||
(description
|
(description
|
||||||
"WakaTime mode is an Emacs minor mode for automatic time tracking and
|
"WakaTime mode is an Emacs minor mode for automatic time tracking and
|
||||||
metrics generated from your programming activity.")
|
metrics generated from your programming activity.")
|
||||||
(license license:gpl3+))))
|
(license license:gpl3+)
|
||||||
|
(properties
|
||||||
|
'((rosenthal-update? . #f))))))
|
||||||
|
@ -24,7 +24,10 @@
|
|||||||
(base32 "199yajw3amvspl9k2a75v4jblwr965laqngxbnsi5l3ragp5c1ck"))))
|
(base32 "199yajw3amvspl9k2a75v4jblwr965laqngxbnsi5l3ragp5c1ck"))))
|
||||||
(native-inputs
|
(native-inputs
|
||||||
;; Go 1.24 and later requires Go 1.22+ as the bootstrap toolchain.
|
;; Go 1.24 and later requires Go 1.22+ as the bootstrap toolchain.
|
||||||
(alist-replace "go" (list go-1.22) (package-native-inputs go-1.23)))))
|
(alist-replace "go" (list go-1.22) (package-native-inputs go-1.23)))
|
||||||
|
(properties
|
||||||
|
`(,@(package-properties go-1.23)
|
||||||
|
(rosenthal-update? . #f)))))
|
||||||
|
|
||||||
(define-public go-cloudflare
|
(define-public go-cloudflare
|
||||||
(let ((commit "37bc41c6ff79507200a315b72834fce6ca427a7e")
|
(let ((commit "37bc41c6ff79507200a315b72834fce6ca427a7e")
|
||||||
@ -43,4 +46,7 @@
|
|||||||
(base32
|
(base32
|
||||||
"1zg6jqwhj42gaapk1fzqc4i7a6shdbfbpqgqhjyry55r4i0nqvxy"))))
|
"1zg6jqwhj42gaapk1fzqc4i7a6shdbfbpqgqhjyry55r4i0nqvxy"))))
|
||||||
(home-page "https://github.com/cloudflare/go")
|
(home-page "https://github.com/cloudflare/go")
|
||||||
(synopsis "Go with Cloudflare experimental patches"))))
|
(synopsis "Go with Cloudflare experimental patches")
|
||||||
|
(properties
|
||||||
|
`(,@(package-properties go-1.22)
|
||||||
|
(rosenthal-update? . #f))))))
|
||||||
|
@ -246,7 +246,9 @@ can be used to create network proxy servers, clients and transparent proxies.")
|
|||||||
(description
|
(description
|
||||||
"This package provides a simple tool to plumb HTTP proxy requests through
|
"This package provides a simple tool to plumb HTTP proxy requests through
|
||||||
a SOCKS5 proxy.")
|
a SOCKS5 proxy.")
|
||||||
(license license:expat)))
|
(license license:expat)
|
||||||
|
(properties
|
||||||
|
'((rosenthal-update? . #f)))))
|
||||||
|
|
||||||
(define-public tailscale
|
(define-public tailscale
|
||||||
(package
|
(package
|
||||||
|
@ -23,4 +23,7 @@
|
|||||||
(modify-inputs (package-inputs base)
|
(modify-inputs (package-inputs base)
|
||||||
(append `(,zlib "static"))
|
(append `(,zlib "static"))
|
||||||
(replace "libtomcrypt" `(,libtomcrypt "static"))
|
(replace "libtomcrypt" `(,libtomcrypt "static"))
|
||||||
(replace "libtommath" `(,libtommath "static")))))))
|
(replace "libtommath" `(,libtommath "static"))))
|
||||||
|
(properties
|
||||||
|
`(,@(package-properties base)
|
||||||
|
(rosenthal-update? . #f))))))
|
||||||
|
@ -35,4 +35,6 @@
|
|||||||
(inherit base)
|
(inherit base)
|
||||||
(arguments
|
(arguments
|
||||||
(append '(#:tests? #f) ;FIXME
|
(append '(#:tests? #f) ;FIXME
|
||||||
(package-arguments base))))))
|
(package-arguments base)))
|
||||||
|
(properties
|
||||||
|
'((rosenthal-update? . #f))))))
|
||||||
|
@ -20,4 +20,7 @@
|
|||||||
((#:phases _) #~%standard-phases)))
|
((#:phases _) #~%standard-phases)))
|
||||||
(inputs
|
(inputs
|
||||||
(modify-inputs (package-inputs base)
|
(modify-inputs (package-inputs base)
|
||||||
(delete "libx11" "libxext" "libxfixes"))))))
|
(delete "libx11" "libxext" "libxfixes")))
|
||||||
|
(properties
|
||||||
|
`(,@(package-properties base)
|
||||||
|
(rosenthal-update? . #f))))))
|
||||||
|
@ -258,4 +258,6 @@ pipelines, Hugo renders a complete site in seconds, often less.")
|
|||||||
facilitate collaborative software development. It is built to be easy to
|
facilitate collaborative software development. It is built to be easy to
|
||||||
install and maintain, making it an ideal choice for teams and organizations
|
install and maintain, making it an ideal choice for teams and organizations
|
||||||
looking for a reliable platform to manage their software projects.")
|
looking for a reliable platform to manage their software projects.")
|
||||||
(license license:gpl3+)))
|
(license license:gpl3+)
|
||||||
|
(properties
|
||||||
|
'((rosenthal-update? . #f)))))
|
||||||
|
@ -67,7 +67,9 @@
|
|||||||
(synopsis "Rust bindings for PipeWire")
|
(synopsis "Rust bindings for PipeWire")
|
||||||
(description "This package provides Rust bindings for PipeWire.")
|
(description "This package provides Rust bindings for PipeWire.")
|
||||||
(license license:expat)
|
(license license:expat)
|
||||||
(properties '((hidden? . #t))))))
|
(properties
|
||||||
|
'((hidden? . #t)
|
||||||
|
(rosenthal-update? . #f))))))
|
||||||
|
|
||||||
(define-public rust-smithay
|
(define-public rust-smithay
|
||||||
(let ((commit "0cd3345c59f7cb139521f267956a1a4e33248393")
|
(let ((commit "0cd3345c59f7cb139521f267956a1a4e33248393")
|
||||||
@ -118,7 +120,9 @@ will need, in a generic fashion.
|
|||||||
It supports the @code{wayland}, @code{wayland-protocols}, and some external
|
It supports the @code{wayland}, @code{wayland-protocols}, and some external
|
||||||
extensions, such as @code{wlr-protocols} and @code{plasma-wayland-protocols}.")
|
extensions, such as @code{wlr-protocols} and @code{plasma-wayland-protocols}.")
|
||||||
(license license:expat)
|
(license license:expat)
|
||||||
(properties '((hidden? . #t))))))
|
(properties
|
||||||
|
'((hidden? . #t)
|
||||||
|
(rosenthal-update? . #f))))))
|
||||||
|
|
||||||
(define-public niri
|
(define-public niri
|
||||||
(package
|
(package
|
||||||
|
Loading…
Reference in New Issue
Block a user