in-git-repo.rkt

#!/usr/bin/env racket

;;;; Support code for my shell "gitcd" function: if you are in a git
;;;; repo, but not in the worktree part -- you're in a regular repo
;;;; somewhere inside the .git directory, or in a bare git repo -- the
;;;; usual "git rev-parse --show-toplevel" stuff doesn't work.
;;;;
;;;; The code here detects those situations where rev-parse fails: it
;;;; looks for either ".git" somewhere in the current directory's
;;;; ancestry, or "reponame.git" in the cwd ancestry.
;;;;
;;;; When it finds that, it prints the apparent top-level directory for
;;;; the repo and exits with code 0. Otherwise, it prints an empty
;;;; string/blank line and exits with code 1.

#lang typed/racket

(require threading)

;;; in the repl, if you do
;;;
;;; (require (submod "in-git-repo.rkt" test))
;;;
;;; It will automatically run the tests whenever you send the module
;;; there.
(module+ test
  (require typed/rackunit))

(define (path-is-dot-git? [p : Path])
  "Does the provided path equal '.git', or have a '.git' extension?"
  (or
   (equal? p (string->path ".git"))
   (and (not (symbol? p))
        (path-has-extension? p ".git"))))

;;; just something super simple as I'm learning how this works
(module+ test
  (check-true (path-is-dot-git? (build-path ".git")))
  (check-false (path-is-dot-git? (build-path "git")))
  (check-true (path-is-dot-git? (build-path "bare-repo.git")))
  (check-false (path-is-dot-git? (build-path "foo.gitx"))))

(define (rest-if-starts-with-dot-git [path-components : (Listof Path)])
  "Drop the first path in path-components if it's '.git'; otherwise, a
no-op."
  (if (and (pair? path-components)
           (equal? (string->path ".git") (first path-components)))
      (rest path-components)
      path-components))

(: filter-symbols (-> (Listof (U 'same 'up Path-For-Some-System)) (Listof Path)))
(define (filter-symbols paths)
  "Helper function for the type checker: filters a list of path-related
values to remove the symbols 'up and 'same. In the code here, we never
have those, so for our purposes, this is the identity function, but the
type checker doesn't know that."
  (filter path? paths))

(define (maybe-git-repo-path [path : Path]) : (Listof Path)
  "Return a list of path components if there's .git somewhere in an
ancestor directory of the path. Returns empty list when there is no such
component."
  (~> path
      explode-path
      filter-symbols
      reverse
      (dropf _  (λ ([p : Path]) (not (path-is-dot-git? p))))
      rest-if-starts-with-dot-git
      reverse
      ))

(define (get-git-repo-path-string [path : Path])
  "Returns a string representing the root of the git repo for the provided
path if:

  - there's '.git' in the ancestry, or
  - there's 'foo.git' for some 'foo' in the ancestry.

  Returns the empty string when neither of those is true; that is,
there's no .git in the path."
  (define mgrp (maybe-git-repo-path path))
  (if (empty? mgrp)
      ""
      (~> mgrp (apply build-path _) (format "~a" _))))

(module+ test
  (check-equal? (get-git-repo-path-string (build-path "/one/two/.git")) "/one/two")
  (check-equal? (get-git-repo-path-string (build-path "/one/two/.git/objects")) "/one/two")
  (check-equal? (get-git-repo-path-string (build-path "/one/two/foo.git")) "/one/two/foo.git")
  (check-equal? (get-git-repo-path-string (build-path "/one/two/foo.git/three")) "/one/two/foo.git")
  (check-equal? (get-git-repo-path-string (build-path "/one/nodot/git")) "")
  (check-equal? (get-git-repo-path-string (build-path "/home/dan")) ""))

(define (main)
  "Print the top-level directory of the current git repo, if 'foo.git' or
'.git' are in the current path. Prints empty line if not apparently in a
git repo.

  Exit code indicates whether you seem to be in a git repo."
  (define target-directory
    (get-git-repo-path-string (current-directory)))
  (displayln target-directory)
  (if (string=? target-directory "")
      (exit 1)
      (exit 0)))

;;; If you want to distinguish between being required versus actually
;;; being run -- as a script, in the repl -- you use the
;;;
;;; (module+ main ...)
;;;
;;; approach:
;;; https://docs.racket-lang.org/guide/Module_Syntax.html#%28part._main-and-test%29
;;;
;;; ...but running in the repl triggers that. I want to detect running
;;; as a script on the command line, so I just use this.
(when (terminal-port? (current-input-port))
  (main))