diff --git a/src/k16/kl/api/resolver.clj b/src/k16/kl/api/resolver.clj index ef24947..f160b05 100644 --- a/src/k16/kl/api/resolver.clj +++ b/src/k16/kl/api/resolver.clj @@ -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 @@ -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?})) diff --git a/src/k16/kl/api/resolver/downloader.clj b/src/k16/kl/api/resolver/downloader.clj index 463aa7a..7411b13 100644 --- a/src/k16/kl/api/resolver/downloader.clj +++ b/src/k16/kl/api/resolver/downloader.clj @@ -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) @@ -45,12 +53,9 @@ (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 "]")) @@ -58,4 +63,4 @@ (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))))