;; Library：多个仓库各自成为一套文档，并在 /library 页里用自定义名称切换。
;; 一个仓库只能属于 Docs 或 Library 其中一处。这些仓库不出现在首页列表。
(defmodule lamina_library
(export all))
(defun settings-key () 'library_entries)
(defun entries ()
(parse-entries (lamina_docs:decode-text (lamina_site_mgr:get (settings-key) ""))))
(defun parse-entries (text)
(lists:filtermap #'parse-entry/1 (string:split (lamina_docs:to-str text) "\n" 'all)))
(defun parse-entry (line)
(case (string:split (string:trim line) "\t" 'all)
(`(,repo-id ,branch ,name)
(let ((label (string:trim name))
(id (string:trim repo-id))
(ref (string:trim branch)))
(if (and (/= "" label) (/= "" id) (/= "" ref))
`#(true ,(entry id ref label))
'false)))
(_ 'false)))
(defun entry (repo-id branch name)
(maps:from_list
(list (tuple 'repo_id (normalize-id repo-id))
(tuple 'branch branch)
(tuple 'name name))))
(defun format-entries (entries)
(string:join
(lists:map
(lambda (item)
(string:join (list (maps:get 'repo_id item)
(maps:get 'branch item)
(maps:get 'name item))
"\t"))
entries)
"\n"))
(defun hidden-repo-ids ()
(let ((docs-id (normalize-id (lamina_docs:saved-repo-id))))
(lists:usort
(lists:filter
(lambda (id) (/= "" id))
(cons docs-id (lists:map (lambda (item) (maps:get 'repo_id item)) (entries)))))))
(defun hidden-paths ()
(lists:filtermap
(lambda (id)
(case (lamina_docs:find-repo id)
(`#(value ,repo) `#(true ,(maps:get 'path repo)))
(_ 'false)))
(hidden-repo-ids)))
(defun claims-repo? (repo-id)
(claims-repo? repo-id ""))
(defun claims-repo? (repo-id except-name)
(let ((id (normalize-id repo-id)))
(and (/= "" id)
(or (=:= id (normalize-id (lamina_docs:saved-repo-id)))
(lists:any
(lambda (item)
(and (=:= id (maps:get 'repo_id item))
(/= except-name (maps:get 'name item))))
(entries))))))
(defun find-entry (name)
(lists:search (lambda (item) (=:= name (maps:get 'name item))) (entries)))
(defun entry-prefix (item)
(lists:flatten (list "/library/" (lamina_docs:encode-segment (maps:get 'name item)))))
(defun valid-name? (name)
(let ((label (string:trim (lamina_docs:to-str name))))
(and (> (length label) 0)
(< (length label) 80)
(not (lists:member label (list "." "..")))
(lists:all #'name-char?/1 label))))
(defun name-char? (char)
(and (> char 31)
(/= char 9)
(/= char 35)
(/= char 37)
(/= char 47)
(/= char 63)
(/= char 92)))
(defun normalize-id (value)
(let ((number (lamina_docs:to-int value)))
(if (> number 0) (integer_to_list number) "")))
(defun add (repo-id branch name0)
(let ((name (chars name0))
(ref (string:trim (chars branch)))
(id (normalize-id repo-id)))
(cond
((not (valid-name? name)) `#(error "Enter a navigation name without / or %."))
((name-taken? name "") `#(error "That navigation name is already used."))
((not (lamina_docs:valid-branch? ref)) `#(error "Enter a branch name."))
((/= 'false (lamina_docs:find-repo id))
(if (claims-repo? id)
`#(error "That repository is already used by Docs or Library.")
(write (lists:append (entries) (list (entry id ref name))))))
('true `#(error "Select a repository.")))))
(defun update (old-name0 name0 branch)
(let ((old-name (chars old-name0))
(name (chars name0))
(ref (string:trim (chars branch))))
(case (find-entry old-name)
('false `#(error "That Library entry no longer exists."))
(`#(value ,current)
(cond
((not (valid-name? name)) `#(error "Enter a navigation name without / or %."))
((name-taken? name old-name) `#(error "That navigation name is already used."))
((not (lamina_docs:valid-branch? ref)) `#(error "Enter a branch name."))
('true
(write (replace-entry (entries) old-name
(entry (maps:get 'repo_id current) ref name)))))))))
(defun remove (name0)
(let ((name (chars name0)))
(case (find-entry name)
('false `#(error "That Library entry no longer exists."))
(_ (write (lists:filter (lambda (item) (/= name (maps:get 'name item))) (entries)))))))
(defun move (name0 direction)
(let ((name (chars name0)))
(case (swap (entries) name direction)
('false `#(error "That entry cannot move further."))
(updated (write updated)))))
(defun name-taken? (name except)
(lists:any
(lambda (item)
(and (=:= name (maps:get 'name item))
(/= except (maps:get 'name item))))
(entries)))
(defun replace-entry (items old-name new-item)
(lists:map
(lambda (item)
(if (=:= old-name (maps:get 'name item)) new-item item))
items))
(defun swap (items name direction)
(swap items name direction '()))
(defun swap (items name direction seen)
(case items
('() 'false)
(`(,item . ,rest)
(cond
((and (=:= "up" direction)
(=:= name (maps:get 'name item))
(/= '() seen))
(lists:append (list (lists:reverse (tl seen)) (list item (hd seen)) rest)))
((and (=:= "down" direction) (=:= name (maps:get 'name item)))
(case rest
('() 'false)
(`(,next . ,more)
(lists:append (list (lists:reverse seen) (list next item) more)))))
('true (swap rest name direction (cons item seen)))))))
(defun write (items)
(let ((stored (unicode:characters_to_binary (format-entries items))))
(case (lamina_site_mgr:set (settings-key) stored)
('ok (progn (lamina_docs:clear-cache) 'ok))
(error error))))
(defun chars (value)
(string:trim (lamina_docs:decode-text value)))