;; 后台管理 Library:每个仓库一条文档,并填写导航名称。
(defmodule lamina_library_admin
(export all))
(defun show (req)
(page req (param req "repo_id") ""))
(defun save (req)
(if (not (lamina_admin_pages:csrf-valid? req))
(lamina_admin_pages:html 403 "CSRF token 无效")
(let ((action (param req "action")))
(case (run action req)
('ok (page req "" (done-message action)))
(`#(error ,message) (page req (param req "repo_id") message))
(_ (page req (param req "repo_id") "Could not update the Library."))))))
(defun run (action req)
(case action
("add" (lamina_library:add (param req "repo_id") (param req "branch") (param req "name")))
("save" (lamina_library:update (param req "old_name") (param req "name") (param req "branch")))
("remove" (lamina_library:remove (param req "name")))
("up" (lamina_library:move (param req "name") "up"))
("down" (lamina_library:move (param req "name") "down"))
(_ `#(error "Unknown action."))))
(defun done-message (action)
(case action
("remove" "Library entry removed.")
("up" "Library order saved.")
("down" "Library order saved.")
(_ "Library saved.")))
(defun page (req picked message)
(let ((repos (lamina_docs:list-repos))
(entries (lamina_library:entries)))
(lamina_admin_pages:html
200
(lamina_admin_pages:layout
(lamina_admin_pages:current-username req)
"Library"
(lamina_docs:encode-html (body req repos entries picked message))))))
(defun body (req repos entries picked message)
(let ((available (available-repos repos))
(public (lists:flatten (list (lamina_site_mgr:site-url) "/library"))))
(list
"<div class=\"settings-page library-page\"><div class=\"topline\"><div><h1>Library</h1>"
"<p class=\"lede\">Add a repository on the left. Entries already in the Library stay in the list on the right.</p>"
"<p class=\"hint\">Public page: <a href=\"/library\">" (lamina_ui:escape public) "</a></p></div></div>"
(if (=:= "" message) "" (list "<div class=\"notice\">" (lamina_ui:escape message) "</div>"))
"<div class=\"library-split\">"
(add-html req available picked)
(entries-html req repos entries)
"</div></div>")))
(defun entries-html (req repos entries)
(list "<section class=\"library-list\"><div class=\"library-head\"><h2>Entries</h2>"
"<span class=\"hint\">" (count-label entries) "</span></div>"
(if (=:= '() entries)
"<div class=\"tablebox\"><p class=\"hint library-empty\">No repositories yet.</p></div>"
(list "<div class=\"tablebox\"><table class=\"library-table\"><thead><tr>"
"<th>Navigation name</th><th>Repository</th><th>Address</th><th>Branch</th><th>Order</th><th></th>"
"</tr></thead><tbody>"
(entry-rows repos entries entries 0)
"</tbody></table></div>"
(entry-forms req entries 0)))
"</section>"))
(defun count-label (entries)
(let ((n (length entries)))
(if (=:= 1 n)
"1 entry"
(lists:flatten (list (integer_to_list n) " entries")))))
(defun entry-rows (repos items entries index)
(case items
('() '())
(`(,item . ,rest)
(cons (entry-row repos item entries index)
(entry-rows repos rest entries (+ index 1))))))
(defun entry-row (repos item entries index)
(let ((name (maps:get 'name item))
(repo (find-listed repos (maps:get 'repo_id item)))
(save-id (form-id "save" index)))
(list "<tr>"
(if (=:= 'none repo)
(list "<td class=\"library-name library-miss\">Missing repository</td>"
"<td class=\"library-repo\">" (lamina_ui:escape (maps:get 'repo_id item)) "</td>"
"<td class=\"library-address\"></td><td class=\"library-branch\"></td><td class=\"library-order\"></td>")
(list "<td class=\"library-name\"><input form=\"" save-id "\" name=\"name\" value=\"" (lamina_ui:escape name) "\"></td>"
"<td class=\"library-repo\"><a class=\"library-repo\" href=\"" (lamina_ui:escape (repo-href repo)) "\">"
(lamina_ui:escape (lamina_docs:repo-label repo)) "</a></td>"
"<td class=\"library-address\">" (repo-facts repo (maps:get 'branch item)) "</td>"
"<td class=\"library-branch\">" (branch-control repo (maps:get 'branch item) save-id) "</td>"
"<td class=\"library-order\"><span class=\"library-ops\">"
(order-button "up" index "Up" (not (first? item entries)))
(order-button "down" index "Down" (not (last? item entries)))
"</span></td>"))
"<td class=\"library-actions\"><span class=\"library-ops\">"
(if (=:= 'none repo)
""
(list "<button class=\"btn\" type=\"submit\" form=\"" save-id "\">Save</button>"))
"<button class=\"btn secondary\" type=\"submit\" form=\"" (form-id "remove" index) "\">Remove</button>"
"</span></td></tr>")))
(defun entry-forms (req entries index)
(case entries
('() '())
(`(,item . ,rest)
(cons (entry-form-set req item index)
(entry-forms req rest (+ index 1))))))
(defun entry-form-set (req item index)
(let ((name (maps:get 'name item)))
(list (hidden-form req (form-id "save" index) "save" name)
(hidden-form req (form-id "up" index) "up" name)
(hidden-form req (form-id "down" index) "down" name)
(hidden-form req (form-id "remove" index) "remove" name))))
(defun hidden-form (req id action name)
(list "<form id=\"" id "\" method=\"POST\" action=\"/admin/library\">"
(lamina_admin_pages:csrf-field req)
"<input type=\"hidden\" name=\"action\" value=\"" action "\">"
(if (=:= "save" action)
(list "<input type=\"hidden\" name=\"old_name\" value=\"" (lamina_ui:escape name) "\">")
(list "<input type=\"hidden\" name=\"name\" value=\"" (lamina_ui:escape name) "\">"))
"</form>"))
(defun form-id (action index)
(lists:flatten (list "lib-" action "-" (integer_to_list index))))
(defun order-button (action index label show)
(if show
(list "<button class=\"btn secondary\" type=\"submit\" form=\"" (form-id action index) "\">" label "</button>")
""))
(defun repo-href (repo)
(lamina_site_mgr:repo-base-url (maps:get 'org repo "") (maps:get 'name repo)))
(defun repo-facts (repo branch)
(let ((href (repo-href repo))
(path (maps:get 'path repo)))
(list "<div class=\"library-meta\"><a class=\"library-addr\" title=\"" (lamina_ui:escape href) "\" href=\"" (lamina_ui:escape href) "\">"
(lamina_ui:escape href) "</a><span class=\"library-facts\">"
(fact "Size" (lamina_docs:format-bytes (lamina_docs:file-size path)))
(fact "Articles" (article-count path branch))
(fact "Timeline" (integer_to_list (lamina_docs:timeline-count path)))
"</span></div>")))
(defun fact (label value)
(list "<span><b>" label "</b>" (lamina_ui:escape value) "</span>"))
(defun article-count (path branch)
(case (lamina_docs:list-files path branch)
(`#(ok ,files) (integer_to_list (maps:get 'articles (lamina_docs:doc-counts files) 0)))
(_ "-")))
(defun add-html (req available picked)
(let ((repo (find-listed available picked)))
(list "<section class=\"settings-card library-add\"><h2>Add an entry</h2>"
(if (=:= '() available)
"<p class=\"hint\">Every repository is already used by Docs or Library.</p>"
(list "<form method=\"GET\" action=\"/admin/library\">"
"<label>Repository<select name=\"repo_id\" onchange=\"this.form.submit()\">"
"<option value=\"\">Select a repository</option>"
(lists:map (lambda (item) (repo-option item picked)) available)
"</select></label></form>"
(if (=:= 'none repo)
"<p class=\"hint\">Choose a repository to load its branches.</p>"
(list "<form method=\"POST\" action=\"/admin/library\">"
(lamina_admin_pages:csrf-field req)
"<input type=\"hidden\" name=\"action\" value=\"add\">"
"<input type=\"hidden\" name=\"repo_id\" value=\""
(lamina_ui:escape (integer_to_list (maps:get 'id repo))) "\">"
"<label>Navigation name<input name=\"name\" value=\"\"></label>"
"<label>Branch" (branch-control repo "trunk" "") "</label>"
"<div class=\"settings-actions\"><button class=\"btn\" type=\"submit\">Add</button></div>"
"</form>"))))
"</section>")))
(defun branch-control (repo selected form-id)
(let ((names (branch-names repo selected))
(form (if (=:= "" form-id) "" (list " form=\"" form-id "\""))))
(if (=:= '() names)
(list "<input name=\"branch\"" form " value=\"" (lamina_ui:escape selected) "\">")
(list "<select name=\"branch\"" form ">"
(lists:map (lambda (name) (branch-option name selected)) names)
"</select>"))))
(defun branch-names (repo selected)
(let ((names (lamina_docs:branches (maps:get 'path repo))))
(if (lists:member selected names)
names
(if (=:= "" selected) names (lists:append names (list selected))))))
(defun branch-option (name selected)
(list "<option" (if (=:= name selected) " selected" "") ">" (lamina_ui:escape name) "</option>"))
(defun repo-option (repo picked)
(let ((id (integer_to_list (maps:get 'id repo))))
(list "<option value=\"" id "\""
(if (=:= id picked) " selected" "")
">" (lamina_ui:escape (lamina_docs:repo-label repo)) "</option>")))
(defun available-repos (repos)
(lists:filter
(lambda (repo) (not (lamina_library:claims-repo? (maps:get 'id repo))))
repos))
(defun find-listed (repos id)
(let ((wanted (lamina_library:normalize-id id)))
(case (lists:search
(lambda (repo) (=:= wanted (lamina_library:normalize-id (maps:get 'id repo))))
repos)
(`#(value ,repo) repo)
(_ 'none))))
(defun first? (item entries)
(=:= (maps:get 'name item) (maps:get 'name (hd entries))))
(defun last? (item entries)
(=:= (maps:get 'name item) (maps:get 'name (lists:last entries))))
(defun param (req name)
(let ((params (maps:get 'params req #M()))
(key (list_to_binary name)))
(case (maps:find key params)
(`#(ok ,value) (lamina_ui:to-str value))
(_
(case (lists:keyfind key 1 (cowboy_req:parse_qs req))
(`#(,_ ,value) (lamina_ui:to-str value))
(_ ""))))))