Fosi Fossil Service
Small teams. Open source. Built on Fossil.

CaaS / Lamina

Unified Management for Fossil Repositories

Public | Owner: CaaS | Default branch: trunk | Last update: 2026-10-25 00:41

Artifact 45102fc822e512cc52786d38a817427cdb2315ca7c977a0ed9446a8630f469a8:


;; 公开首页:按 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"))

Clone

You can clone this repository with the following command:

fossil clone https://fosi.dev/CaaS/Lamina

Contribute

The best way to contribute is through e-mail. See the project documentation for more details.