#lang racket/base

(require racket/path
         racket/string
         racket/contract
         racket/system
         "config.rkt"
         "find-editor.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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Find the configured Git executable.
; pre    : Git is on PATH or a valid executable can be selected interactively.
; post   : The executable path has been cached.
; result : The path to git or git.exe.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Configure the Git executable.
; pre    : exe-path names an executable path.
; post   : The path has been stored and cached.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (set-git-exe! exe-path)
  (-> path? void?)
  (void
   (begin
     (cfg-set! 'git 'exe exe-path)
     (set! cached-git-exe exe-path))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Run Git without allowing interactive terminal prompts.
; pre    : args contains the Git command and its arguments; input is #f or a string
;          that must be written to Git's standard input.
; post   : Optional input has been written and standard output and error have been
;          read completely.
; result : The exit code and ordered (source line) output items.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Configure the process environment used by git-cli Git commands.
; pre    : The editor finder can inspect the current platform.
; post   : Terminal prompting is disabled and a detected GUI editor is made
;          available to Git and Git's sequence editor.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (setup-git-environment!)
  (putenv "GIT_TERMINAL_PROMPT" "0")
  (let ((editor (find-editor)))
    (when editor
      (putenv "GIT_EDITOR" editor)
      (putenv "GIT_SEQUENCE_EDITOR" editor)))
  (void))

(setup-git-environment!)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Run Git without allowing interactive terminal prompts.
; pre    : args contains the Git command and its arguments; input is #f or a string
;          that must be written to Git's standard input.
; post   : Optional input has been written and standard output and error have been
;          read completely.
; result : The exit code and ordered (source line) output items.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (run-git args #:input (input #f))
  (let-values (((process stdout stdin stderr)
                (apply subprocess
                       #f
                       #f
                       #f
                       (git-exe)
                       (map (λ (arg) (format "~a" arg)) args)
                       )))
    (when input
      (display input stdin)
      (flush-output stdin))
    (close-output-port stdin)
    (let ((output-channel (make-channel)))
      (define (read-output source port)
        (thread
         (λ ()
           (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)
              (values (subprocess-status 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)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Separate normal Git output from error output.
; pre    : output contains (source line) items returned by run-git.
; post   : output has only been inspected.
; result : Whether no error occurred and either normal or error lines.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Log and raise a Git exception.
; pre    : cmd, msg* and outp describe a failed Git command.
; post   : The message has been logged and an exception has been raised.
; result : No normal return value.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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) "\n" "\n"))
            (msg (format "git ~a: ~a: ~a" cmd msg* (string-join out enter)))
            )
       (err-git msg)
       (error 'git msg))
     )
    )
  )

(define re-a #px"~+")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Log Git output and optionally display it.
; pre    : out is a string or a list of displayable lines.
; post   : Non-empty output has been logged.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-displ out)
  (let ((str (if (string? out) out (string-join out "\n"))))
    (unless (string=? (string-trim str) "")
      (let ((s (regexp-replace* re-a str "~~")))
        (info-git s))
      (when (cfg-get 'git 'display-output #t)
        (displayln str)))))