;;;; 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))