ui: Add 'new' subcommand.

* doc/haunt.texi: Document it.
* haunt/ui/new.scm: New file.
* Makefile.am (SOURCES): Add it.
* README: Mention the new subcommand.

5 files changed, 174 insertions, 1 deletions

diff --git a/Makefile.am b/Makefile.am
index 679fb15..5ed9c87 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -66,6 +66,7 @@ SOURCES =					\
   haunt/watch/fallback.scm			\
   haunt/ui.scm					\
   haunt/ui/build.scm				\
+  haunt/ui/new.scm				\
   haunt/ui/publish.scm				\
   haunt/ui/serve.scm				\
   haunt/serve/mime-types.scm			\
diff --git a/README b/README
index 7fc6695..b65e301 100644
--- a/README
+++ b/README
@@ -37,6 +37,9 @@ simple, functional, and extensible.
 Write a configuration file named =haunt.scm=.  Add your posts to a
 directory named =posts=.  Then run =haunt build=!
 
+Alternatively, use the =haunt new= command to start a project from a
+template quickly.
+
 To view your creation, run =haunt serve= and browse to
 =localhost:8080=.  For quicker development cycles, run =haunt serve
 --watch= to automatically rebuild the site when things change.
diff --git a/doc/haunt.texi b/doc/haunt.texi
index 6be2fb5..8df937a 100644
--- a/doc/haunt.texi
+++ b/doc/haunt.texi
@@ -299,6 +299,7 @@ programming interfaces.
 @menu
 * Invoking haunt build::        Build the website.
 * Invoking haunt serve::        Serve the website over HTTP.
+* Invoking haunt new::          Generating a blog template.
 * Invoking haunt publish::      Publish the website.
 @end menu
 
@@ -375,6 +376,25 @@ Automatically rebuild the site when source files change.
 
 @end table
 
+@node Invoking haunt new
+@section Invoking @command{haunt new}
+
+The @command{haunt new} command creates a starter template for a new website.
+
+Usage:
+
+@example
+haunt new
+@end example
+
+By default, haunt will create a directory called @file{blog}.  To use a
+different name for your new blog, simply provide the name at the
+command line as follows:
+
+@example
+haunt new my-blog
+@end example
+
 @node Invoking haunt publish
 @section Invoking @command{haunt publish}
 
diff --git a/haunt/ui.scm b/haunt/ui.scm
index a0e98c7..d512cc2 100644
--- a/haunt/ui.scm
+++ b/haunt/ui.scm
@@ -57,7 +57,7 @@
             haunt-main))
 
 (define commands
-  '("build" "publish" "serve"))
+  '("build" "new" "publish" "serve"))
 
 (define program-name (make-parameter 'haunt))
 
diff --git a/haunt/ui/new.scm b/haunt/ui/new.scm
new file mode 100644
index 0000000..7110e06
--- /dev/null
+++ b/haunt/ui/new.scm
@@ -0,0 +1,149 @@
+;;; Haunt --- Static site generator for GNU Guile
+;;; Copyright © 2024 jgart <jgart@dismail.de>
+;;;
+;;; This file is part of Haunt.
+;;;
+;;; Haunt 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.
+;;;
+;;; Haunt 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 Haunt.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Haunt new sub-command.
+;;
+;;; Code:
+
+(define-module (haunt ui new)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (haunt ui)
+  #:use-module (haunt utils)
+  #:export (haunt-new))
+
+(define (show-help)
+  (format #t "Usage: haunt new [NAME]
+Create a new Haunt project.~%")
+  (display "
+  -p, --project-dir       project directory")
+  (display "
+  -t, --title             project title")
+  (display "
+  -d, --domain            project domain")
+  (display "
+  -a, --author            project author")
+  (display "
+  -e, --email             project email")
+  (show-common-options-help)
+  (newline)
+  (display "
+  -h, --help             display this help and exit")
+  (display "
+  -V, --version          display version information and exit")
+  (newline))
+
+(define %options
+  (list (option '(#\h "help") #f #f
+		(lambda _
+		  (show-help)
+		  (exit 0)))
+	(option '(#\V "version") #f #f
+		(lambda _
+		  (show-version-and-exit "haunt new")))
+        (option '(#\p "project-dir") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'project-dir arg result)))
+        (option '(#\t "title") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'title arg result)))
+        (option '(#\d "domain") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'domain arg result)))
+        (option '(#\a "author") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'author arg result)))
+        (option '(#\e "email") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'email arg result)))))
+
+(define %default-options
+  (append '((project-dir . "blog")
+            (title . "Built with Guile")
+            (domain . "example.com")
+            (author . "Eva Luator")
+            (email . "eva@example.com"))
+          %default-common-options))
+
+(define (write-template project-dir build-file title domain author email)
+  (let ((path (string-append project-dir "/" build-file)))
+    (call-with-output-file path
+      (lambda (port)
+        (pretty-print
+         '(use-modules (haunt asset)
+		       (haunt builder blog)
+		       (haunt builder atom)
+		       (haunt builder assets)
+		       (haunt reader commonmark)
+		       (haunt site))
+         port)
+        (newline port)
+        (pretty-print
+         `(site #:title ,title
+	        #:domain ,domain
+	        #:default-metadata
+	        '((author . ,author)
+                  (email  . ,email))
+	        #:readers (list commonmark-reader)
+	        #:builders (list (blog)
+			         (atom-feed)
+			         (atom-feeds-by-tag)
+			         (static-directory "images")))
+         port)))))
+
+(define %first-post-file-name "hello.md")
+
+(define %first-post-contents
+  "title: First post!
+date: 2018-03-13 18:00
+tags: hello
+summary: hello!
+---
+
+Hello, world!
+")
+
+(define (write-first-post project-dir)
+  (let* ((first-post-file %first-post-file-name)
+	 (first-post-contents %first-post-contents)
+	 (output-path
+	  (string-append project-dir "/posts/" first-post-file)))
+    (call-with-output-file output-path
+      (lambda (port)
+	(display first-post-contents port)))))
+
+(define (build-template project-dir build-file title domain author email)
+  (mkdir-p (string-append project-dir "/images"))
+  (mkdir-p (string-append project-dir "/posts"))
+  (write-template project-dir build-file title domain author email)
+  (write-first-post project-dir)
+  (format #t "new blog was created in project directory ~a\n" project-dir))
+
+(define (haunt-new . args)
+  (let* ((opts (simple-args-fold args %options %default-options))
+         (project-dir (assq-ref opts 'project-dir))
+	 (build-file  (assq-ref opts 'config))
+         (title       (assq-ref opts 'title))
+         (domain      (assq-ref opts 'domain))
+         (author      (assq-ref opts 'author))
+         (email       (assq-ref opts 'email)))
+    (build-template project-dir build-file title domain author email)))