;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;;

(define-module (gitile repo)
  #:use-module (git)
  #:use-module (git types)
  #:use-module (gitile git)
  #:use-module (srfi srfi-9)
  #:use-module (system foreign)
  #:export (get-branches
            get-tags
            get-files
            get-file-content
            get-commits
            get-commit
            get-description
            last-commit

            <file>
            make-file
            file?
            file-name
            file-type))

(define tree-entry-type
  (let ((proc (libgit2->procedure int "git_tree_entry_type" '(*))))
    (lambda (entry)
      (proc (tree-entry->pointer entry)))))

(define (get-branches repo)
  (map (lambda (ref) (cons (reference-shorthand ref) (reference-name ref)))
       (filter reference-branch? (reference-fold cons '() repo))))

(define (get-tags repo)
  (map (lambda (ref) (cons (reference-shorthand ref) (reference-name ref)))
       (filter reference-tag? (reference-fold cons '() repo))))

(define (search-reference repo name)
  (reference-fold (lambda (ref acc)
                    (if (equal? name (reference-shorthand ref))
                        (reference-name ref)
                        acc))
                  #f
                  repo))

(define (ref->oid repo ref)
  (let ((ref-name (or ref
                      (false-if-exception (reference-name (repository-head repo))))))
    (or (false-if-exception (string->oid ref-name))
        (false-if-exception (reference-name->oid repo ref-name))
        (reference-name->oid repo (search-reference repo ref-name)))))

(define-record-type <file>
  (make-file name type commit)
  file?
  (name   file-name)
  (type   file-type)
  (commit file-commit))

(define* (get-files repo #:key (path "") (ref #f))
  (let* ((oid (ref->oid repo ref))
         (commit (commit-lookup repo oid))
         (tree (commit-tree commit)))
    (let ((result '()))
      (tree-walk
        tree TREEWALK-PRE
        (lambda (root entry)
          (when (equal? root path)
            (set! result
              (cons (make-file (tree-entry-name entry)
                               (tree-entry-type entry)
                               (last-commit-for-file
                                 (string-append root (tree-entry-name entry))
                                 commit))
                    result)))
          0))
      result)))

(define (last-commit repo ref)
  (let ((oid (ref->oid repo ref)))
    (commit-lookup repo oid)))

(define* (get-file-content repo path #:key (ref #f))
  (let* ((oid (ref->oid repo ref))
         (commit (commit-lookup repo oid))
         (tree (commit-tree commit))
         (entry (tree-entry-bypath tree path))
         (entry-oid (tree-entry-id entry))
         (blob (blob-lookup repo entry-oid)))
    (blob-content blob)))

(define (last-commit-for-file path commit)
  (let* ((initial-tree (commit-tree commit))
         (initial-entry (false-if-exception (tree-entry-bypath initial-tree path))))
    (let loop ((commit commit))
      (let ((pcommit (false-if-exception (commit-parent commit))))
        (if pcommit
            (let* ((ptree (commit-tree pcommit))
                   (pentry (false-if-exception (tree-entry-bypath ptree path))))
              (if (or (and (not initial-entry) (not pentry))
                      (and initial-entry pentry
                           (equal? (tree-entry-id initial-entry)
                                   (tree-entry-id pentry))))
                  (loop pcommit)
                  commit))
            commit)))))

(define (get-commits repo ref)
  (let* ((oid (ref->oid repo ref))
         (commit (commit-lookup repo oid)))
    (let loop ((result (list commit)) (commit commit))
      (let ((pcommit (false-if-exception (commit-parent commit))))
        (if (and pcommit (< (length result) 20))
            (loop (cons pcommit result) pcommit)
            (cons (reverse result) pcommit))))))

(define (get-options config)
  (let ((out '()))
    (config-foreach
      config
      (lambda (entry)
        (set! out (cons (cons (config-entry-name entry)
                              (config-entry-value entry))
                        out))
        0))
    out))

(define (get-description repo)
  (let* ((config (repository-config repo))
         (options (get-options config)))
    (or (assoc-ref options "gitweb.description") "")))

(define (get-commit repo hash)
  (let* ((oid (ref->oid repo hash))
         (commit (commit-lookup repo oid)))
    commit))