reorganized repo and added git-interactive-sparse-clone

Author: tionis

git-tools/git-interactive-sparse-checkout renamed to git-tools/cli/git-interactive-sparse-checkout.janet

@@ -1,4 +1,4 @@
 #!/bin/env janet
-(use ./interactive-sparse-checkout)
+(use ../interactive-sparse-checkout)
 (defn main [_ & args]
   (interactive-sparse-checkout))

git-tools/cli/git-interactive-sparse-clone.janet

@@ -0,0 +1,20 @@
+#!/bin/env janet
+(import spork/argparse :prefix "")
+(use ../interactive-sparse-clone)
+
+(def argparse-params
+  [`Clone repo and sparse check it out interactively`
+   "ref" {:kind :option
+          :short "r"
+          :default "origin/main"
+          :help "Ref to check out"}
+   :default {:kind :accumulate
+             :help "remote to clone and optionally a path to clone it to"}])
+
+(defn main [_ remote & args]
+  (def res (argparse ;argparse-params))
+  (unless res (os/exit 1))
+
+  (interactive-sparse-clone (first (res :default))
+                            :ref (res "ref")
+                            :path (get (res :default) 1 nil)))

git-tools/git-repl renamed to git-tools/cli/git-repl.janet

@@ -1,4 +1,4 @@
 #!/bin/env janet
-(use ./repl)
+(use ../repl)
 (defn main [& _]
   (repl))

git-tools/interactive-sparse-checkout.janet

@@ -16,12 +16,22 @@
       ret)
     [])) # Ignore top level or empty paths
 
-(defn interactive-sparse-checkout []
+(defn interactive-sparse-checkout
+  `Interactivly select paths to sparse checkout in a git repo using a fuzzy file selection ui
+  ref optionally defines the reference to use to look up the tree of files and later checkout
+  git-repo-path optionally passes the repo directory and is passed to git via the -C option`
+  [&named ref git-repo-path]
+  (default ref "HEAD")
+  (def extra-git-opts @[])
+  (when git-repo-path
+    (array/push extra-git-opts "-C")
+    (array/push extra-git-opts git-repo-path))
   (def selected-paths @[])
   (def available-paths
-    (->> (sh/exec-slurp "git" "ls-tree" "--name-only" "-r" "-z" "HEAD")
+    (->> (sh/exec-slurp "git" ;extra-git-opts "ls-tree" "--name-only" "-r" "-z" ref)
          (string/split "\0")
          (mapcat filter-and-split-paths-into-components)
          (distinct)))
-  (exec "git" "sparse-checkout" "set" ;(jeff/choose available-paths :multi true))
-  (exec "git" "checkout" "HEAD"))
+  # TODO support second ui that allows specifying patterns and shows the matching files in a second window or smth like that
+  (exec "git" ;extra-git-opts "sparse-checkout" "set" ;(jeff/choose available-paths :multi true))
+  (exec "git" ;extra-git-opts "checkout" ref))

git-tools/interactive-sparse-clone.janet

@@ -0,0 +1,17 @@
+#!/bin/env janet
+#(import spork/path)
+#(import spork/sh)
+(import ./remote)
+(use ./interactive-sparse-checkout)
+(use ./exec)
+
+(defn interactive-sparse-clone [remote &named path ref]
+  (default path (remote/get-name remote))
+  (default ref "origin/main")
+
+  (os/mkdir path)
+  (exec "git" "-C" path "init")
+  (exec "git" "-C" path "remote" "add" "origin" remote)
+  (exec "git" "-C" path "fetch" "--depth" "1" "origin" "HEAD")
+  (exec "git" "-C" path "fetch")
+  (interactive-sparse-checkout :git-repo-path path :ref ref))

git-tools/remote.janet

@@ -0,0 +1,34 @@
+(import uri)
+(import ./string)
+
+(def remote-scp-peg
+  (peg/compile
+    ~{:user (capture (to "@"))
+      :host (capture (to ":"))
+      :path-part (* (capture (to (+ "/" -1))) (+ "/" -1))
+      :path (replace (some :path-part)
+                     ,(fn [& x] x))
+      :main (replace (* :user "@" :host ":" :path)
+                     ,|{:user $0
+                        :host $1
+                        :path $2})}))
+
+(defn- remote/parse
+  `Parse remote url into it's components`
+  [remote]
+  (def peg-res (first (peg/match remote-scp-peg remote)))
+  (if peg-res
+    {:scheme "scp" :host (peg-res :host) :path (peg-res :path) :user (peg-res :user)}
+    (let [uri-res (uri/parse remote)]
+      {:scheme (uri-res :scheme)
+       :host (uri-res :host)
+       :user (uri-res :userinfo)
+       :path (first (peg/match ~{:path-part (* (capture (to (+ "/" -1))) (+ "/" -1))
+                                  :main (replace (* (opt "/") (some :path-part))
+                                                 ,(fn [& x] x))}
+                               (uri-res :path)))})))
+
+(defn get-name [remote]
+  (string/trim-suffix ".git" (last ((remote/parse remote) :path))))
+
+(setdyn 'parse (dyn 'remote/parse))

git-tools/string.janet

@@ -0,0 +1,13 @@
+(defn trim-prefix
+  "Trim the specified prefix of a string if it has one"
+  [prefix str]
+  (if (string/has-prefix? prefix str)
+    (slice str (length prefix) -1)
+    str))
+
+(defn trim-suffix
+  "Trim the specified suffix of a string if it has one"
+  [suffix str]
+  (if (string/has-suffix? suffix str)
+    (slice str 0 (* -1 (+ 1 (length suffix))))
+    str))

project.janet

@@ -8,10 +8,10 @@
   :url "https://tasadar.net/tionis/git-tools"
   :repo "git+https://tasadar.net/tionis/git-tools")
 
-(each f (filter |(peg/match ~(sequence "git-" (any 1) -1) $0) (os/dir "git-tools"))
+(each f (os/dir "git-tools/cli")
   (declare-executable # Install janet git tools
-    :name f
-    :entry (string "git-tools/" f)
+    :name (first (peg/match ~(* (* (capture (any (* (not ".janet") 1))) ".janet") -1) f))
+    :entry (string "git-tools/cli/" f)
     :install true))
 
 (each f (os/dir "bin") # Install shell scripts
@@ -25,6 +25,7 @@
     :is-janet false))
 
 (each f (if (os/stat "man") (os/dir "man") [])
+  # TODO auto generate from module doc if not exists?
   (declare-manpage # Install man pages
     (string "man/" f)))