bin: Spin out hosts normalization into separate function.

* bin/tissue (tissue-web): Spin out hosts normalization into ...
(normalize-host): ... new function.

1 files changed, 25 insertions, 19 deletions

diff --git a/bin/tissue b/bin/tissue
index f81ef5a..566cf36 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -242,6 +242,28 @@ port."
              socket-or-port)
      (make-tcp-server-socket #:port socket-or-port)))))
 
+(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-lambda
+    ((name . parameters)
+     ;; Add repository directory, website directory, xapian directory
+     ;; settings for each host.
+     (let ((repository-directory
+            (string-append state-directory "/" name "/repository")))
+       (parameterize ((%current-git-repository
+                       (repository-open repository-directory)))
+         (cons name
+               `((project . ,(call-with-temporary-checkout repository-directory
+                               (lambda (temporary-checkout)
+                                 (call-with-current-directory temporary-checkout
+                                   load-config))))
+                 (repository-directory . ,repository-directory)
+                 (website-directory . ,(string-append state-directory "/" name "/website"))
+                 (xapian-directory . ,(string-append state-directory "/" name "/xapian"))
+                 ,@parameters)))))))
+
 (define tissue-web
   (match-lambda*
     (("--help")
@@ -267,25 +289,9 @@ Serve repositories specified in CONFIG-FILE over HTTP.
        (when (assq-ref args 'listen-repl)
          (start-repl (assq-ref args 'listen-repl)))
        (start-web-server (listen->socket-address (assq-ref args 'listen))
-                         (map (match-lambda
-                                ((name parameters ...)
-                                 ;; Add repository directory, website
-                                 ;; directory, xapian directory
-                                 ;; settings for each host.
-                                 (let* ((state-directory (assq-ref args 'state-directory))
-                                        (repository-directory
-                                         (string-append state-directory "/" name "/repository")))
-                                   (parameterize ((%current-git-repository
-                                                   (repository-open repository-directory)))
-                                     (cons name
-                                           `((project . ,(call-with-temporary-checkout repository-directory
-                                                           (lambda (temporary-checkout)
-                                                             (call-with-current-directory temporary-checkout
-                                                               load-config))))
-                                             (repository-directory . ,repository-directory)
-                                             (website-directory . ,(string-append state-directory "/" name "/website"))
-                                             (xapian-directory . ,(string-append state-directory "/" name "/xapian"))
-                                             ,@parameters))))))
+                         (map (cut normalize-host
+                                   (assq-ref args 'state-directory)
+                                   <>)
                               (assq-ref args 'hosts)))))))
 
 (define tissue-web-dev