;; Fossil 仓库基础操作。
(defmodule lamina_fossil_repo
(export all))
;; 新建仓库；admin-user 为 Setup 角色用户名。
(defun init (repo-path admin-user)
(lamina_fossil:run (list "init" "-A" admin-user repo-path)))
;; 创建时可直接写入项目名称和描述，避免额外 SQL 操作。
(defun init (repo-path admin-user project-name project-description)
(lamina_fossil:run
(list "init" "-A" admin-user
"--project-name" project-name
"--project-desc" project-description
repo-path)))
;; 设置仓库用户密码（Setup 角色凭据创建/更新）。
(defun set-user-pw (repo-path username password)
(lamina_fossil:run (list "user" "password" username password "-R" repo-path)))
;; Fossil CLI 没有跨进程参数绑定接口；这里使用 SQLite 标准字符串转义，
;; SQL 作为单独的 open_port 参数传递，不经过 shell。
(defun set-description (repo-path name description)
(let ((sql (lists:flatten
(io_lib:format
"INSERT OR REPLACE INTO config(name,value) VALUES('project-name','~s'),('project-description','~s');"
(list (sql-quote name) (sql-quote description))))))
(lamina_fossil:run (list "sql" "-R" repo-path sql))))
;; 克隆远程仓库（超时放宽到 300s）。
(defun clone (remote-url repo-path admin-user)
(lamina_fossil:run
(list "clone" remote-url repo-path "--admin-user" admin-user)
(lamina_fossil:clone-timeout-ms)))
;; 从已登记的远程源同步本地仓库。
(defun sync (remote-url repo-path)
(lamina_fossil:run
(list "sync" remote-url "-R" repo-path)
(lamina_fossil:clone-timeout-ms)))
(defun info (repo-path)
(lamina_fossil:run (list "info" "-R" repo-path)))
;; 取仓库最后活动时间（字符串或 'unknown）。
;; Fossil CLI 的 timeline 把日期和时刻拆成两行，不能用 "YYYY-MM-DD HH:MM:SS" 整段匹配。
(defun last-timeline (repo-path)
(let ((path (to-str repo-path)))
(case (lamina_fossil:run
(list "sql" "-R" path
"SELECT strftime('%Y-%m-%d %H:%M',mtime,'localtime') FROM event ORDER BY mtime DESC LIMIT 1;"))
(`#(ok ,out)
(case (parse-timeline-output out)
('unknown (last-timeline-cli path))
(stamp stamp)))
(_ (last-timeline-cli path)))))
(defun last-timeline-cli (path)
(case (lamina_fossil:run (list "timeline" "-n" "1" "-R" path))
(`#(ok ,out) (parse-timeline-output out))
(_ 'unknown)))
(defun parse-timeline-output (out)
(let ((s (to-str out)))
(case (parse-inline-datetime s)
('unknown (parse-split-timeline s))
(stamp stamp))))
(defun parse-inline-datetime (s)
(case (re:run s "[0-9]{4}-[0-9]{2}-[0-9]{2} [0-9]{2}:[0-9]{2}(?::[0-9]{2})?"
(list (tuple 'capture 'first 'list)))
(`#(match (,text)) text)
(_ 'unknown)))
(defun parse-split-timeline (s)
(case (re:run s "=== ([0-9]{4}-[0-9]{2}-[0-9]{2}) ===\\s+([0-9]{2}:[0-9]{2}(?::[0-9]{2})?)"
(list (tuple 'capture 'all 'list)))
(`#(match (,_all ,date ,time)) (lists:flatten (list date " " time)))
(_ 'unknown)))
;; 应用 skin.conf（skin.conf 为 fossil configuration 导出格式）。
(defun apply-skin (repo-path skin-conf-path)
(lamina_fossil:run
(list "configuration" "import" skin-conf-path "-R" repo-path)))
;; 仓库首页改为 Files（/dir），并写入与设计图一致的主菜单。
;; index-page 在 Admin/Configuration 里，不是 fossil setting 列表中的项。
(defun configure-web (repo-path)
(let ((sql (lists:flatten
(list
"INSERT OR REPLACE INTO config(name,value,mtime) VALUES"
"('index-page','/dir?ci=tip',julianday('now')),"
"('mainmenu','Files /dir?ci=tip * {} Timeline /timeline * {} "
"Branches /brlist * {} Tags /taglist * {} Tickets /ticket * {} "
"Wiki /wiki * {} Forum /forum * {} Admin /setup s {}',julianday('now')),"
"('robot-restrict','timelineX,diff,annotate,fileage,reports,tree,hexdump,download',julianday('now'));"))))
(lamina_fossil:run (list "sql" "-R" repo-path sql))))
(defun sql-quote (value)
(string:replace (to-str value) "'" "''" 'all))
(defun to-str (value)
(cond
((is_binary value) (binary_to_list value))
((is_list value) value)
('true (lists:flatten (io_lib:format "~p" (list value))))))