;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; forgejo.scm
;; Copyright (C) 2025 Cor Legemaat <cor@cor.za.net>
;;
;; This file is part of ebuild-autogen: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published by the
;; Free Software Foundation, version 3 of the License.
;;
;; ebuild-autogen is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
;; more details.
;;
;; You should have received a copy of the GNU General Public License along with
;; ebuild-autogen. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (ebuild fetchers forgejo)
  #:use-module (ebuild defs)
  #:use-module (ebuild fetchers raw)
  #:use-module (ebuild utils)
  #:use-module (curl)
  #:use-module (json)
  #:use-module (ice-9 pretty-print)
  #:use-module (oop goops)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-43)
  #:use-module (rx irregex)
  #:use-module (dql dql))

(define api-base-url "/api/v1/repos/")

(define check-forgejo-errors
  (lambda (responce)
    ""
    ;; TODO
    '()))

(define fetch-forgejo-pages
  (lambda* (url auth-token verbosity #:optional (page 1))
    ""
    (let ((curl-handle (curl-easy-init)))
      (if (>= verbosity verbosity-info)
          (begin (display "src-url: ") (display url) (newline)))
      (curl-easy-setopt curl-handle
                        'url
                        (string-append url
                                       "?limit=100&page="
                                       (number->string page)))
      (curl-easy-setopt curl-handle 'useragent curl-useragent)
      (if (string<> auth-token "")
          (curl-easy-setopt curl-handle
                            'httpheader
                            (list (string-append "Authorization: token "
                                                 auth-token))))
      (let* ((responce (curl-easy-perform curl-handle)))
        (if (>= verbosity verbosity-debug)
            (begin (display "json = ") (display responce) (newline)))
        (if responce
            (begin (check-forgejo-errors responce)
                   (let ((scm-responce (json-string->scm responce)))
                     (if (< 100 (vector-length scm-responce))
                         (vector-append (fetch-forgejo-pages url
                                                             auth-token
                                                             verbosity
                                                             (+1 page)))
                         (begin (if (>= verbosity verbosity-info)
                                    (pretty-print scm-responce))
                                scm-responce))))
            (error (string-append "Forgejo fetch failed with error "
                                  (curl-error-string)
                                  "\n")))))))

(define get-releases
  (lambda (host user repo auth-token version-filter verbosity)
    ""
    ((dql (select (filter (where version-filter
                                 "tag_name"))
                  (parm-as "version" "tag_name")
                  (parm-as "date" "created_at")))
     (fetch-forgejo-pages (string-append host
                                         api-base-url
                                         user
                                         "/"
                                         repo
                                         "/releases")
                          auth-token
                          verbosity))))

(define get-tags
  (lambda (host user repo auth-token version-filter verbosity)
    ""
    ((dql (select (filter (where version-filter
                                 "name"))
                  (parm-as "version" "name")
                  (parm "commit" "sha")))
     (fetch-forgejo-pages (string-append host
                                         api-base-url
                                         user
                                         "/"
                                         repo
                                         "/tags")
                          auth-token
                          verbosity))))

(define get-rel-assets
  (lambda (host user repo auth-token name-prefix version-alter releases)
    "TODO Won't work!!!"
    ;; (display "for-releases:") (newline)
    ;; (pretty-print releases)
    (map (lambda (release)
           ;; (display "for-release:") (newline)
           ;; (pretty-print release)
           (let* ((version (assoc-ref release "version"))
                  (version-final (version-alter version))
                  (base-asset-url (string-append host "/" user "/" repo))
                 (curl-handle (curl-easy-init))
                 (json "")
                 (scm ""))
             (curl-easy-setopt curl-handle
                               'url
                               (string-append host api-base-url
                                              user
                                              "/"
                                              repo
                                              "/releases/"
                                              version))
             (curl-easy-setopt curl-handle 'useragent curl-useragent)
             (if (string<> auth-token "")
          (curl-easy-setopt curl-handle
                            'httpheader
                            (list (string-append "Authorization: token "
                                                 auth-token))))
             ;;(curl-easy-setopt curl-handle 'max-time 120)
             ;;(curl-easy-setopt curl-handle 'connect-timeout 30)
             (set! json (curl-easy-perform curl-handle))
             ;; (display "json=") (display json) (newline)
             (if (not json)
                 (error (string-append "GitHub release asset fetch "
                                       "failed with error "
                                       (curl-error-string)
                                       "\n")))
             (check-forgejo-errors json)
             (set! scm (json-string->scm json))
             (assoc-set! release "version" version-final)
             (append release
                     (list (cons "repo-user" user))
                     (list (cons "repo-repo" repo))
                     ;;TODO append this with list of custom assets.
                     (list
                      (list "assets"
                           (list (cons "uri" (string-append base-asset-url
                                                            "/archive/"
                                                            version
                                                             ".tar.gz"))
                                 (cons "name" (string-append name-prefix
                                                             "-"
                                                             version-final
                                                             ".tar.gz"))
                                 (cons "type" "tar.gz"))
                           (list (cons "uri" (string-append base-asset-url
                                                            "/archive/"
                                                            version
                                                             ".tar.gz"))
                                 (cons "name" (string-append name-prefix
                                                             "-"
                                                             version-final
                                                             ".zip"))
                                 (cons "type" "zip")))))))
         releases)))

(define get-tag-assets
  (lambda (host user repo name-prefix version-alter tags)
     ;; (display "tags = ")
     ;; (pretty-print tags)
    (map (lambda (tag)
           (let* ((version-final (version-alter (assoc-ref tag "version")))
                  (version-name (assoc-ref tag "version"))
                 (base-asset-url (string-append host "/" user "/" repo)))
            (assoc-set! tag "version" version-final)
            (append tag
                    (list (cons "repo-user" user))
                    (list (cons "repo-name" repo))
                    (list
                     (list "assets"
                           (list (cons "uri" (string-append base-asset-url
                                                            "/archive/"
                                                            version-name
                                                             ".tar.gz"))
                                 (cons "name" (string-append name-prefix
                                                             "-"
                                                             version-final
                                                             ".tar.gz"))
                                 (cons "type" "tar.gz"))
                           (list (cons "uri" (string-append base-asset-url
                                                            "/archive/"
                                                            version-name
                                                             ".tar.gz"))
                                 (cons "name" (string-append name-prefix
                                                             "-"
                                                             version-final
                                                             ".zip"))
                                 (cons "type" "zip")))))))
         tags)))

(define-public fetch-forgejo
  (lambda* (host user repo querry verbosity #:key
                 (auth-token "")
                 (version-filter (lambda (version)
                                   (irregex-search
                                    '(seq bos
                                          (+ num)
                                          (* (seq "." (+ num))))
                                    version)))
                 (version-alter (lambda (version)
                                  (let ((my-match (irregex-search
                                                   '(seq (+ num)
                                                         (* (seq "." (+ num))))
                                                   version)))
                                    (if my-match
                                        (irregex-match-substring my-match)
                                        #f))))
                 (file-prefix repo))
    ""
    (display "Fetching forgejo repo ")
    (display repo)
    (display " from ")
    (display user)
    (display " at ")
    (display host)
    (newline)
    (letrec* ((releases
               (case querry
                 ((releases) (get-releases host
                                           user
                                           repo
                                           auth-token
                                           version-filter
                                           verbosity))
                 ((tags) (get-tags host
                                   user
                                   repo
                                   auth-token
                                   version-filter
                                   verbosity))
                 (else (error (string-append "Error github can only "
                                             "querry tags or releases.")))))
              (assets (case querry
                        ((releases) (get-rel-assets host user repo auth-token
                                                    file-prefix version-alter
                                                    releases))
                        ((tags) (get-tag-assets host user repo
                                                file-prefix version-alter
                                                releases))
                        (else '()))))
      assets)))

(define-public extract-forgejo-release
  (lambda (release tmp-path)
    (let* ((sha7 (assoc-ref release "sha7"))
           (extracted-path (string-append tmp-path
                                          "/"
                                          (assoc-ref release "github-user")
                                          "-"
                                          (assoc-ref release "github-repo")
                                          "-" sha7))
           (file-path (fetch-raw-release release "tar.gz")))
      (if (access? extracted-path F_OK)
          (system* "/bin/rm" "-r" extracted-path))
      (mkpath tmp-path)
      (system* "/bin/tar"
               "-xf" file-path "--directory"
               tmp-path)
      extracted-path)))

(define-public fetch-forgejo-prefixed
  (lambda* (host user repo querry verbosity prefix #:key
                 (auth-token "")
                 (file-prefix repo))
    ""
    (fetch-forgejo host user repo querry verbosity
                   #:auth-token auth-token
                   #:version-filter
                   (lambda (version)
                     (irregex-search
                      `(seq ,prefix
                            (+ num)
                            (* (seq "." (+ num))))
                      version))
                   #:version-alter
                   (lambda (version)
                     (let ((my-match (irregex-search
                                      `(seq (look-behind ,prefix)
                                            (+ num)
                                            (* (seq "." (+ num))))
                                      version)))
                       (if my-match
                           (irregex-match-substring my-match)
                           #f)))
                   #:file-prefix file-prefix)))