;; 公开 Library。/library 打开第一条；/library/名称/文章 阅读对应仓库。
(defmodule lamina_library_pages
(export all))
(defun show (req)
(if (=:= 'true (lamina_setup:installed?))
(render req)
`#(redirect "/setup")))
(defun render (req)
(let (((tuple name article) (locate req))
(entries (lamina_library:entries)))
(cond
((=:= '() entries)
(lamina_docs_pages:html 200 (message-page req "Library" "Library has not been configured yet.")))
((and (=:= "" name) (=:= "" article))
`#(redirect ,(lamina_library:entry-prefix (hd entries))))
('true (render-entry req entries name article)))))
(defun render-entry (req entries name article)
(case (lamina_library:find-entry name)
('false
(lamina_docs_pages:html
404
(shell req entries "" "Not found"
"<article class=\"docs-body\"><h1>Page not found</h1><p>That section is not in the Library.</p></article>"
(not-found-fragment "Not found"))))
(`#(value ,entry)
(case (lamina_docs:find-repo (maps:get 'repo_id entry))
('false
(lamina_docs_pages:html
200
(shell req entries name "Library"
"<article class=\"docs-body\"><h1>Repository missing</h1><p>The repository for this section is no longer available.</p></article>"
(not-found-fragment "Library"))))
(`#(value ,repo)
(show-tree req entries entry name article repo))))))
(defun show-tree (req entries entry name article repo)
(case (lamina_docs:serve (maps:get 'path repo)
(maps:get 'branch entry)
(lamina_library:entry-prefix entry)
article)
(`#(file ,mime ,bytes)
`#(status 200
#M(#"content-type" ,(list_to_binary mime)
#"x-content-type-options" #"nosniff"
#"content-security-policy" #"default-src 'none'")
,bytes))
(`#(article ,tree ,doc)
(let ((title (maps:get 'title doc "")))
(lamina_docs_pages:html
200
(if (fragment? req)
(article-fragment title doc)
(shell req entries name title
(list (lamina_docs_pages:sidebar (maps:get 'categories tree '()) (maps:get 'path doc))
(lamina_docs_pages:article-html doc))
(article-fragment title doc))))))
('unconfigured
(lamina_docs_pages:html 200 (message-page req "Library" "Library has not been configured yet.")))
(`#(empty ,_tree)
(lamina_docs_pages:html
200
(shell req entries name name
"<article class=\"docs-body\"><h1>No articles</h1><p>This repository has no Markdown files on the selected branch.</p></article>"
(not-found-fragment name))))
(`#(not-found ,tree)
(lamina_docs_pages:html
404
(if (fragment? req)
(not-found-fragment "Not found")
(shell req entries name "Not found"
(list (lamina_docs_pages:sidebar (maps:get 'categories tree '()) "")
"<article class=\"docs-body\"><h1>Page not found</h1><p>That document is not in the selected repository.</p></article>")
(not-found-fragment "Not found")))))
(`#(error ,message)
(lamina_docs_pages:html 200 (message-page req "Library" message)))
(_
(lamina_docs_pages:html 200 (message-page req "Library" "The documentation could not be read.")))))
(defun locate (req)
(let ((path (lamina_docs:decode-url-path (decode-path (cowboy_req:path req)))))
(cond
((lists:prefix "/library/" path) (split-rest (lists:nthtail 9 path)))
('true (tuple "" "")))))
(defun split-rest (rest)
(case (string:split rest "/" 'leading)
(`(,name ,article) (tuple name article))
(`(,name) (tuple name ""))
(_ (tuple "" ""))))
(defun decode-path (path)
(case (unicode:characters_to_list path)
(`#(error ,_ ,_) (lamina_ui:to-str path))
(`#(incomplete ,_ ,_) (lamina_ui:to-str path))
(chars chars)))
(defun fragment? (req)
(=:= "fragment" (string:lowercase (lamina_ui:to-str (cowboy_req:header #"x-lamina-docs" req #"")))))
(defun message-page (req title message)
(shell req '() "" title
(list "<article class=\"docs-body\"><h1>" (lamina_ui:escape title) "</h1><p>"
(lamina_ui:escape message) "</p></article>")
""))
(defun shell (req entries current title inner _fragment)
(if (fragment? req)
(if (=:= "" _fragment) inner _fragment)
(let* ((site (lamina_site_mgr:all))
(site-name (maps:get 'site_name site "lamina"))
(session (lamina_auth:verify-request req)))
(list
(lamina_ui:public-head (lists:flatten (list title " - Library - " site-name)) "shell docs-shell")
(lamina_ui:public-nav site-name session 'library)
(lamina_ui:public-tagline (maps:get 'site_tagline site ""))
(switcher entries current)
"<main class=\"docs\">" inner "</main>"
(lamina_docs_pages:nav-script)
(lamina_ui:public-footer site)
"</div></body></html>"))))
(defun switcher (entries current)
(if (=:= '() entries)
""
(list "<nav class=\"library-nav\">"
(lists:map
(lambda (item)
(let ((name (maps:get 'name item)))
(list "<a href=\"" (lamina_ui:escape (lamina_library:entry-prefix item)) "\""
(if (=:= name current) " class=\"active\"" "")
">" (lamina_ui:escape name) "</a>")))
entries)
"</nav>")))
(defun article-fragment (title article)
(let ((site-name (maps:get 'site_name (lamina_site_mgr:all) "lamina")))
(list "<title>" (lamina_ui:escape (lists:flatten (list title " - Library - " site-name))) "</title>"
(lamina_docs_pages:article-html article))))
(defun not-found-fragment (title)
(let ((site-name (maps:get 'site_name (lamina_site_mgr:all) "lamina")))
(list "<title>" (lamina_ui:escape (lists:flatten (list title " - Library - " site-name))) "</title>"
"<article class=\"docs-body\"><h1>Page not found</h1><p>That document is not in the selected repository.</p></article>")))