#lang racket/base

(require racket/path
         racket/string
         racket/contract
         racket/system
         "config.rkt"
         )

(provide git-exe
         set-git-exe!
         run-git
         git-out
         git-error
         git-displ
         )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define cached-git-exe #f)

(define (ask-for-git-executable)
  (displayln "Git was not found on PATH.")
  (displayln "Enter the full path to git/git.exe, or press Enter to abort:")
  (let loop ()
    (display "> ")
    (flush-output)
    (let ((answer (read-line)))
      (when (or (eof-object? answer)
                (string=? (string-trim answer) ""))
        (error 'git "Git executable not found; configuration aborted"))
      (let ((candidate (find-executable-path answer)))
        (if (eq? candidate #f)
            (begin
              (displayln
               (format "'~a' is not found, please try again or press Enter to abort." answer))
               (loop))
            (begin
              (set-git-exe! candidate)
              #t)))))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define/contract (git-exe)
  (-> (or/c path? #f))
  (if (eq? cached-git-exe #f)
      (let ((the-git-exe (let ((exe (cfg-get 'git 'exe #f)))
                           (if (eq? exe #f)
                               (let ((path (find-executable-path "git")))
                                 (if (eq? path #f)
                                     (if (ask-for-git-executable)
                                         (git-exe)
                                         #f)
                                     path))
                               exe
                               ))))
        (set! cached-git-exe the-git-exe)
        the-git-exe)
      cached-git-exe))

(define/contract (set-git-exe! exe-path)
  (-> path? void?)
  (void
   (begin
     (cfg-set! 'git 'exe exe-path)
     (set! cached-git-exe exe-path))))


(define/contract (run-git args)
  (-> (listof (or/c path-string? symbol?))
      (listof (list/c (one-of/c 'stdout 'stderr) string?)))
  (putenv "GIT_TERMINAL_PROMPT" "0")
  (let-values (((process stdout stdin stderr)
                (apply subprocess
                       #f
                       #f
                       #f
                       (git-exe)
                       (map (lambda (arg)
                              (if (symbol? arg)
                                  (symbol->string arg)
                                  arg))
                            args))))
    (close-output-port stdin)
    (let ((output-channel (make-channel)))
        (define (read-output source port)
          (thread
           (lambda ()
             (let loop ()
               (let ((line (read-line port)))
                 (channel-put output-channel (list source line))
                 (if (eof-object? line)
                     (close-input-port port)
                     (loop)))))))

        (read-output 'stdout stdout)
        (read-output 'stderr stderr)

        (let loop ((open-ports 2)
                   (result '()))
          (if (= open-ports 0)
              (begin
                (subprocess-wait process)
                (reverse result))
              (let* ((output (channel-get output-channel))
                     (line (cadr output)))
                (if (eof-object? line)
                    (loop (- open-ports 1) result)
                    (loop open-ports
                          (cons output result)))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided utility functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (is-output? e)
  (or (eq? (car e) 'stdout)
      (and (eq? (car e) 'stderr)
           (string-prefix? (string-downcase (cadr e)) "warning:"))))

(define (is-error? e)
  (not (is-output? e)))

(define (git-out cmd output)
  (let* ((out (map (λ (e) (cadr e)) (filter (λ (e) (is-output? e)) output)))
         (err (map (λ (e) (cadr e)) (filter (λ (e) (is-error? e)) output)))
         (r (null? err))
         )
    (values r (if (eq? r #t) out err))))

(define-syntax git-error
  (syntax-rules ()
    ((_ cmd msg* outp)
     (let* ((out (map (λ (e) (if (list? e)
                                 (if (null? e)
                                     ""
                                     (if (or (eq? (car e) 'stdout)
                                             (eq? (car e) 'stderr))
                                         (format "~a" (cadr e))
                                         (format "~a" e)))
                                 (format "~a" e)))
                      (if (list? outp) outp (list outp))))
            (enter (if (eq? (system-type 'os) 'windows) "\r\n" "\n"))
            (msg (format "git ~a: ~a: ~a" cmd msg* (string-join out enter)))
            )
       (err-git msg)
       (error 'git msg))
     )
    )
  )

(define (git-displ out)
  (let ((str (if (string? out) out (string-join out "\n"))))
    (unless (string=? (string-trim str) "")
      (info-git str)
      (when (cfg-get 'git 'display-output #t)
        (displayln str)))))