Skip to content

Commit

Permalink
Add support for recursive submodule resulution
Browse files Browse the repository at this point in the history
  • Loading branch information
@julienvincent
julienvincent committed Oct 30, 2023
1 parent b4c174d commit f00c279
Show file tree
Hide file tree
Showing 2 changed files with 96 additions and 48 deletions.
123 changes: 83 additions & 40 deletions src/k16/kl/api/resolver.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@

(:sha data)))

(defn- resolve-module-sha [{:keys [url sha ref subdir]
(defn- resolve-module-ref [{:keys [url sha ref subdir]
:or {ref "master"}}]

(when-not sha
Expand All @@ -32,54 +32,97 @@
(cond-> {:url url :sha sha :ref ref}
subdir (assoc :subdir subdir))))

(defn- resolve-modules [{:keys [module lock force-resolve?]}]
(defn- resolve-module [partial-reference]
(let [module-ref (resolve-module-ref partial-reference)
module (resolver.downloader/download-module-config module-ref)]
{:ref module-ref
:module module}))

(defn- resolve-modules-tree [{:keys [module lock force-resolve?] :as props}]
(->> (:modules module)
(map (fn [[submodule-name location]]
(p/vthread
(let [lock-entry (get lock submodule-name)

should-resolve?
(or (not (:sha lock-entry))

(and (:sha location) (not= (:sha location) (:sha lock-entry)))
(and (:ref location) (not= (:ref location) (:ref lock-entry)))
(and (:subdir location) (not= (:subdir location) (:subdir lock-entry)))

force-resolve?)]
(if should-resolve?
[submodule-name (resolve-module-sha location)]
[submodule-name lock-entry])))))
doall
(map (fn [promise] @promise))
(map
(fn [[submodule-name partial-ref]]
(p/vthread
(let [lock-entry (get lock submodule-name)
current-reference (:ref lock-entry)

should-resolve?
(or (not (:sha current-reference))

(and (:sha partial-ref) (not= (:sha partial-ref) (:sha current-reference)))
(and (or (:ref partial-ref) "master") (not= (:ref partial-ref) (:ref current-reference)))
(and (:subdir partial-ref) (not= (:subdir partial-ref) (:subdir current-reference)))

force-resolve?)]

(if should-resolve?
(let [{:keys [module ref]} (resolve-module partial-ref)
submodules (resolve-modules-tree (assoc props :module module))]
[submodule-name {:ref ref :module module :submodules submodules}])
[submodule-name lock-entry])))))
p/all
deref
(into {})))

(defn- deduplicate-tree [{:keys [tree result]
:or {result {}}}]
(->> tree
(reduce
(fn [result [module-name entry]]
(if-not (contains? result module-name)
(deduplicate-tree
{:tree (:submodules entry)
:result (assoc result module-name entry)})
result))
result)))

(defn- tree->lock [tree]
(->> tree
(reduce
(fn [lock [module-name entry]]
(assoc lock module-name
{:ref (:ref entry)
:submodules (tree->lock (:submodules entry))}))
{})))

(defn- tree->modules [tree]
(->> tree
(reduce
(fn [lock [module-name entry]]
(assoc lock module-name (:ref entry)))
{})))

(defn- resolve-modules [props]
(let [tree (resolve-modules-tree props)
tree' (deduplicate-tree {:tree tree})]
{:lock (tree->lock tree')
:modules (tree->modules tree')}))

(defn pull! [module-name {:keys [update-lockfile? force?]}]
(let [module (api.fs/read-edn (api.fs/get-root-module-file module-name))
lock (api.fs/read-edn (api.fs/get-lock-file module-name))

modules (resolve-modules {:module module
:lock lock
:force-resolve? update-lockfile?})
current-lock (api.fs/read-edn (api.fs/get-lock-file module-name))

lockfile-updated? (not= modules lock)
{:keys [lock modules]}
(resolve-modules {:module module
:lock current-lock
:force-resolve? update-lockfile?})

downloads (when (or lockfile-updated? force?)
(->> modules
(map (fn [[submodule-name module]]
(p/vthread
(resolver.downloader/download-remote-module!
{:module-name module-name
:submodule-name (name submodule-name)
:module module}))))

doall))]
lockfile-updated? (not= lock current-lock)]

(when lockfile-updated?
(api.fs/write-edn (api.fs/get-lock-file module-name) modules))

(when downloads
(doseq [download downloads]
@download))
(api.fs/write-edn (api.fs/get-lock-file module-name) lock))

(when (or lockfile-updated? force?)
(->> modules
(map (fn [[submodule-name module-ref]]
(p/vthread
(resolver.downloader/download-remote-module!
{:module-name module-name
:submodule-name (name submodule-name)
:module-ref module-ref}))))

p/all
deref))

{:modules modules
:lockfile-updated? lockfile-updated?}))
21 changes: 13 additions & 8 deletions src/k16/kl/api/resolver/downloader.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,9 +31,17 @@
(str/replace acc (str "{{" (name key) "}}") value))
contents)))

(defn download-remote-module! [{:keys [module-name submodule-name module]}]
(defn download-module-config
([module-ref] (download-module-config module-ref {}))
([{:keys [url sha subdir] :or {subdir ".kl"}} vars]
(-> (read-repo-file url sha (relative-to subdir "module.edn"))
(replace-vars vars)
edn/read-string)))

(defn download-remote-module! [{:keys [module-name submodule-name module-ref]}]
(let [{:keys [sha url subdir]
:or {subdir ".kl"}} module
:or {subdir ".kl"}} module-ref

sha-short (subs sha 0 7)

submodule-dir (-> (api.fs/from-submodule-dir module-name submodule-name)
Expand All @@ -45,17 +53,14 @@

(log/info (str "Downloading " url "@" sha-short))

(let [config (-> (read-repo-file url sha (relative-to subdir "module.edn"))
(replace-vars vars)
edn/read-string)]

(let [module (download-module-config module-ref vars)]
@(p/all
(->> (:include config)
(->> (:include module)
(map (fn [file]
(p/vthread
(log/info (str "Downloading " file " [" submodule-name "]"))
(let [contents (-> (read-repo-file url sha (relative-to subdir file))
(replace-vars vars))]
(spit (api.fs/from-submodule-dir module-name submodule-name file) contents)))))))

(api.fs/write-edn (api.fs/from-submodule-dir module-name submodule-name "module.edn") config))))
(api.fs/write-edn (api.fs/from-submodule-dir module-name submodule-name "module.edn") module))))

0 comments on commit f00c279

Please sign in to comment.