(in-package :fwoar.cl-git)
 

 ;; TODO: Update the code so this uses an object instead of a path.
 (defvar *git-repository*)
 (setf (documentation '*git-repository* 'variable)
       "The git repository path for porcelain commands to operate on.")
 

 (defvar *git-encoding* :utf-8
   "The encoding to use when parsing git objects")
 

 (defun co.fwoar.git:in-repository (root)

   (setf *git-repository*

         (ensure-repository
          (truename root))))

 (defun co.fwoar.git:repository ()

   *git-repository*)
 

 (defmacro co.fwoar.git:with-repository ((root) &body body)

   `(let ((*git-repository* (ensure-repository ,root)))

      ,@body))
 

 (defun co.fwoar.git:show-repository ()

   *git-repository*)
 

 (defun in-git-package (symbol)
   (intern (symbol-name symbol)

           :co.fwoar.git))

 (defun handle-list (_1)
   (case (in-git-package (car _1))

     (co.fwoar.git::unwrap `(uiop:nest (car)
                                       (mapcar ,@(cdr _1))))

     (t (cons (in-git-package (car _1))
              (cdr _1)))))
 

 (defun co.fwoar.git::resolve-refish (it)

   (flet ((hash-p (it)
            (and (> (length it) 32)
                 (every (serapeum:op
                          (digit-char-p _1 16))
                        it))))
     (cond

       ((block is-branch
          (mapc (fw.lu:destructuring-lambda ((name hash))
                  (when (equal it name)
                    (return-from is-branch
                      (ensure-ref hash))))
                (branches *git-repository*))
          nil))

       ((hash-p it) (ensure-ref it)))))
 

 (defmacro co.fwoar.git:git (&rest commands)

   `(uiop:nest ,@(reverse

                  (funcall (data-lens:<>1
                            (data-lens:over (serapeum:op
                                              (typecase _1
                                                (string `(identity ,_1))
                                                (list (handle-list _1)))))
                            (data-lens:transform-head (serapeum:op
                                                        (etypecase _1

                                                          (string `(co.fwoar.git::resolve-refish ,_1))

                                                          (t _1)))))
                           commands))))

 (defun co.fwoar.git::ensure-ref (it)

   (ensure-ref it))
 

 (defun co.fwoar.git::decode (it)

   (babel:octets-to-string it :encoding *git-encoding*))
 

 (defun co.fwoar.git::<<= (fun &rest args)

   (apply #'mapcan fun args))
 

 (defmacro co.fwoar.git::map (fun list)

   (alexandria:once-only (list)
     (alexandria:with-gensyms (it)
       `(mapcar ,(if (consp fun)
                     `(lambda (,it)
                        (,(in-git-package (car fun))
                         ,@(cdr fun)
                         ,it))
                     `',(in-git-package fun))
                ,list))))
 

 (defmacro co.fwoar.git::juxt (&rest args)

   (let ((funs (butlast args))
         (arg (car (last args))))
     (alexandria:once-only (arg)
       `(list ,@(mapcar (lambda (f)
                          `(,@(alexandria:ensure-list f) ,arg))
                        funs)))))
 

 (defmacro co.fwoar.git::pipe (&rest funs)

   (let ((funs (reverse (butlast funs)))
         (var (car (last funs))))
     `(uiop:nest ,@(mapcar (lambda (it)
                             (if (consp it)
                                 `(,(in-git-package (car it)) ,@(cdr it))
                                 `(,(in-git-package it))))
                           funs)
                 ,var)))
 

 (defun co.fwoar.git::filter (fun &rest args)

   (apply #'remove-if-not fun args))
 

 (defun co.fwoar.git::object (thing)

   (extract-object thing))

 (defun co.fwoar.git:show (object)

   (extract-object object))

 (defun co.fwoar.git:contents (object)
   (co.fwoar.git:show object))

 (defun co.fwoar.git:component (&rest args)

   (let ((component-list (butlast args))
         (target (car (last args))))
     (fwoar.cl-git::component component-list target)))
 

 (defun co.fwoar.git:tree (commit-object)

   (component :tree
              commit-object))

 (defun co.fwoar.git::filter-tree (name-pattern tree)

   #+lispworks
   (declare (notinline serapeum:string-prefix-p))

   (let* ((tree-entries (component :entries tree))
          (scanner (cl-ppcre:create-scanner name-pattern)))

     (remove-if-not (serapeum:op

                      (cl-ppcre:scan scanner _))
                    tree-entries
                    :key #'te-name)))

 (defun co.fwoar.git:branch (&optional (branch :master))

   #+lispworks
   (declare (notinline serapeum:assocadr))

   (let ((branches (branches *git-repository*)))
     (ref *git-repository*

          (serapeum:assocadr (etypecase branch
                               (string branch)
                               (keyword (string-downcase branch)))
                             branches
                             :test 'equal))))

 (defun co.fwoar.git:branches ()

   (branches *git-repository*))

 (defun co.fwoar.git::parents (commit)

   (mapcar 'ensure-ref
           (component :parents commit)))

 (defun co.fwoar.git:commit-parents (commit)
   (co.fwoar.git::parents commit))

 (defun co.fwoar.git:rev-list (ref-id &optional (limit nil limit-p))

   "Return the commits reachable from the ref."

   (when limit-p
     (rotatef ref-id limit))

   (let ((seen (make-hash-table)))
     (labels ((iterate (queue accum &optional (count 0))
                (if (or (when limit-p
                          (= limit count))
                        (null queue))
                    accum
                    (destructuring-bind (next . rest) queue
                      (let ((parents (co.fwoar.git::parents next)))
                        (iterate (append rest parents)
                          (if (gethash next seen)
                              accum
                              (progn
                                (setf (gethash next seen) t)
                                (cons next accum)))
                          (1+ count)))))))
       (iterate (list (ensure-ref ref-id))
         ()))))