Infrastructure as a Service / Nemoptera

Artifact 5dd1a81aebb0bfd31b1fe5e36e51440aa2b24db0367c9add79912655f6d64999:

• File src/web/nemoptera_public.lfe — part of check-in [14d905c889] at 2026-11-08 15:25:21 on branch trunk — refactor(core): 重命名项目为 Nemoptera (user: pluto size: 5358)

(defmodule nemoptera_public
  (export all))

(defun index (req)
  (if (nemoptera_setup:installed?)
      (let ((groups (nemoptera_site:public-groups))
            (logged-in? (logged-in? req)))
        (nemoptera_http:html 200
         (nemoptera_ui:render "Repositories" 'home 'public logged-in?
                             (list "<div class=\"cats\" id=\"repositories\">"
                                   (if (=:= '() groups)
                                       "<p>No repositories yet.</p>"
                                       (lists:map #'group/1 groups))
                                   "<section class=\"cat\" id=\"organizations\"></section>"
                                   "</div>"))))
      (nemoptera_http:redirect "/setup")))

(defun timeline (req)
  (if (nemoptera_setup:installed?)
      (nemoptera_http:html 200
       (nemoptera_ui:render "Timeline" 'timeline 'public (logged-in? req)
                           (list "<h1 class=\"page\">Timeline</h1>"
                                 (timeline-body (nemoptera_site:timeline-rows)))))
      (nemoptera_http:redirect "/setup")))

(defun rss (_req)
  (if (nemoptera_setup:installed?)
      (nemoptera_http:xml 200 "application/rss+xml; charset=utf-8" (rss-body))
      (nemoptera_http:redirect "/setup")))

(defun atom (_req)
  (if (nemoptera_setup:installed?)
      (nemoptera_http:xml 200 "application/atom+xml; charset=utf-8" (atom-body))
      (nemoptera_http:redirect "/setup")))

(defun group (group)
  (let ((title (maps:get 'title group ""))
        (anchor (maps:get 'anchor group ""))
        (description (maps:get 'description group ""))
        (repos (maps:get 'repos group '())))
    (list "<section class=\"cat\" id=\"" (nemoptera_ui:escape anchor) "\">"
          "<h2><a href=\"#" (nemoptera_ui:escape anchor) "\">" (nemoptera_ui:escape title) "</a></h2>"
          (if (=:= "" description)
              ""
              (list "<p class=\"blurb\">" (nemoptera_ui:escape description) "</p>"))
          (repo-line repos)
          "</section>")))

(defun repo-line (repos)
  (case repos
    ('() "<p class=\"repoline note\">No repositories yet.</p>")
    (_ (list "<p class=\"repoline\">" (join-repos repos "") "</p>"))))

(defun join-repos
  (('() acc) acc)
  (((cons repo rest) acc)
   (let ((piece (list (if (=:= "" acc) "" " ")
                      "<a href=\"" (nemoptera_ui:escape (maps:get 'url repo)) "\" target=\"_blank\" rel=\"noopener\">"
                      (nemoptera_ui:escape (maps:get 'name repo)) "</a>"
                      (let ((description (maps:get 'description repo "")))
                        (if (=:= "" description)
                            ""
                            (list "; " (nemoptera_ui:escape description)))))))
     (join-repos rest (list acc piece)))))

(defun timeline-body (rows)
  (case rows
    ('() "<p>No repositories yet.</p>")
    (_
     (list "<table><tr><th>When</th><th>Repository</th><th>Description</th></tr>"
           (lists:map
            (lambda (row)
              (let ((when (maps:get 'timeline row "")))
                (list "<tr><td>" (nemoptera_ui:escape (if (=:= "" when) "—" when)) "</td><td><a href=\""
                      (nemoptera_ui:escape (maps:get 'url row)) "\" target=\"_blank\" rel=\"noopener\">"
                      (nemoptera_ui:escape (maps:get 'name row)) "</a></td><td>"
                      (nemoptera_ui:escape (maps:get 'description row)) "</td></tr>")))
            rows)
           "</table>"))))

(defun rss-body ()
  (let ((site (nemoptera_site:all)))
    (list "<?xml version=\"1.0\" encoding=\"utf-8\"?><rss version=\"2.0\"><channel><title>"
          (nemoptera_ui:escape (maps:get 'site_name site)) "</title><link>"
          (nemoptera_ui:escape (nemoptera_site:root)) "</link><description>"
          (nemoptera_ui:escape (maps:get 'site_tagline site)) "</description>"
          (lists:map #'rss-item/1 (nemoptera_site:timeline-rows))
          "</channel></rss>")))

(defun rss-item (row)
  (list "<item><title>" (nemoptera_ui:escape (maps:get 'name row)) "</title><link>"
        (nemoptera_ui:escape (lists:flatten (list (nemoptera_site:root) (maps:get 'url row))))
        "</link><description>" (nemoptera_ui:escape (maps:get 'description row))
        "</description></item>"))

(defun atom-body ()
  (let ((site (nemoptera_site:all))
        (root (nemoptera_site:root)))
    (list "<?xml version=\"1.0\" encoding=\"utf-8\"?><feed xmlns=\"http://www.w3.org/2005/Atom\"><title>"
          (nemoptera_ui:escape (maps:get 'site_name site)) "</title><link href=\""
          (nemoptera_ui:escape root) "\"/><id>" (nemoptera_ui:escape root) "</id><updated>"
          (nemoptera_text:now-iso) "</updated>"
          (lists:map (lambda (row) (atom-item root row)) (nemoptera_site:timeline-rows))
          "</feed>")))

(defun atom-item (root row)
  (let ((href (lists:flatten (list root (maps:get 'url row)))))
    (list "<entry><title>" (nemoptera_ui:escape (maps:get 'name row)) "</title><link href=\""
          (nemoptera_ui:escape href) "\"/><id>" (nemoptera_ui:escape href) "</id><updated>"
          (nemoptera_text:now-iso) "</updated><summary>"
          (nemoptera_ui:escape (maps:get 'description row)) "</summary></entry>")))

(defun logged-in? (req)
  (case (nemoptera_auth:verify-request req)
    (`#(ok ,_) 'true)
    (_ 'false)))