[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/05: services: cgit: Add support for file-like objects.
|
From: |
Clément Lassieur |
|
Subject: |
03/05: services: cgit: Add support for file-like objects. |
|
Date: |
Wed, 11 Apr 2018 15:24:23 -0400 (EDT) |
snape pushed a commit to branch master
in repository guix.
commit ad05e96e14ff61c5739a9f8fc79aba8ed6545d16
Author: Clément Lassieur <address@hidden>
Date: Tue Mar 20 20:33:38 2018 +0100
services: cgit: Add support for file-like objects.
* doc/guix.texi (Version Control Services): Update accordingly.
* gnu/services/cgit.scm (serialize-field, serialize-string,
serialize-boolean,
serialize-integer, serialize-repository-cgit-configuration-list,
serialize-nginx-server-configuration-list, serialize-repo-field,
serialize-repo-boolean, serialize-repo-integer, serialize-module-link-path,
serialize-repository-directory, serialize-mimetype-alist): Return strings or
string-valued gexps and stop printing.
(repository-cgit-configuration)[source-filter, about-filter, commit-filter,
logo, owner-filter], (cgit-configuration)[auth-filter, commit-filter, css,
email-filter, favicon, include, logo, owner-filter, mimetype-file, readme,
source-filter]: Replace STRING with FILE-OBJECT.
(file-object?, serialize-file-object, repo-file-object?,
serialize-repo-file-object): New procedures.
(cgit-activation): Use SERIALIZE-CONFIGURATION's return value with
MIXED-TEXT-FILE instead of using its output with PLAIN-FILE.
---
doc/guix.texi | 40 ++++++++++++-----------
gnu/services/cgit.scm | 87 ++++++++++++++++++++++++++++-----------------------
2 files changed, 70 insertions(+), 57 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index d825f39..1e9601c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -18542,6 +18542,9 @@ By default, Cgit can be accessed on port 80
(@code{http://localhost:80}).
(service cgit-service-type)
@end example
+The @code{file-object} type designates either a file-like object
+(@pxref{G-Expressions, file-like objects}) or a string.
+
@c %start of fragment
Available @code{cgit-configuration} fields are:
@@ -18556,7 +18559,7 @@ NGINX configuration.
@end deftypevr
address@hidden address@hidden parameter} string about-filter
address@hidden address@hidden parameter} file-object about-filter
Specifies a command which will be invoked to format the content of about
pages (both top-level and for each repository).
@@ -18572,7 +18575,7 @@ Defaults to @samp{""}.
@end deftypevr
address@hidden address@hidden parameter} string auth-filter
address@hidden address@hidden parameter} file-object auth-filter
Specifies a command that will be invoked for authenticating repository
access.
@@ -18681,7 +18684,7 @@ Defaults to @samp{()}.
@end deftypevr
address@hidden address@hidden parameter} string commit-filter
address@hidden address@hidden parameter} file-object commit-filter
Command which will be invoked to format commit messages.
Defaults to @samp{""}.
@@ -18697,14 +18700,14 @@ Defaults to @samp{"git log"}.
@end deftypevr
address@hidden address@hidden parameter} string css
address@hidden address@hidden parameter} file-object css
URL which specifies the css document to include in all cgit pages.
Defaults to @samp{"/share/cgit/cgit.css"}.
@end deftypevr
address@hidden address@hidden parameter} string email-filter
address@hidden address@hidden parameter} file-object email-filter
Specifies a command which will be invoked to format names and email
address of committers, authors, and taggers, as represented in various
places throughout the cgit interface.
@@ -18828,7 +18831,7 @@ Defaults to @samp{#f}.
@end deftypevr
address@hidden address@hidden parameter} string favicon
address@hidden address@hidden parameter} file-object favicon
URL used as link to a shortcut icon for cgit.
Defaults to @samp{"/favicon.ico"}.
@@ -18860,7 +18863,7 @@ Defaults to @samp{""}.
@end deftypevr
address@hidden address@hidden parameter} string include
address@hidden address@hidden parameter} file-object include
Name of a configfile to include before the rest of the current config-
file is parsed.
@@ -18892,7 +18895,7 @@ Defaults to @samp{#f}.
@end deftypevr
address@hidden address@hidden parameter} string logo
address@hidden address@hidden parameter} file-object logo
URL which specifies the source of an image which will be used as a logo
on all cgit pages.
@@ -18907,7 +18910,7 @@ Defaults to @samp{""}.
@end deftypevr
address@hidden address@hidden parameter} string owner-filter
address@hidden address@hidden parameter} file-object owner-filter
Command which will be invoked to format the Owner column of the main
page.
@@ -18976,7 +18979,7 @@ Defaults to @samp{((gif "image/gif") (html "text/html")
(jpg
@end deftypevr
address@hidden address@hidden parameter} string mimetype-file
address@hidden address@hidden parameter} file-object mimetype-file
Specifies the file to use for automatic mimetype lookup.
Defaults to @samp{""}.
@@ -19014,7 +19017,7 @@ Defaults to @samp{#f}.
@end deftypevr
address@hidden address@hidden parameter} string readme
address@hidden address@hidden parameter} file-object readme
Text which will be used as default value for @code{cgit-repo-readme}.
Defaults to @samp{""}.
@@ -19132,7 +19135,7 @@ Defaults to @samp{#f}.
@end deftypevr
address@hidden address@hidden parameter} string source-filter
address@hidden address@hidden parameter} file-object source-filter
Specifies a command which will be invoked to format plaintext blobs in
the tree view.
@@ -19194,7 +19197,7 @@ Defaults to @samp{()}.
@end deftypevr
address@hidden address@hidden parameter} repo-string source-filter
address@hidden address@hidden parameter} repo-file-object source-filter
Override the default @code{source-filter}.
Defaults to @samp{""}.
@@ -19208,7 +19211,7 @@ Defaults to @samp{""}.
@end deftypevr
address@hidden address@hidden parameter} repo-string about-filter
address@hidden address@hidden parameter} repo-file-object about-filter
Override the default @code{about-filter}.
Defaults to @samp{""}.
@@ -19230,7 +19233,7 @@ Defaults to @samp{()}.
@end deftypevr
address@hidden address@hidden parameter} repo-string commit-filter
address@hidden address@hidden parameter} repo-file-object commit-filter
Override the default @code{commit-filter}.
Defaults to @samp{""}.
@@ -19270,7 +19273,7 @@ Defaults to @samp{""}.
@end deftypevr
address@hidden address@hidden parameter} repo-string email-filter
address@hidden address@hidden parameter} repo-file-object email-filter
Override the default @code{email-filter}.
Defaults to @samp{""}.
@@ -19340,7 +19343,7 @@ Defaults to @samp{#f}.
@end deftypevr
address@hidden address@hidden parameter} repo-string logo
address@hidden address@hidden parameter} repo-file-object logo
URL which specifies the source of an image which will be used as a logo
on this repo’s pages.
@@ -19355,7 +19358,7 @@ Defaults to @samp{""}.
@end deftypevr
address@hidden address@hidden parameter} repo-string owner-filter
address@hidden address@hidden parameter} repo-file-object owner-filter
Override the default @code{owner-filter}.
Defaults to @samp{""}.
@@ -19440,6 +19443,7 @@ Defaults to @samp{()}.
@end deftypevr
+
@c %end of fragment
However, it could be that you just want to get a @code{cgitrc} up and
diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index 3c685f1..98e46e0 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -76,13 +76,12 @@
(string-delete #\? (symbol->string field-name)))
(define (serialize-field field-name val)
- (format #t "~a=~a\n" (uglify-field-name field-name) val))
+ #~(format #f "~a=~a\n" #$(uglify-field-name field-name) #$val))
(define (serialize-string field-name val)
- (if (string=? val "") "" (serialize-field field-name val)))
-
-(define (serialize-boolean field-name val)
- (serialize-field field-name (if val 1 0)))
+ (if (and (string? val) (string=? val ""))
+ ""
+ (serialize-field field-name val)))
(define (serialize-list field-name val)
(if (null? val) "" (serialize-field field-name (string-join val))))
@@ -96,7 +95,10 @@
(exact-integer? val))
(define (serialize-integer field-name val)
- (serialize-field field-name val))
+ (serialize-field field-name (number->string val)))
+
+(define (serialize-boolean field-name val)
+ (serialize-integer field-name (if val 1 0)))
(define (serialize-repository-cgit-configuration x)
(serialize-configuration x repository-cgit-configuration-fields))
@@ -105,7 +107,13 @@
(list? val))
(define (serialize-repository-cgit-configuration-list field-name val)
- (for-each serialize-repository-cgit-configuration val))
+ #~(string-append
+ #$@(map serialize-repository-cgit-configuration val)))
+
+(define (file-object? val)
+ (or (file-like? val) (string? val)))
+(define (serialize-file-object field-name val)
+ (serialize-string field-name val))
;;;
@@ -116,7 +124,7 @@
(and (list? val) (and-map nginx-server-configuration? val)))
(define (serialize-nginx-server-configuration-list field-name val)
- #f)
+ "")
;;;
@@ -124,18 +132,18 @@
;;;
(define (serialize-repo-field field-name val)
- (format #t "repo.~a=~a\n" (uglify-field-name field-name) val))
+ #~(format #f "repo.~a=~a\n" #$(uglify-field-name field-name) #$val))
(define (serialize-repo-list field-name val)
(if (null? val) "" (serialize-repo-field field-name (string-join val))))
(define repo-boolean? boolean?)
-(define (serialize-repo-boolean field-name val)
- (serialize-repo-field field-name (if val 1 0)))
-
(define (serialize-repo-integer field-name val)
- (serialize-repo-field field-name val))
+ (serialize-repo-field field-name (number->string val)))
+
+(define (serialize-repo-boolean field-name val)
+ (serialize-repo-integer field-name (if val 1 0)))
(define repo-list? list?)
@@ -144,23 +152,26 @@
(define (serialize-repo-string field-name val)
(if (string=? val "") "" (serialize-repo-field field-name val)))
+(define repo-file-object? file-object?)
+(define serialize-repo-file-object serialize-repo-string)
+
(define module-link-path? list?)
(define (serialize-module-link-path field-name val)
(if (null? val) ""
(match val
((path text)
- (format #t "repo.module-link.~a=~a\n" path text)))))
+ (format #f "repo.module-link.~a=~a\n" path text)))))
(define repository-directory? string?)
(define (serialize-repository-directory _ val)
- (if (string=? val "") "" (format #t "scan-path=~a\n" val)))
+ (if (string=? val "") "" (format #f "scan-path=~a\n" val)))
(define mimetype-alist? list?)
(define (serialize-mimetype-alist field-name val)
- (format #t "# Mimetypes\n~a"
+ (format #f "# Mimetypes\n~a"
(string-join
(map (match-lambda
((extension mimetype)
@@ -174,13 +185,13 @@
"A mask of snapshot formats for this repo that cgit generates links for,
restricted by the global @code{snapshots} setting.")
(source-filter
- (repo-string "")
+ (repo-file-object "")
"Override the default @code{source-filter}.")
(url
(repo-string "")
"The relative URL used to access the repository.")
(about-filter
- (repo-string "")
+ (repo-file-object "")
"Override the default @code{about-filter}.")
(branch-sort
(repo-string "")
@@ -190,7 +201,7 @@ ref list, and when set to @samp{name} enables ordering by
branch name.")
(repo-list '())
"A list of URLs which can be used to clone repo.")
(commit-filter
- (repo-string "")
+ (repo-file-object "")
"Override the default @code{commit-filter}.")
(commit-sort
(repo-string "")
@@ -209,7 +220,7 @@ is no suitable HEAD.")
(repo-string "")
"The value to show as repository homepage.")
(email-filter
- (repo-string "")
+ (repo-file-object "")
"Override the default @code{email-filter}.")
(enable-commit-graph?
(repo-boolean #f)
@@ -243,14 +254,14 @@ repository index.")
(repo-boolean #f)
"Flag which, when set to @samp{#t}, ignores the repository.")
(logo
- (repo-string "")
+ (repo-file-object "")
"URL which specifies the source of an image which will be used as a
logo on this repo’s pages.")
(logo-link
(repo-string "")
"URL loaded when clicking on the cgit logo image.")
(owner-filter
- (repo-string "")
+ (repo-file-object "")
"Override the default @code{owner-filter}.")
(module-link
(repo-string "")
@@ -296,7 +307,7 @@ after this option will inherit the current section name.")
(nginx-server-configuration-list (list %cgit-configuration-nginx))
"NGINX configuration.")
(about-filter
- (string "")
+ (file-object "")
"Specifies a command which will be invoked to format the content of about
pages (both top-level and for each repository).")
(agefile
@@ -304,7 +315,7 @@ pages (both top-level and for each repository).")
"Specifies a path, relative to each repository path, which can be used to
specify the date and time of the youngest commit in the repository.")
(auth-filter
- (string "")
+ (file-object "")
"Specifies a command that will be invoked for authenticating repository
access.")
(branch-sort
@@ -357,7 +368,7 @@ generates valid clone URLs for the repository.")
(list '())
"List of @code{clone-url} templates.")
(commit-filter
- (string "")
+ (file-object "")
"Command which will be invoked to format commit messages.")
(commit-sort
(string "git log")
@@ -365,10 +376,10 @@ generates valid clone URLs for the repository.")
commit log, and when set to @samp{topo} enables strict topological
ordering.")
(css
- (string "/share/cgit/cgit.css")
+ (file-object "/share/cgit/cgit.css")
"URL which specifies the css document to include in all cgit pages.")
(email-filter
- (string "")
+ (file-object "")
"Specifies a command which will be invoked to format names and email
address of committers, authors, and taggers, as represented in various
places throughout the cgit interface.")
@@ -432,7 +443,7 @@ links for plaintext blobs printed in the tree view.")
"Flag which, when set to @samp{#f}, will allow cgit to use Git config to
set any repo specific settings.")
(favicon
- (string "/favicon.ico")
+ (file-object "/favicon.ico")
"URL used as link to a shortcut icon for cgit.")
(footer
(string "")
@@ -448,7 +459,7 @@ verbatim in the HTML HEAD section on all pages.")
"The content of the file specified with this option will be included
verbatim at the top of all pages.")
(include
- (string "")
+ (file-object "")
"Name of a configfile to include before the rest of the current config-
file is parsed.")
(index-header
@@ -464,14 +475,14 @@ verbatim below the heading on the repository index page.")
"Flag which, if set to @samp{#t}, makes cgit print commit and tag times
in the servers timezone.")
(logo
- (string "/share/cgit/cgit.png")
+ (file-object "/share/cgit/cgit.png")
"URL which specifies the source of an image which will be used as a logo
on all cgit pages.")
(logo-link
(string "")
"URL loaded when clicking on the cgit logo image.")
(owner-filter
- (string "")
+ (file-object "")
"Command which will be invoked to format the Owner column of the main
page.")
(max-atom-items
@@ -508,7 +519,7 @@ on the repository index page.")
(svg "image/svg+xml")))
"Mimetype for the specified filename extension.")
(mimetype-file
- (string "")
+ (file-object "")
"Specifies the file to use for automatic mimetype lookup.")
(module-link
(string "")
@@ -533,7 +544,7 @@ header on all pages.")
;; "A list of subdirectories inside of @code{repository-directory},
;; relative to it, that should loaded as Git repositories.")
(readme
- (string "")
+ (file-object "")
"Text which will be used as default value for @code{cgit-repo-readme}.")
(remove-suffix?
(boolean #f)
@@ -591,7 +602,7 @@ many path elements from each repo path to use as a default
section name.")
"If set to @samp{#t} shows side-by-side diffs instead of unidiffs per
default.")
(source-filter
- (string "")
+ (file-object "")
"Specifies a command which will be invoked to format plaintext blobs in the
tree view.")
(summary-branches
@@ -640,16 +651,14 @@ for cgit to allow access to that repository.")
(config-str
(if opaque-config?
(opaque-cgit-configuration-cgitrc config)
- (with-output-to-string
- (lambda ()
- (serialize-configuration config
- cgit-configuration-fields))))))
+ (serialize-configuration config cgit-configuration-fields))))
#~(begin
(use-modules (guix build utils))
(mkdir-p #$(if opaque-config?
(opaque-cgit-configuration-cache-root config)
(cgit-configuration-cache-root config)))
- (copy-file #$(plain-file "cgitrc" config-str) "/etc/cgitrc"))))
+ (copy-file #$(mixed-text-file "cgitrc" config-str)
+ "/etc/cgitrc"))))
(define (cgit-configuration-nginx-config config)
(if (opaque-cgit-configuration? config)