#lang racket/base

(require "git-provider.rkt"
         "git-auth.rkt"
         racket/string
         racket/list
         )

(provide def-git-cmd-proxy
         check-git-args
         has-git-arg?
         std-process-git-result
         default-git-authentication-handler
         current-git-authentication-handler
         exn:fail:git-auth?
         exn:fail:git-auth-command
         exn:fail:git-auth-args
         exn:fail:git-auth-exit-code
         exn:fail:git-auth-output
         )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Determine whether a Git option occurs in an argument list.
; pre    : args is a list and opt is a symbol, string or regular expression.
; post   : args has only been inspected.
; result : The match result, or #f when the option is absent.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (has-git-arg? args opt)
  (let ((cmp (cond ((symbol? opt) (λ (x) (eq? x opt)))
                   ((string? opt) (λ (x) (string=? (format "~a" x) opt)))
                   ((regexp? opt) (λ (x) (regexp-match opt (format "~a" x))))
                   (else (error "opt must be a string, symbol or regular expression")))))
    (letrec ((f (λ (args)
                  (if (null? args)
                      #f
                      (let ((m (cmp (car args))))
                        (if m
                            m
                            (f (cdr args))))))))
      (if (list? args)
          (f args)
          (error 'has-git-arg? "args must be a list of arguments")))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Check that mandatory Git options and their arguments are present.
; pre    : flags contains (option argument-count error-message) items.
; post   : Missing options have raised an exception.
; result : args when every mandatory option is present.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (check-git-args cmd args flags)
  (for-each
   (λ (opt)
     (let ((flag (car opt))
           (num-args (cadr opt))
           (err-msg (caddr opt)))
       (letrec ((find (λ (l)
                        (if (null? l)
                            #f
                            (if (eq? (car l) flag)
                                (if  (>= (length (cdr l)) num-args)
                                     #t
                                     #f)
                                (find (cdr l)))))))
         (let ((found (find args)))
           (unless found
             (error 'git (format "git ~a: ~a" cmd err-msg))))
         )
       ))
   flags)
  args)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Process the standard result of a Git command.
; pre    : exit-code and out belong to the completed Git command.
; post   : Successful output has been displayed or a Git exception has been raised.
; result : #t when exit-code is zero.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (std-process-git-result cmd exit-code result output out info)
  (if (= exit-code 0)
      (begin
        (git-displ (map cadr output))
        #t)
      (git-error cmd (format "Exitcode <> 0: ~a" exit-code) out)
      )
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Define the internal proxy for a Git command.
; pre    : pre-code and process-result accept the command proxy arguments.
; post   : Authentication failures are offered once to the current authentication
;          handler before the Git command is retried.
; result : A procedure named f accepting a list of Git arguments.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax def-git-cmd-proxy
  (syntax-rules ()
    ((_ f cmd pre-code process-result)
     (define (f args*)
       (let* ((args (flatten args*))
              (info (make-hash))
              (nargs (pre-code args info)))
         (let retry ((authentication-retry? #t))
           (with-handlers
               ((exn:fail:git-auth?
                 (λ (e)
                   (if (and authentication-retry?
                            ((current-git-authentication-handler) cmd nargs e))
                       (retry #f)
                       (git-error cmd
                                  (format "Exitcode <> 0: ~a"
                                          (exn:fail:git-auth-exit-code e))
                                  (exn:fail:git-auth-output e))))))
             (let-values (((exit-code output) (run-git (cons cmd nargs))))
               (when (authentication-failure? exit-code output)
                 (raise-git-auth-error cmd nargs exit-code output))
               (let-values (((result out) (git-out cmd output)))
                 (process-result cmd exit-code result output out info))))))))
    )
  )