;; Setup 安装向导页面(GET /setup, POST /setup/step/:n)
(defmodule lamina_setup_pages
(export all))
(defun steps ()
(list "Welcome" "Site Settings" "Database" "Storage" "Admin Account" "Finish"))
(defun show (req)
(if (=:= 'true (lamina_setup:installed?))
(redirect "/login")
(render-step (lamina_setup:current-step) req "")))
;; POST /setup/step/:n —— n 为刚提交的步骤号
(defun step (req)
(if (=:= 'true (lamina_setup:installed?))
(redirect "/login")
(let ((n (step-number (maps:get 'bindings req))))
(handle-step n (maps:get 'params req #M()) req))))
(defun step-number (bindings)
(let ((v (case (maps:find 'n bindings)
(`#(ok ,x) x)
('error
(case (maps:find #"n" bindings)
(`#(ok ,x) x)
('error "1"))))))
(case (catch (list_to_integer (if (is_binary v) (binary_to_list v) v)))
(`#(EXIT ,_) 1)
(n n))))
(defun handle-step (n params req)
(let ((state (lamina_setup:get-state)))
(let ((result
(case n
(1 (if (lamina_setup:all-ok? (lamina_setup:check-env))
(progn (lamina_setup:advance state 2) 'ok)
`#(error "环境检测未通过,请修复失败项后再继续")))
(2 (lamina_setup:save-site state params))
(3 (lamina_setup:save-db state params))
(4 (lamina_setup:save-storage state params))
(5 (lamina_setup:save-admin state params))
(6 (lamina_setup:finalize state))
(_ `#(error "未知步骤")))))
(if (=:= 'ok result)
(case n
;; 第 6 步完成后进入登录页(M3 实现,暂由公开首页代替提示)
(6 (redirect "/"))
(_ (render-step (lamina_setup:current-step) req "")))
(render-step (lamina_setup:current-step) req
(case result
(`#(error ,msg) msg)
(_ "未知错误")))))))
;;---- 渲染 ----
(defun render-step (step req err)
(let ((body (step-body step req)))
(html 200 (page step err body))))
(defun step-body (step req)
(case step
(1 (render-welcome))
(2 (render-site))
(3 (render-db))
(4 (render-storage))
(5 (render-admin))
(6 (render-finish req))))
(defun heading (n name)
(concat-strings
(list "<h1>Setup</h1><p class=\"kicker\">Step " (integer_to_list n)
" of 6 - " name "</p>")))
(defun render-welcome ()
(concat-strings
(list
(heading 1 "Welcome")
"<p>This wizard will help you set up lamina, a simple code hosting platform for small teams, built on Fossil SCM.</p>"
"<p>You will be guided through a few basic configuration steps.</p>"
"<hr><h2>License</h2>"
"<p>lamina is open source software, released under the <a href=\"https://opensource.org/licenses/MIT\">MIT License</a>.</p>"
"<hr><h2>Prerequisites</h2>"
"<p>Before you begin, please make sure the following requirements are met:</p>"
"<ul class=\"check\">"
(checks-html (lamina_setup:check-env))
"</ul>"
(next-button))))
(defun checks-html (checks)
(string:join
(lists:map
(lambda (c)
(concat-strings
(list "<li class=\"" (if (maps:get 'ok c) "ok" "fail") "\">"
(if (maps:get 'ok c) "Pass" "Fail")
" - <b>" (escape (maps:get 'name c)) "</b>: " (escape (maps:get 'detail c))
"</li>")))
checks)
""))
(defun render-site ()
(concat-strings
(list
(heading 2 "Site Settings")
"<p>These values appear on the public site, login page, and repository skin.</p>"
(field "site_name" "Site name" "lamina")
(field "site_url" "Site URL" "http://localhost:8827")
(next-button))))
(defun render-db ()
(concat-strings
(list
(heading 3 "Database")
"<p>SQLite3 database file path. The directory will be created if it does not exist.</p>"
(field "db_path" "Database path" "data/lamina.db")
(next-button))))
(defun render-storage ()
(concat-strings
(list
(heading 4 "Storage")
"<p>Directory used to store Fossil repository files.</p>"
(field "repo_dir" "Repository directory" "data/repos")
(next-button))))
(defun render-admin ()
(concat-strings
(list
(heading 5 "Admin Account")
"<p>Create the single administrator account for this site.</p>"
(field "username" "Username" "admin")
(password-field "password" "Password (at least 8 characters)")
(password-field "password2" "Confirm password")
(next-button))))
(defun render-finish (_req)
(let ((s (lamina_setup:get-state)))
(concat-strings
(list
(heading 6 "Finish")
"<p>Review the configuration, then write files, generate the secret key, and create the admin account.</p>"
"<hr><h2>Summary</h2><ul class=\"check\">"
"<li>Site name: " (escape (maps:get 'site_name s "")) "</li>"
"<li>Site URL: " (escape (maps:get 'site_url s "")) "</li>"
"<li>Database: " (escape (maps:get 'db_path s "")) "</li>"
"<li>Repository directory: " (escape (maps:get 'repo_dir s "")) "</li>"
"<li>Administrator: " (escape (maps:get 'username s "")) "</li>"
"</ul>"
(next-button)))))
;;---- HTML 片段 ----
(defun field (name label default)
(concat-strings
(list "<label>" (escape label) "<input type=\"text\" name=\""
(escape name) "\" value=\"" (escape default) "\"></label>")))
(defun password-field (name label)
(concat-strings
(list "<label>" label "<input type=\"password\" name=\"" name "\"></label>")))
(defun next-button ()
"<button class=\"btn\" type=\"submit\">Next -></button>")
(defun page (step err body)
(concat-strings
(list
"<!DOCTYPE html><html lang=\"en\"><head><meta charset=\"utf-8\">"
"<meta name=\"color-scheme\" content=\"light only\">"
"<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">"
"<title>Setup · lamina</title><style>" (lamina_ui:setup-css) "</style></head><body>"
"<div class=\"shell\"><div class=\"top\"><div><a class=\"brand\" href=\"/setup\">lamina</a>"
"<p class=\"tag\">Simple code hosting for small teams</p></div></div>"
"<div class=\"wrap\"><nav class=\"steps\">" (steps-html step) "</nav>"
"<div class=\"main\">"
(if (=:= "" err) "" (list "<div class=\"err\">" (escape err) "</div>"))
"<form method=\"POST\" action=\"/setup/step/" (integer_to_list step) "\">"
body
"</form></div></div>"
"<div class=\"foot\"><span>lamina v0.1.0</span><nav>"
"<a href=\"https://fossil-scm.org/home/doc/trunk/www/index.wiki\">Documentation</a>"
"<a href=\"https://fossil-scm.org\">Source</a></nav></div></div></body></html>")))
(defun steps-html (cur)
(string:join
(lists:map
(lambda (i)
(let ((name (lists:nth i (steps))))
(concat-strings
(list "<div" (if (=:= i cur) " class=\"cur\"" "") ">"
(integer_to_list i) ". " name "</div>"))))
(lists:seq 1 6))
""))
;;---- helpers ----
(defun redirect (path)
`#(redirect ,path))
(defun html (code body)
`#(status ,code #M(#"content-type" #"text/html; charset=utf-8") ,(list_to_binary body)))
(defun concat-strings (parts)
(lists:flatten parts))
(defun to-str (value)
(cond
((is_binary value) (binary_to_list value))
((is_list value) value)
('true (lists:flatten (io_lib:format "~p" (list value))))))
(defun escape (value)
(let ((s (to-str value)))
(string:replace
(string:replace
(string:replace
(string:replace
(string:replace s "&" "&" 'all)
"<" "<" 'all)
">" ">" 'all)
"\"" """ 'all)
"'" "'" 'all)))