diff options
Diffstat (limited to 'bin/tissue')
| -rwxr-xr-x | bin/tissue | 63 |
1 files changed, 41 insertions, 22 deletions
@@ -252,23 +252,39 @@ port." (call-with-current-directory temporary-checkout load-config))))) -(define (normalize-host state-directory host) - "Normalize @var{host} from @file{tissue.conf} adding in default and +(define (normalize-project state-directory project) + "Normalize @var{project} from @file{tissue.conf} adding in default and extra parameters for convenient processing later on. @var{state-directory} is the tissue state directory." - (match-lambda + (match project ((name . parameters) - ;; Add repository directory, website directory, xapian directory - ;; settings for each host. (let ((repository-directory (string-append state-directory "/" name "/repository"))) (cons name - `((project . ,(load-config-from-repository repository-directory)) + `((base-path . ,(or (assq-ref parameters 'base-path) + (string-append "/" name))) + (project . ,(load-config-from-repository repository-directory)) (repository-directory . ,repository-directory) - (website-directory . ,(string-append state-directory "/" name "/website")) - (xapian-directory . ,(string-append state-directory "/" name "/xapian")) + (website-directory . ,(string-append state-directory + "/" name "/website")) + (xapian-directory . ,(string-append state-directory + "/" name "/xapian")) ,@parameters)))))) +(define (normalize-host state-directory host) + "Normalize @var{host} from @file{tissue.conf} adding in default and +extra parameters for convenient processing later on. +@var{state-directory} is the tissue state directory." + (match host + ((host-name . host-parameters) + ;; Add repository directory, website directory, xapian directory + ;; settings for each host. + (cons host-name + `((projects + ,@(map (cut normalize-project state-directory <>) + (assq-ref host-parameters 'projects))) + ,@host-parameters))))) + (define tissue-web (match-lambda* (("--help") @@ -455,7 +471,7 @@ HOSTNAME." (define tissue-pull (match-lambda* (("--help") - (format #t "Usage: ~a pull [OPTIONS] HOST + (format #t "Usage: ~a pull [OPTIONS] PROJECT Pull latest from upstream repositories. -C, --config=CONFIG-FILE read configuration parameters from CONFIG-FILE @@ -470,8 +486,8 @@ Pull latest from upstream repositories. read) result)))) invalid-option - (lambda (host result) - (acons 'host host result)) + (lambda (project result) + (acons 'project project result)) (default-configuration)))) (let ((state-directory (assq-ref args 'state-directory))) ;; Error out if state directory does not exist. @@ -480,24 +496,27 @@ Pull latest from upstream repositories. "State directory ~a does not exist.~%" state-directory) (exit #f)) - ;; Pull state for specificied host. - ;; It is not a good idea to pull for all configured hosts - ;; when no host is specified on the command line. Since + ;; Pull state for specificied project. + ;; It is not a good idea to pull for all configured projects + ;; when no project is specified on the command line. Since ;; pulling requires executing code in each repository, - ;; pulling for multiple hosts in a single process can cause - ;; interaction of code across hosts. - (let ((hostname (assq-ref args 'host))) + ;; pulling for multiple projects in a single process can + ;; cause interaction of code across projects. + (let ((project-name (assq-ref args 'project))) (cond - ((assoc-ref (assq-ref args 'hosts) - hostname) + ((assoc-ref (append-map (match-lambda + ((_ . parameters) + (assq-ref parameters 'projects))) + (assq-ref args 'hosts)) + project-name) => (lambda (parameters) (pull state-directory - hostname + project-name (assq-ref parameters 'upstream-repository)))) (else (format (current-error-port) - "Host ~a not found in configuration file." - hostname) + "Project ~a not found in configuration file." + project-name) (exit #f))))))))) (define (main args) |