#lang racket/base

(require "private/git-provider.rkt"
         "private/git-commands.rkt"
         "private/config.rkt"
         "private/diff.rkt"
         "private/info.rkt"
         simple-log
         racket/string
         net/sendurl
         )

(provide git
         git-add
         git-status
         git-commit
         git-pull
         git-push
         git-log
         git-grep
         git-new-version
         )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define git-commands (make-hash))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Command invocation using 'git'
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; goal: Invoke a supported Git command through the command table.
;; pre: command is a registered Git command symbol.
;; post: The selected command has processed all supplied arguments.
;; result: The command-specific result.

(define (git command . args)
  ((hash-ref git-commands command
             (λ ()
               (error "Not a supported or recognized git command: " command)))
   args))

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

(define (git-prompt p)
  (display p)
  (flush-output)
  (read-line))

(define (add-porcelain args info . f)
  (let ((m (has-git-arg? args #px"^[-][-]porcelain([=](.*))?"))
        (g (if (null? f) (λ (x) x) (car f)))
        )
    (if m
        (g args)
        (g (cons '--porcelain args)))))

(define (status->symbol status)
  (cond
    ((string=? status " ") 'unchanged)
    ((string=? status "M") 'modified)
    ((string=? status "T") 'type-changed)
    ((string=? status "A") 'added)
    ((string=? status "D") 'deleted)
    ((string=? status "R") 'renamed)
    ((string=? status "C") 'copied)
    ((string=? status "U") 'unmerged)
    ((string=? status "?") 'untracked)
    ((string=? status "!") 'ignored)
    (else (error 'git-status "Unexpected status: ~a" status))))

(define (nothing-to-commit? out)
  (ormap (λ (line)
           (let ((line* (string-downcase line)))
             (or (string-contains? line* "nothing to commit")
                 (string-contains? line* "no changes added to commit"))))
         out))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Command definition macro
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-syntax def-cmd
  (syntax-rules ()
    ((_ cmd cmd* cmd-sym)
     (def-cmd cmd cmd* cmd-sym (λ (args info) args) std-process-git-result))
    ((_ cmd cmd* cmd-sym pre-code)
     (def-cmd cmd cmd* cmd-sym pre-code std-process-git-result))
    ((_ cmd cmd* cmd-sym pre-code process-result)
     (begin
       (def-git-cmd-proxy cmd* cmd-sym
         pre-code
         process-result)
       (define (cmd . args) (cmd* args))
       (hash-set! git-commands cmd-sym cmd*)))
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Typical git commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; goal: Return the complete Git index and worktree status for every reported file.
;; pre: The current directory is inside a Git working tree.
;; post: Git status has been invoked with --porcelain.
;; result: A list containing (index-status worktree-status file) for every file.
(def-cmd git-status cmd-git-status 'status
  add-porcelain
  (λ (cmd exit-code result output out info)
    (dbg-git (format "~a" output))
    (if (= exit-code 0)
        (map (λ (line)
               (if (< (string-length line) 3)
                   (git-error 'status "Unexpected output" line)
                   (list (status->symbol (substring line 0 1))
                         (status->symbol (substring line 1 2))
                         (substring line 3))))
             (map cadr
                  (filter (λ (entry) (eq? (car entry) 'stdout)) output)))
        (git-error 'status "Exitcode <> 0" (cons (format "~a\n" exit-code) output))
        ))
  )


;; goal: Add file contents to the Git index.
;; pre: The supplied arguments are valid for git add.
;; post: Git add has completed successfully or an exception has been raised.
;; result: #t after a successful Git command.
(def-cmd git-add cmd-git-add 'add)

;; goal: Create a Git commit.
;; pre: A commit message is supplied or can be requested from the user.
;; post: The commit was created, nothing needed committing, or an exception was raised.
;; result: #t after a commit or when the repository has nothing to commit.
(def-cmd git-commit cmd-git-commit 'commit
  (λ (args info)
    (with-handlers ([exn:fail? (λ (e)
                                 (let ((msg (string-trim (git-prompt "Commit message:\n>"))))
                                   (if (string=? msg "")
                                       (raise "A commit message is mandatory")
                                       (cons '-m (cons msg args)))))])
      (check-git-args 'commit args '((-m 1 "A commit message is mandatory")))))
  (λ (cmd exit-code result output out info)
    (cond
      ((and (= exit-code 1)
            (nothing-to-commit? out))
       (git-displ out)
       #t)
      (else 
       (std-process-git-result cmd exit-code result output out info))))
  )

;; goal: Push local changes to a remote repository.
;; pre: The supplied arguments are valid for git push.
;; post: Git push has completed successfully or an exception has been raised.
;; result: #t after a successful push.
(def-cmd git-push cmd-git-push 'push add-porcelain)

;; goal: Fetch and integrate changes from a remote repository.
;; pre: The supplied arguments are valid for git pull.
;; post: Git pull has completed successfully or an exception has been raised.
;; result: #t after a successful pull.
(def-cmd git-pull cmd-git-pull 'pull)

(def-cmd git-branch cmd-git-branch 'branch)

(def-cmd git-clone cmd-git-clone 'clone)

;; goal: Display the Git commit log.
;; pre: The supplied arguments are valid for git log.
;; post: Git log has completed successfully or an exception has been raised.
;; result: #t after successfully displaying the log.
(def-cmd git-log cmd-git-log 'log)

(def-cmd git-rev-list cmd-git-rev-list 'rev-list)

(def-cmd git-diff cmd-git-diff 'diff
  (λ (args info) args)
  (λ (cmd exit-code result output out info)
    (if (and (zero? exit-code)
             result)
        (let ((diff (string-join 
                     (filter (λ (line)
                               (not (string-prefix? (string-downcase line) "warning:")))
                             out)
                     "\n")))
          (diff->html diff)
          #t)
          #f)))

;; goal: Search tracked files for a pattern.
;; pre: The supplied arguments are valid for git grep.
;; post: Git grep has completed; exit code one is treated as no matches.
;; result: A list containing file, line number, match count and matched text.
(def-cmd git-grep cmd-git-grep 'grep
  (λ (args info)
    (let ((matches #f)
          (line-nr #f)
          )
          
      (let ((nargs (map
                    (λ (e)
                      (let ((o (format "~a" e)))
                        (cond
                          ((string=? o "-c") (set! matches #t))
                          ((string=? o "-n") (set! line-nr #t))))
                      e)
                    (map (λ (x) (if (eq? x '-i) "-i" x)) args))))
        (when (eq? line-nr #f)
          (set! nargs (cons "-n" nargs)))  ;; add line numbers / counts for pattern recognition
        (hash-set! info 'matches matches)
        (hash-set! info 'line-nr (if matches #f line-nr))
        nargs)))
  (λ (cmd exit-code result output out info)
    (with-handlers ([exn:fail? (λ (e)
                                 (err-git (string-join (map cadr output) "\n"))
                                 (raise e))])
      (if (and result
               (or (= exit-code 0) (= exit-code 1)))
          (let ((re #px"([^:]+)[:]([^:]+)([:](.*))?"))
            (map (λ (line)
                   (let ((m (regexp-match re line)))
                     (let ((line-nr (if (hash-ref info 'line-nr #f)
                                        (if (eq? m #f)
                                            #f
                                            (string->number (caddr m)))
                                        #f))
                           (matches (if (hash-ref info 'matches #f)
                                        (if (eq? m #f)
                                            #f
                                            (string->number (caddr m)))
                                        #f))
                           )
                       (if m
                           (list (cadr m) line-nr matches (cadddr (cdr m)))
                           (list line #f #f #f)))))
                 out))
          (begin
            (err-git (string-join (map cadr output) "\n"))
            #f))))
  )

(def-cmd git-help cmd-git-help 'help)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Racket module versioning
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (git-version . args)
  (cmd-git-version args))

(define (cmd-git-version args)
  (info-version "."))

(hash-set! git-commands 'version cmd-git-version)

;; goal: Increment the package version in info.rkt.
;; pre: kind is 'maj, 'major, 'min, 'minor or 'patch.
;; post: The version definition in info.rkt has been updated.
;; result: The new version as a list containing major, minor and patch.
(define (git-new-version . args)
  (cmd-git-new-version args))

(define (cmd-git-new-version args)
  (when(null? args)
      (error "git-new-version expects 'maj, 'major, 'min, 'minor or 'patch"))
  (let ((kind (car args)))
    (git-next-version kind ".")
    (git-version)))

(hash-set! git-commands 'new-version cmd-git-new-version)