;; 公开首页:按 project / organization 分组展示仓库,版式按 docs/参考图.png。
(defmodule lamina_pages
(export all))
(defun index (req)
(if (=:= 'true (lamina_setup:installed?))
(let* ((data (lamina_site_mgr:public-index))
(site (maps:get 'site data #M()))
(groups (maps:get 'groups data '()))
(site-name (maps:get 'site_name site "lamina"))
(description (maps:get 'site_description site
"Open source projects and tools powered by Fossil."))
(tagline (maps:get 'site_tagline site
"Small teams. Open source. Built on Fossil.")))
(lamina_ui:html 200 (page site-name description tagline groups site
(lamina_auth:verify-request req))))
`#(redirect "/setup")))
(defun page (site-name description tagline groups site session)
(let ((root (lamina_ui:trim-right-slash (maps:get 'site_url site "http://localhost:8827"))))
(lists:flatten
(list
(lamina_ui:public-head (lists:flatten (list site-name " · Explore")))
(lamina_ui:public-nav site-name session 'explore)
(lamina_ui:public-tagline tagline)
"<main><section class=\"hero\"><h1>" (lamina_ui:escape site-name)
" public repositories</h1><p class=\"lede\">" (lamina_ui:escape description) "</p></section>"
(groups-html groups)
(contribute-html groups root site)
"</main>"
(lamina_ui:public-footer site)
"</div></body></html>"))))
(defun groups-html (groups)
(if (=:= '() groups)
"<section class=\"section empty\"><h2>Repositories</h2><p>Repositories will appear here when they are created.</p></section>"
(list "<section class=\"section\"><h2>Repositories</h2><div class=\"table-wrap\"><table><thead><tr><th>Name</th><th>Description</th><th>Last update</th></tr></thead><tbody>"
(lists:map #'group-html/1 groups)
"</tbody></table></div></section>")))
(defun group-html (group)
(let ((title (maps:get 'title group "project"))
(repos (maps:get 'repos group '())))
(list "<tr class=\"group-row\"><td colspan=\"3\">" (lamina_ui:escape title) "</td></tr>"
(lists:map #'repo-html/1 repos))))
(defun repo-html (repo)
(let ((display (maps:get 'display_name repo ""))
(name (maps:get 'name repo ""))
(description (maps:get 'description repo ""))
(url (maps:get 'url repo ""))
(last (maps:get 'last_timeline repo "No activity yet")))
(let ((label (if (=:= "" (lamina_ui:to-str display)) name display)))
(list "<tr><td><a class=\"repo\" href=\"" (lamina_ui:escape url)
"\" target=\"_blank\" rel=\"noopener\">" (lamina_ui:escape label)
"</a></td><td>" (lamina_ui:escape description) "</td><td>"
(lamina_ui:escape last) "</td></tr>"))))
(defun contribute-html (groups root site)
(let* ((example (first-repo groups))
(clone-url (case example
('none (lists:flatten (list (lamina_ui:trim-right-slash root) "/repository")))
(repo (lists:flatten (list (lamina_ui:trim-right-slash root) (maps:get 'url repo))))))
(contact (lamina_ui:to-str (maps:get 'footer_contact_url site ""))))
(list
"<section class=\"section contribute\"><h2>Contribute</h2>"
"<p>The best way to contribute to our projects is through Fossil patches or e-mail. Send patches, ideas or improvements - we are always happy to hear from you.</p>"
"<p>To get started, you can clone any repository using the Fossil command-line tool:</p>"
(lamina_ui:clone-box (lists:flatten (list "fossil clone " clone-url)))
"<p>Our public repositories may also be mirrored on other platforms for easier access.</p>"
(if (=:= "" contact)
"<p class=\"hint\">Questions or patches are welcome.</p>"
(list "<p>Questions or patches: <a href=\"" (lamina_ui:escape contact) "\">"
(lamina_ui:escape contact) "</a></p>"))
"</section>")))
(defun first-repo (groups)
(case groups
('() 'none)
(`(,group . ,rest)
(case (maps:get 'repos group '())
('() (first-repo rest))
(`(,repo . ,_) repo)))))
(defun not_found (_req)
(lamina_ui:html 404 #"not found"))