; lib/gitea/issues.sx — sx-gitea Phase 4: issues.
;
; An issue is a kv record: number, title, author, state, label/assignee
; sets, a Markdown body, and a comment thread (each comment is Markdown
; too). The Markdown is the stored source of truth; lib/content turns it
; into a block document (content/from-markdown) and renders HTML
; (content/html) — content-on-sx's round-trip law keeps the two views of
; the same body honest.
;
; The issue graph (issue->repo, author, assignees, labels, commenters) is
; DERIVED from the records into lib/relations facts — like the acl db in
; access.sx, the relations db is rebuilt (cached on fact equality) rather
; than maintained incrementally, so deleting a repo can never leave
; dangling edges.
;
; Requires: lib/gitea/{repo,access,web}.sx and their stacks, plus
; lib/relations/{schema,engine,api}.sx and the content stack
; (lib/smalltalk/* + lib/content/{block,doc,render,api,meta,text,section,
; table,markdown,md-import}.sx) with content bootstrapped:
;   (st-bootstrap-classes!) (content/bootstrap!)
;   (content-bootstrap-markdown!) (content-bootstrap-table!)

; ── numbering / keys ─────────────────────────────────────────────────
; keys carry zero-padded numbers so lexicographic kv order = issue order

(define
  gitea/pad8
  (fn
    (n)
    (let
      ((s (str n)))
      (str
        (substr "00000000" 0 (- 8 (string-length s)))
        s))))

(define
  gitea/digits-loop
  (fn
    (s i)
    (if
      (>= i (string-length s))
      true
      (let
        ((c (char-code (char-at s i))))
        (if
          (and (>= c 48) (<= c 57))
          (gitea/digits-loop s (+ i 1))
          false)))))

(define
  gitea/digits?
  (fn
    (s)
    (and
      (string? s)
      (> (string-length s) 0)
      (gitea/digits-loop s 0))))

(define
  gitea/issue-key
  (fn (owner name n) (str "gitea/issue/" owner "/" name "/" (gitea/pad8 n))))

(define
  gitea/issue-seq-key
  (fn (owner name) (str "gitea/issue-seq/" owner "/" name)))

(define
  gitea/issue-next!
  (fn
    (forge owner name)
    (let
      ((k (gitea/issue-seq-key owner name)))
      (let
        ((n (+ 1 (or (persist/kv-get (gitea/forge-db forge) k) 0))))
        (begin (persist/kv-put (gitea/forge-db forge) k n) n)))))

; ── sorted-set helpers ───────────────────────────────────────────────

(define
  gitea/set-add
  (fn
    (xs x)
    (artdag/sort-strings (cons x (filter (fn (e) (not (= e x))) xs)))))

(define gitea/set-remove (fn (xs x) (filter (fn (e) (not (= e x))) xs)))

; ── issue CRUD ───────────────────────────────────────────────────────

(define
  gitea/issue-create!
  (fn
    (forge owner name author title body opts)
    (cond
      ((not (gitea/repo-exists? forge owner name)) {:error "no-such-repo"})
      ((not (gitea/owner-exists? forge author)) {:error "no-such-user"})
      ((or (not (string? title)) (= title "")) {:error "empty-title"})
      (else
        (let
          ((o (or opts {})))
          (let
            ((n (gitea/issue-next! forge owner name)))
            (let
              ((rec {:state "open" :comments (list) :title title :body (or body "") :number n :author author :created-at (or (get o :created-at) 0) :assignees (artdag/sort-strings (or (get o :assignees) (list))) :labels (artdag/sort-strings (or (get o :labels) (list)))}))
              (begin
                (persist/kv-put
                  (gitea/forge-db forge)
                  (gitea/issue-key owner name n)
                  rec)
                rec))))))))

(define
  gitea/issue-get
  (fn
    (forge owner name n)
    (persist/kv-get (gitea/forge-db forge) (gitea/issue-key owner name n))))

(define
  gitea/issues
  (fn
    (forge owner name)
    (map
      (fn (s) (parse-int s))
      (gitea/names-under forge (str "gitea/issue/" owner "/" name "/")))))

(define
  gitea/issue-records
  (fn
    (forge owner name)
    (map
      (fn (n) (gitea/issue-get forge owner name n))
      (gitea/issues forge owner name))))

(define
  gitea/issue-update!
  (fn
    (forge owner name n f)
    (let
      ((rec (gitea/issue-get forge owner name n)))
      (if
        (nil? rec)
        nil
        (persist/kv-put
          (gitea/forge-db forge)
          (gitea/issue-key owner name n)
          (f rec))))))

(define
  gitea/issue-close!
  (fn
    (forge owner name n)
    (gitea/issue-update!
      forge
      owner
      name
      n
      (fn (r) (assoc r :state "closed")))))

(define
  gitea/issue-reopen!
  (fn
    (forge owner name n)
    (gitea/issue-update!
      forge
      owner
      name
      n
      (fn (r) (assoc r :state "open")))))

(define
  gitea/issue-comment!
  (fn
    (forge owner name n author body opts)
    (cond
      ((not (gitea/owner-exists? forge author)) {:error "no-such-user"})
      ((nil? (gitea/issue-get forge owner name n)) {:error "no-such-issue"})
      (else
        (let
          ((comment {:body (or body "") :at (or (get (or opts {}) :at) 0) :author author}))
          (begin
            (gitea/issue-update!
              forge
              owner
              name
              n
              (fn
                (r)
                (assoc
                  r
                  :comments (append (get r :comments) (list comment)))))
            comment))))))

; ── labels / assignees ───────────────────────────────────────────────

(define
  gitea/issue-label!
  (fn
    (forge owner name n label)
    (if
      (or (not (string? label)) (= label ""))
      {:error "invalid-label"}
      (gitea/issue-update!
        forge
        owner
        name
        n
        (fn (r) (assoc r :labels (gitea/set-add (get r :labels) label)))))))

(define
  gitea/issue-unlabel!
  (fn
    (forge owner name n label)
    (gitea/issue-update!
      forge
      owner
      name
      n
      (fn (r) (assoc r :labels (gitea/set-remove (get r :labels) label))))))

(define
  gitea/issue-assign!
  (fn
    (forge owner name n user)
    (if
      (not (gitea/owner-exists? forge user))
      {:error "no-such-user"}
      (gitea/issue-update!
        forge
        owner
        name
        n
        (fn
          (r)
          (assoc r :assignees (gitea/set-add (get r :assignees) user)))))))

(define
  gitea/issue-unassign!
  (fn
    (forge owner name n user)
    (gitea/issue-update!
      forge
      owner
      name
      n
      (fn
        (r)
        (assoc r :assignees (gitea/set-remove (get r :assignees) user))))))

; ── views over the records ───────────────────────────────────────────

(define
  gitea/issues-open
  (fn
    (forge owner name)
    (filter
      (fn (r) (= (get r :state) "open"))
      (gitea/issue-records forge owner name))))

(define
  gitea/issues-closed
  (fn
    (forge owner name)
    (filter
      (fn (r) (= (get r :state) "closed"))
      (gitea/issue-records forge owner name))))

(define
  gitea/issues-with-label
  (fn
    (forge owner name label)
    (filter
      (fn (r) (contains? (get r :labels) label))
      (gitea/issue-records forge owner name))))

(define
  gitea/issues-assigned
  (fn
    (forge owner name user)
    (filter
      (fn (r) (contains? (get r :assignees) user))
      (gitea/issue-records forge owner name))))

; ── content documents ────────────────────────────────────────────────

(define gitea/md-doc (fn (md id) (content/from-markdown (or md "") id)))

(define gitea/md-html (fn (md id) (content/html (gitea/md-doc md id))))

(define
  gitea/issue-doc
  (fn
    (owner name issue)
    (gitea/md-doc
      (get issue :body)
      (str "issue-" owner "-" name "-" (get issue :number)))))

(define
  gitea/issue-html
  (fn (owner name issue) (content/html (gitea/issue-doc owner name issue))))

; ── relations graph (derived) ────────────────────────────────────────

(define gitea/user-node (fn (user) (str "user:" user)))
(define gitea/repo-node (fn (owner name) (str "repo:" owner "/" name)))
(define
  gitea/issue-node
  (fn (owner name n) (str "issue:" owner "/" name "#" n)))
(define
  gitea/label-node
  (fn (owner name label) (str "label:" owner "/" name "/" label)))

(define
  gitea/rel-facts
  (fn
    (forge)
    (let
      ((facts (list)))
      (begin
        (for-each
          (fn
            (full)
            (let
              ((p (gitea/split-full full)))
              (let
                ((owner (get p :owner)) (name (get p :name)))
                (for-each
                  (fn
                    (rec)
                    (let
                      ((inode (gitea/issue-node owner name (get rec :number))))
                      (begin
                        (append!
                          facts
                          (relations-rel
                            inode
                            (gitea/repo-node owner name)
                            (quote parent)))
                        (append!
                          facts
                          (relations-rel
                            inode
                            (gitea/user-node (get rec :author))
                            (quote origin)))
                        (for-each
                          (fn
                            (a)
                            (append!
                              facts
                              (relations-rel
                                (gitea/user-node a)
                                inode
                                (quote member))))
                          (get rec :assignees))
                        (for-each
                          (fn
                            (l)
                            (append!
                              facts
                              (relations-rel
                                inode
                                (gitea/label-node owner name l)
                                (quote link))))
                          (get rec :labels))
                        (for-each
                          (fn
                            (c)
                            (append!
                              facts
                              (relations-rel
                                (gitea/user-node (get c :author))
                                inode
                                (quote reply))))
                          (get rec :comments)))))
                  (gitea/issue-records forge owner name)))))
          (gitea/repos forge))
        facts))))

; rebuild only when the derived facts changed (cache in the forge handle)
(define
  gitea/rels-db
  (fn
    (forge)
    (let
      ((facts (gitea/rel-facts forge)) (cache (get forge :cache)))
      (if
        (and cache (= (get cache "rel-facts") facts) (get cache "rels-db"))
        (get cache "rels-db")
        (let
          ((db (relations-build-db facts)))
          (begin
            (if
              cache
              (begin
                (dict-set! cache "rel-facts" facts)
                (dict-set! cache "rels-db" db))
              nil)
            db))))))

; issues of a repo, by graph (sorted issue node ids)
(define
  gitea/repo-issue-nodes
  (fn
    (forge owner name)
    (artdag/sort-strings
      (relations-parents-of
        (gitea/rels-db forge)
        (gitea/repo-node owner name)
        (quote parent)))))

; issues a user authored
(define
  gitea/user-authored
  (fn
    (forge user)
    (artdag/sort-strings
      (relations-parents-of
        (gitea/rels-db forge)
        (gitea/user-node user)
        (quote origin)))))

; issues assigned to a user
(define
  gitea/user-assigned
  (fn
    (forge user)
    (artdag/sort-strings
      (relations-children-of
        (gitea/rels-db forge)
        (gitea/user-node user)
        (quote member)))))

; issues carrying a label
(define
  gitea/label-issues
  (fn
    (forge owner name label)
    (artdag/sort-strings
      (relations-parents-of
        (gitea/rels-db forge)
        (gitea/label-node owner name label)
        (quote link)))))

; everyone touching an issue: author + assignees + commenters
(define
  gitea/issue-participants
  (fn
    (forge owner name n)
    (let
      ((inode (gitea/issue-node owner name n)) (db (gitea/rels-db forge)))
      (artdag/sort-strings
        (relations-dedup
          (concat
            (relations-children-of db inode (quote origin))
            (concat
              (relations-parents-of db inode (quote member))
              (relations-parents-of db inode (quote reply)))))))))

; ── web ──────────────────────────────────────────────────────────────

(define
  gitea/w-issue-n
  (fn
    (req)
    (let
      ((s (dream-param req "n")))
      (if (gitea/digits? s) (parse-int s) nil))))

(define
  gitea/w-issue-item
  (fn
    (owner name r)
    (str
      "<li class=\""
      (get r :state)
      "\"><a href=\"/"
      owner
      "/"
      name
      "/issues/"
      (get r :number)
      "\">#"
      (get r :number)
      " "
      (dream-escape (get r :title))
      "</a> ["
      (get r :state)
      "]</li>")))

(define
  gitea/w-issues-page
  (fn
    (forge req)
    (let
      ((owner (dream-param req "owner")) (name (dream-param req "name")))
      (if
        (not (gitea/w-readable? forge req owner name))
        (dream-not-found)
        (gitea/w-page
          (str owner "/" name " issues")
          (str
            "<h1>Issues</h1><ul>"
            (join
              ""
              (map
                (fn (r) (gitea/w-issue-item owner name r))
                (gitea/issue-records forge owner name)))
            "</ul>"))))))

(define
  gitea/w-comment-html
  (fn
    (owner name n i c)
    (str
      "<div class=\"comment\"><p class=\"author\">"
      (dream-escape (get c :author))
      "</p>"
      (gitea/md-html (get c :body) (str "c-" owner "-" name "-" n "-" i))
      "</div>")))

(define
  gitea/w-issue-page
  (fn
    (forge req)
    (let
      ((owner (dream-param req "owner"))
        (name (dream-param req "name"))
        (n (gitea/w-issue-n req)))
      (if
        (or (nil? n) (not (gitea/w-readable? forge req owner name)))
        (dream-not-found)
        (let
          ((rec (gitea/issue-get forge owner name n)))
          (if
            (nil? rec)
            (dream-not-found)
            (gitea/w-page
              (str "#" n " " (get rec :title))
              (str
                "<h1>#"
                n
                " "
                (dream-escape (get rec :title))
                "</h1>"
                "<p class=\"state\">"
                (get rec :state)
                "</p>"
                "<p class=\"author\">"
                (dream-escape (get rec :author))
                "</p>"
                "<p class=\"labels\">"
                (dream-escape (join ", " (get rec :labels)))
                "</p>"
                "<p class=\"assignees\">"
                (dream-escape (join ", " (get rec :assignees)))
                "</p>"
                "<div class=\"body\">"
                (gitea/issue-html owner name rec)
                "</div>"
                "<h2>Comments</h2>"
                (join
                  ""
                  (map-indexed
                    (fn (i c) (gitea/w-comment-html owner name n i c))
                    (get rec :comments)))))))))))

; ── json api ─────────────────────────────────────────────────────────

(define
  gitea/w-api-issues
  (fn
    (forge req)
    (let
      ((owner (dream-param req "owner")) (name (dream-param req "name")))
      (if
        (not (gitea/w-readable? forge req owner name))
        (dream-not-found)
        (dream-json-value
          (map (fn (r) {:state (get r :state) :title (get r :title) :number (get r :number)}) (gitea/issue-records forge owner name)))))))

; any authenticated reader may open an issue
(define
  gitea/w-api-issue-create
  (fn
    (forge req)
    (let
      ((owner (dream-param req "owner")) (name (dream-param req "name")))
      (let
        ((user (gitea/w-user forge req)))
        (cond
          ((not (gitea/can? forge user "read" owner name))
            (if
              (nil? user)
              (if
                (gitea/repo-exists? forge owner name)
                (if
                  (equal?
                    (get (gitea/repo-get forge owner name) :visibility)
                    "public")
                  (gitea/w-unauthorized)
                  (dream-not-found))
                (dream-not-found))
              (dream-not-found)))
          ((nil? user) (gitea/w-unauthorized))
          (else
            (let
              ((body (dream-json-body req)))
              (let
                ((res (gitea/issue-create! forge owner name user (get body :title) (or (get body :body) "") {:created-at (or (get body :created-at) 0) :assignees (or (get body :assignees) (list)) :labels (or (get body :labels) (list))})))
                (if
                  (get res :error)
                  (gitea/w-json-status 400 {:error (get res :error)})
                  (gitea/w-json-status 201 {:title (get res :title) :number (get res :number)}))))))))))

(define
  gitea/w-api-issue-comment
  (fn
    (forge req)
    (let
      ((owner (dream-param req "owner"))
        (name (dream-param req "name"))
        (n (gitea/w-issue-n req)))
      (let
        ((user (gitea/w-user forge req)))
        (cond
          ((or (nil? n) (not (gitea/can? forge user "read" owner name)))
            (dream-not-found))
          ((nil? user) (gitea/w-unauthorized))
          (else
            (let
              ((body (dream-json-body req)))
              (let
                ((res (gitea/issue-comment! forge owner name n user (or (get body :body) "") {:at (or (get body :created-at) 0)})))
                (if
                  (get res :error)
                  (gitea/w-json-status 404 {:error (get res :error)})
                  (dream-json-value {:author user}))))))))))

; the author or anyone with write may close/reopen
(define
  gitea/issue-can-close?
  (fn
    (forge user owner name rec)
    (or
      (= user (get rec :author))
      (gitea/can? forge user "write" owner name))))

(define
  gitea/w-api-issue-state
  (fn
    (forge req state)
    (let
      ((owner (dream-param req "owner"))
        (name (dream-param req "name"))
        (n (gitea/w-issue-n req)))
      (let
        ((user (gitea/w-user forge req)))
        (cond
          ((or (nil? n) (not (gitea/can? forge user "read" owner name)))
            (dream-not-found))
          ((nil? user) (gitea/w-unauthorized))
          (else
            (let
              ((rec (gitea/issue-get forge owner name n)))
              (cond
                ((nil? rec) (dream-not-found))
                ((not (gitea/issue-can-close? forge user owner name rec))
                  (gitea/w-forbidden))
                (else
                  (begin
                    (gitea/issue-update!
                      forge
                      owner
                      name
                      n
                      (fn (r) (assoc r :state state)))
                    (dream-json-value {:state state :number n})))))))))))

; label + assignee management requires write
(define
  gitea/w-api-issue-edit
  (fn
    (forge req f)
    (let
      ((owner (dream-param req "owner"))
        (name (dream-param req "name"))
        (n (gitea/w-issue-n req)))
      (let
        ((user (gitea/w-user forge req)))
        (cond
          ((or (nil? n) (not (gitea/can? forge user "read" owner name)))
            (dream-not-found))
          ((nil? user) (gitea/w-unauthorized))
          ((not (gitea/can? forge user "write" owner name))
            (gitea/w-forbidden))
          ((nil? (gitea/issue-get forge owner name n)) (dream-not-found))
          (else
            (let
              ((res (f owner name n)))
              (if
                (and (dict? res) (get res :error))
                (gitea/w-json-status 400 {:error (get res :error)})
                (dream-json-value {:number n})))))))))

(define
  gitea/issue-routes
  (fn
    (forge)
    (list
      (dream-get
        "/:owner/:name/issues"
        (fn (req) (gitea/w-issues-page forge req)))
      (dream-get
        "/:owner/:name/issues/:n"
        (fn (req) (gitea/w-issue-page forge req)))
      (dream-get
        "/api/repos/:owner/:name/issues"
        (fn (req) (gitea/w-api-issues forge req)))
      (dream-post
        "/api/repos/:owner/:name/issues"
        (fn (req) (gitea/w-api-issue-create forge req)))
      (dream-post
        "/api/repos/:owner/:name/issues/:n/comments"
        (fn (req) (gitea/w-api-issue-comment forge req)))
      (dream-post
        "/api/repos/:owner/:name/issues/:n/close"
        (fn (req) (gitea/w-api-issue-state forge req "closed")))
      (dream-post
        "/api/repos/:owner/:name/issues/:n/reopen"
        (fn (req) (gitea/w-api-issue-state forge req "open")))
      (dream-put
        "/api/repos/:owner/:name/issues/:n/labels/:label"
        (fn
          (req)
          (gitea/w-api-issue-edit
            forge
            req
            (fn
              (o r n)
              (gitea/issue-label! forge o r n (dream-param req "label"))))))
      (dream-delete
        "/api/repos/:owner/:name/issues/:n/labels/:label"
        (fn
          (req)
          (gitea/w-api-issue-edit
            forge
            req
            (fn
              (o r n)
              (gitea/issue-unlabel! forge o r n (dream-param req "label"))))))
      (dream-put
        "/api/repos/:owner/:name/issues/:n/assignees/:user"
        (fn
          (req)
          (gitea/w-api-issue-edit
            forge
            req
            (fn
              (o r n)
              (gitea/issue-assign! forge o r n (dream-param req "user"))))))
      (dream-delete
        "/api/repos/:owner/:name/issues/:n/assignees/:user"
        (fn
          (req)
          (gitea/w-api-issue-edit
            forge
            req
            (fn
              (o r n)
              (gitea/issue-unassign! forge o r n (dream-param req "user")))))))))

(set! gitea/route-packs (append gitea/route-packs (list gitea/issue-routes)))