blob: a721b3ad97f3c035fd3753bf24c031fdee97ecbb (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
#!/usr/bin/env bb
(require '[clojure.java.shell :refer [sh]])
(require '[clojure.string :as str])
(require '[clojure.java.io :as io])
(defn dirname [path] (.getParent (io/file path)))
(defn git [dir & args]
(let [proc (apply sh "git" "-C" (or dir ".") args)]
(when (= (:exit proc) 0)
(str/trim (:out proc)))))
(defn git-remote-origin [dir]
(not-empty (git dir "remote" "get-url" "origin")))
(defn git-first-remote [dir]
(some->> (git dir "remote" "-v")
str/split-lines
(keep #(re-matches #"^\w+\s+(.*)\s+\(fetch\)" %))
first
second))
(defn prepare-link [remote-url rev file-path & [line-start line-end]]
(let [parse-path #(some->> (re-matches % remote-url) second)
line-hash (cond
(nil? line-start) nil
(= line-start line-end) (str "#L" line-start)
(some? line-end) (str "#L" line-start "-L" line-end)
(nil? line-end) (str "#L" line-start))]
(some->>
(cond
(empty? remote-url) nil
(.contains remote-url "github.com:") ["https://github.com" (parse-path #".*github.com:(.*)\.git$") "blob" rev (str file-path line-hash)]
(.contains remote-url "github.com/") ["https://github.com" (parse-path #".*github.com/(.*)(\.git)?$") "blob" rev (str file-path line-hash)]
(.contains remote-url "gitlab.com:") ["https://gitlab.com" (parse-path #".*gitlab.com:(.*)\.git$") "-/blob" rev (str file-path line-hash)]
(.contains remote-url "gitlab.com/") ["https://gitlab.com" (parse-path #".*gitlab.com/(.*)(\.git)?$") "-/blob" rev (str file-path line-hash)]
(.contains remote-url "git.sr.ht:") ["https://git.sr.ht" (parse-path #".*git.sr.ht:(.*)\.git$") "tree" rev (str file-path line-hash)]
(.contains remote-url "git.sr.ht/") ["https://git.sr.ht" (parse-path #".*git.sr.ht/(.*)(\.git)?$") "tree" rev (str file-path line-hash)]
:else nil)
(remove nil?)
(str/join "/"))))
(defn git-current-rev [dir]
(let [commit (git dir "rev-parse" "--short" "HEAD")]
(when (not-empty (git dir "branch" "-r" "--contains" commit))
commit)))
#_ (todo add branch?)
#_ (defn git-current-branch [dir] )
(defn git-base-branch [dir]
(some->> (git dir "rev-parse" "--abbrev-ref" "origin/HEAD") :out
not-empty
(sh "basename") :out
not-empty))
(defn git-remote-url [dir file-path revision line-start line-end]
(some-> (or (git-remote-origin dir) (git-first-remote dir))
(prepare-link revision file-path line-start line-end)))
(defn git-root [path]
(let [file-dir (if (empty? path) "." (dirname path))]
(some->> (git file-dir "rev-parse" "--absolute-git-dir")
dirname)))
(defn cmd-link [[file-path line-start line-end rev]]
(let [dir (git-root file-path)
revision (or rev (git-current-rev dir) (git-base-branch dir) "main")
relative-file-path (str/trim (:out (sh "realpath" "--relative-to" dir file-path)))
remote-url (git-remote-url dir relative-file-path revision line-start line-end)]
(println remote-url)))
(def commands
{"link" cmd-link})
(let [[cmd & args] *command-line-args*]
(if-let [command-fn (commands cmd)]
(command-fn args)
(binding [*out* *err*]
(println (str "invalid command: " (or cmd "")))
(println (str "Valid commands: " (keys commands))))))
|
