code.framework
Source and test analysis foundation.
code.framework extracts namespace, function, docstring, line, and test metadata from source files. It is the analysis substrate below code management and documentation generation.
1 Motivation
Documentation and maintenance both need an index of what exists. code.framework creates that index by analysing source and test files and by connecting implementation forms with facts and docstrings.
2 How it is used
Use analyse for namespace-level source/test metadata, extract for function-level entries, and the link/cache helpers when repeated project-wide scans would be too expensive.
3 Internal usage
code.doc relies on framework-style analysis to build API tables. code.manage uses the same metadata to find missing tests, incomplete examples, orphaned references, and importable fact bodies.
4 Walkthrough
4.1 Parsing source and test files
code.framework turns raw source text into structured entries. analyse-source-code extracts namespace and function metadata from a source string, while analyse-test-code extracts fact metadata from a test string.
analyse a source snippet
(-> (fw/analyse-source-code "(ns example.core)\n\n(defn hello []\n 1)")
(get-in '[example.core hello]))
=> (contains {:ns 'example.core
:var 'hello
:source (contains {:code string?})})
create a selector for top-level forms
(fw/toplevel-selector 'hello)
=> vector?
detect the test framework in a namespace form
(fw/find-test-frameworks '(ns example
(:use code.test)))
=> #{:fact}
4.2 Analysing the current project
analyse and vars operate within the project context. They use the file lookup built by code.project to find source and test files.
analyse a namespace in the current project
(->> (project/in-context (fw/analyse 'code.framework))
(get-in [:source 'code.framework]))
=> map?
list vars in a project namespace
(project/in-context (fw/vars {:sorted true}))
=> (contains '[analyse
analyse-file
analyse-source-code])
4.3 End-to-end: locate code by query
locate-code parses a file and returns line information for every match of a structural query.
locate a structural pattern in a project file
(project/in-context (fw/locate-code 'code.framework
{:query '[defn]
:print {:result false :summary false}}))
=> vector?
5 API
- *toplevel-forms*
- all-string
- analyse
- analyse-file
- analyse-source-code
- analyse-source-entry
- analyse-source-function
- analyse-test-code
- compile-regex
- docstrings
- extract
- find-test-frameworks
- grep-replace
- grep-search
- import-selector
- locate-code
- no-test
- read-ns-form
- refactor-code
- search-regex
- toplevel-selector
- transform-code
- var-function
- vars
*toplevel-forms* ^
NONE
(def ^:dynamic *toplevel-forms*
'#{defn
defn.origin
defn.c
defn.js
defn.gl
defn.lua
defn.R
defn.py
defn.pg
defn.sql
defn.oracle
deftype.pg
deftype.sql
deftype.oracle
defenum.sql
defenum.oracle
defpolicy.pg
defn.sh
defn.sol
defn.xt
defgen.js
defgen.lua
defgen.py
defgen.xt
defmulti
defmacro
defmacro.!
defmacro.c
defmacro.js
defmacro.gl
defmacro.lua
defmacro.R
defmacro.pg
defmacro.py
defmacro.sh
defmacro.sol
defmacro.xt
defsingleton.xt
defsingleton.js
defcache
invoke/definvoke
defmemoize
deftask})
link
NONE
(defn- all-string [nav]
(def ^:dynamic *nav* nav)
(->> (iterate nav/right* nav)
(take 10)
(map #(doto % (-> nav/string prn)))
(map nav/string)
(std.string.common/joinl)
(println))
(f/error "oeoeu"))
link
analyse ^
[ns {:keys [output sorted], :as params} lookup project]
seed analyse function for the `code.manage/analyse` task
v 3.0
(defn analyse
([ns {:keys [output sorted] :as params} lookup project]
(let [path (lookup ns)
result (cache/fetch ns path)
nresult (or result
(and path (analyse-file [(project/file-type path) path])))
_ (if (nil? result)
(cache/update ns path nresult))
nresult (cond (and (nil? nresult)
(nil? path))
(cond (= type :test)
(res/result {:status :error
:data :no-test-file})
(= type :source)
(res/result {:status :error
:data :no-test-file}))
(= output :map)
nresult
(= output :vector)
(let [nresult (mapcat vals (vals nresult))]
(if (true? sorted)
(sort-by :var nresult)
(sort-by #(or (-> % :source :line :row)
(-> % :test :line :row)) nresult)))
:else
nresult)]
nresult)))
link
(->> (project/in-context (analyse 'code.framework-test)) (common/display-entry)) => (contains-in {:test {'code.framework (contains '[analyse analyse-file analyse-source-code])}}) (->> (project/in-context (analyse 'code.framework)) (common/display-entry)) => (contains-in {:source {'code.framework (contains '[analyse analyse-file analyse-source-code])}})
analyse-file ^
[[type path]]
analyzes a source or test file for namespace and function definitions, used as a helper for `analyse`
v 3.0
(invoke/definvoke analyse-file
[:recent {:compare (comp fs/last-modified second)}]
([[type path]]
(binding [common/*path* path]
(case type
:source (analyse-source-code (slurp path))
:test (analyse-test-code (slurp path))))))
link
(-> (analyse-file [:source "src/code/framework.clj"]) (common/display-entry)) => (contains-in {:source {'code.framework (contains '[analyse])}})
analyse-source-code ^
[s]
analyses a source file for namespace and function definitions
v 3.0
(defn analyse-source-code
([s]
(let [nav (-> (nav/parse-root s)
(nav/down))
nsp (-> (query/$ nav [(ns | _ & _)] {:walk :top})
first)
fns (->> (query/$* nav (toplevel-selector) {:return :zipper :walk :top})
(mapcat (partial analyse-source-entry nsp))
(into {}))]
(common/entry {nsp fns}))))
link
(-> (analyse-source-code (slurp "test-data/code.manage/src/example/core.clj")) (get-in '[example.core -foo-])) => (contains '{:ns example.core, :var -foo-, :source {:code "(defn -foo-n [x]n (println x "Hello, World!"))", :line {:row 3, :col 1, :end-row 6, :end-col 31}, :path nil}})
v 4.1
(defn analyse-source-entry
([nsp nav]
(let [[id entry :as pair] (analyse-source-function nsp nav)
head (-> nav nav/up nav/down nav/value)]
(if (and (symbol? head)
(= "defimpl" (name head)))
[pair
[(symbol (str "map->" id)) (assoc entry :var (symbol (str "map->" id)))]
[(symbol (str "->" id)) (assoc entry :var (symbol (str "->" id)))]]
[pair]))))
link
(->> (std.block.navigate/parse-string "(impl/defimpl Task [x] (toString [obj] "task"))") (std.block.navigate/down) (std.block.navigate/right) (analyse-source-entry 'foo) (map first)) => '(Task map->Task ->Task) (->> (std.block.navigate/parse-string "(defn foo [] 1)") (std.block.navigate/down) (std.block.navigate/right) (analyse-source-entry 'foo) (map first)) => '(foo)
analyse-source-function ^
[nsp nav]
analyzes a single function definition within a source file, used as a helper for `analyse-source-code`
v 3.0
(defn analyse-source-function
([nsp nav]
(let [id (nav/value nav)
line (-> nav nav/up nav/line-info)
nav (if (= :string (nav/tag (nav/right nav)))
(nav/delete-right nav)
nav)
nav (if (= :map (nav/tag (nav/right nav)))
(nav/delete-right nav)
nav)
code (-> nav nav/up nav/string)]
[id {:ns nsp
:var id
:source {:code code
:line line
:path common/*path*}}])))
link
(second (analyse-source-function 'foo (-> (std.block.navigate/parse-string "(defn foo [] 1)") (std.block.navigate/down) (std.block.navigate/right)))) => (contains {:var 'foo :source (contains {:code "(defn foo [] 1)"})})
v 3.0
(defn analyse-test-code
([s]
(let [nav (-> (nav/parse-root s)
(nav/down))
nsloc (query/$ nav [(ns | _ & _)] {:walk :top
:return :zipper
:first true})
nsp (nav/value nsloc)
ns-form (-> nsloc nav/up nav/value)
frameworks (find-test-frameworks ns-form)]
(->> frameworks
(map (fn [framework] (common/analyse-test framework nav)))
(apply collection/merge-nested)
(common/entry)))))
link
(-> (analyse-test-code (slurp "test-data/code.manage/test/example/core_test.clj")) (get-in '[example.core -foo-])) => (contains {:ns 'example.core :var '-foo- :test map? :meta {:added "3.0"} :intro ""})
v 3.0
(defn compile-regex
([obj]
(cond (f/regexp? obj) obj
(string? obj)
(f/-> (str obj)
(.replaceAll "\(" "\\(")
(.replaceAll "\(" "\\(")
(.replaceAll "\{" "\\{")
(.replaceAll "\}" "\\}")
(.replaceAll "\[" "\\[")
(.replaceAll "\]" "\\]")
(.replaceAll "\+" "\\+")
(.replaceAll "\*" "\\*")
(.replaceAll "\." "\\.")
(.replaceAll "\^" "\\^")
(.replaceAll "\$" "\\$")
(.replaceAll "\?" "\\?"))
:else (compile-regex (str obj)))))
link
(compile-regex "(:require") => "\\(:require"
docstrings ^
[ns {:keys [full sorted]} lookup project]
returns all docstrings in a given namespace with given keys
v 3.0
(defn docstrings
([ns {:keys [full sorted]} lookup project]
(let [ns (project/test-ns ns)
analysis (analyse ns {:output :vector :sorted sorted} lookup project)]
(cond (res/result? analysis) analysis
:else
(collection/map-juxt [(var-function full)
(comp docstring/->docstring :code :test)]
analysis)))))
link
(->> (project/in-context (docstrings)) (map first) sort) => (project/in-context (vars {:sorted true}))
extract ^
[ns {:keys [process], :as params} lookup project]
returns all vars in a given namespace
v 4.0
(defn extract
([ns {:keys [process] :as params} lookup project]
(let [path (lookup ns)
code (slurp path)
results (process code)]
(if (seq results)
results))))
link
(extract 'code.framework {:process identity} (project/file-lookup (project/project)) (project/project)) => string?
v 3.0
(defn find-test-frameworks
([ns-form]
(let [folio (atom #{})]
(walk/postwalk (fn [form]
(if-let [k (common/test-frameworks form)]
(swap! folio conj k)))
ns-form)
@folio)))
link
(find-test-frameworks '(ns ... (:use code.test))) => #{:fact} (find-test-frameworks '(ns ... (:use clojure.test))) => #{:clojure}
grep-replace ^
[ns {:keys [print query replace], :as params} lookup {:keys [root], :as project}]
replaces code based on string query
v 3.0
(defn grep-replace
([ns {:keys [print query replace] :as params} lookup {:keys [root] :as project}]
(let [query (compile-regex query)
transform-fn (fn [original]
(->> (clojure.string/split-lines original)
(map (fn [line] (clojure.string/replace line query replace)))
(clojure.string/join "n")))
params (assoc params :transform transform-fn)]
(transform-code ns params lookup project))))
link
(project/in-context (grep-replace {:query "docstrings" :replace "[DOCSTRINGS]" :print {:function true}}))
grep-search ^
[ns {:keys [print query], :as params} lookup {:keys [root], :as project}]
finds code based on string query
v 3.0
(defn grep-search
([ns {:keys [print query] :as params} lookup {:keys [root] :as project}]
(let [query (search-regex query)
path (lookup ns)
code (slurp path)
analysis (analyse ns params lookup project)
line-lu (common/line-lookup ns analysis)
lines (clojure.string/split-lines code)
results (keep (fn [[i line]]
(if-let [[_ start match] (re-find query line)]
(let [col (inc (count start))]
{:row i :end-row i
:col col
:end-col (+ col (count match))})))
(map vector (iterate inc 1) lines))]
(if (seq results)
(let [path (str (fs/relativize root path))]
(when (:function print)
(env/local :print (str "n" (ansi/style path #{:bold :blue :underline}) "nn"))
(env/local :print (text/->string results lines line-lu params) "n"))
results)))))
link
(project/in-context (grep-search {:query '[docstrings] :print {:function true}})) => seq?
v 3.0
(defn import-selector
([] (import-selector '_))
([var]
[(list *toplevel-forms* '| var '^:%?- string? '^:%?- map? '& '_)]))
link
(import-selector '-hello-) ;;[(#{} | -hello- string? map? & _)] => vector?
locate-code ^
[ns {:keys [print query], :as params} lookup {:keys [root], :as project}]
finds code base upon a query
v 3.0
(defn locate-code
([ns {:keys [print query] :as params} lookup {:keys [root] :as project}]
(let [path (lookup ns)
code (slurp path)
analysis (analyse ns params lookup project)
line-lu (common/line-lookup ns analysis)
results (->> (query/$* (nav/parse-root code)
query
{:return :zipper})
(mapv nav/line-info))]
(if (seq results)
(let [lines (clojure.string/split-lines code)
path (str (fs/relativize root path))]
(when (:function print)
(env/local :print (str "n" (ansi/style path #{:bold :blue :underline}) "nn"))
(env/local :print (text/->string results lines line-lu params) "n"))
results)))))
link
(project/in-context (locate-code {:query '[docstrings] :print {:function true}})) ;;[{:row 93, :col 28, :end-row 93, :end-col 40}] => vector?
v 4.0
(defn no-test
([ns params lookup project]
(let [source-file (lookup ns)
ns-form (read-ns-form source-file)]
(:no-test (meta ns-form)))))
link
(project/in-context (no-test 'code.framework)) => nil
v 4.0
(invoke/definvoke read-ns-form
[:recent {:compare fs/last-modified}]
([path]
(first (fs/read-code path))))
link
(read-ns-form "src/code/framework.clj") => (contains '(ns code.framework))
refactor-code ^
[ns {:keys [edits], :as params} lookup project]
takes in a series of edits and performs them on the code
v 3.0
(defn refactor-code
([ns {:keys [edits] :as params} lookup project]
(let [;;funcs (map +transform+ edits)
transform (fn [original]
(reduce (fn [text f]
(nav/root-string (f (nav/parse-root text))))
original
edits))
params (assoc params :transform transform)]
(transform-code ns params lookup project))))
link
(project/in-context (refactor-code {:edits []})) => {:changed [], :updated false, :verified true, :path "test/code/framework_test.clj"}
v 3.0
(defn search-regex
([obj]
(re-pattern (str "^(.*?)" "(" (compile-regex obj) ")"))))
link
(search-regex "hello") => #"^(.*?)(hello)"
v 3.0
(defn toplevel-selector
([] (toplevel-selector '_))
([var]
[(list *toplevel-forms* '| var '& '_)]))
link
(toplevel-selector '-hello-) ;;[(#{} | -hello- & _)] => vector?
transform-code ^
[ns {:keys [write print skip transform verify full no-analysis], :as params} lookup {:keys [root], :as project}]
transforms the code and performs a diff to see what has changed
v 3.0
(defn transform-code
([ns {:keys [write print skip transform verify full no-analysis] :as params} lookup {:keys [root] :as project}]
(cond skip
(let [path (lookup ns)
text (if (fs/exists? path) "" (slurp path))]
(spit path (transform text))
{:updated true :path path})
:else
(let [path (lookup ns)
params (assoc params :output :map)
[original analysis] (if (fs/exists? path)
[(slurp path) (if no-analysis
{}
(analyse ns params lookup project))]
["" {}])
revised (transform original)
verified (or (first (keep
(fn [[k f]]
(try
(f revised)
nil
(catch Throwable t
(env/prn t)
[k false])))
verify))
true)
deltas (if no-analysis
(text.diff/diff original revised)
(text/deltas ns analysis original revised))
path (str (fs/relativize root path))
updated (when (and write (seq deltas))
(spit (fs/path root path) revised)
true)
_ (when (and (:function print) (seq deltas))
(env/local :print (str "n" (ansi/style path #{:bold :blue :underline}) "nn"))
(env/local :print (text.diff/->string deltas) "n"))]
(cond-> (if no-analysis
(assoc (text.diff/summary deltas)
:changed (text.diff/get-lines deltas))
(text/summarise-deltas deltas))
full (assoc :deltas deltas)
:then (assoc :updated (boolean updated)
:verified verified
:path (str path)))))))
link
;; options include :skip, :full and :write (project/in-context (transform-code 'code.framework {:transform identity})) => (contains {:changed [] :updated false :path any})
v 3.0
(defn var-function
([full]
(fn [{:keys [ns var] :as m}]
(with-meta (if (true? full)
(symbol (str ns) (str var))
var)
m))))
link
((var-function true) {:ns 'hello :var 'world}) => 'hello/world ((var-function false) {:ns 'hello :var 'world}) => 'world
vars ^
[ns {:keys [full sorted], :as params} lookup project]
returns all vars in a given namespace
v 3.0
(defn vars
([ns {:keys [full sorted] :as params} lookup project]
(let [analysis (analyse ns {:output :vector :sorted sorted} lookup project)]
(cond (res/result? analysis)
analysis
:else
(mapv (var-function full) analysis)))))
link
(project/in-context (vars {:sorted true})) => (contains '[analyse analyse-file analyse-source-code analyse-source-entry analyse-source-function])
- *path*
- *test-examples*
- *test-full*
- +test-vars+
- analyse-test
- display-entry
- entry
- entry?
- gather-meta
- gather-string
- line-lookup
- test-frameworks
+test-vars+ ^
NONE
(def +test-vars+ #{:class :form :intro :line :ns :refer :test :unit :var
:let :use :replace :setup :teardown :id :check :sexp :examples})
link
analyse-test ^
serves as the entry point for analyzing test code, taking a test framework keyword and a parsed code structure
v 3.0
(defmulti analyse-test
(fn [type zloc] type))
link
(let [code "^{:refer code.manage/import :added "3.0"} (fact "imports a map" (import {:write true}) => nil)"] (analyse-test :fact (nav/parse-root code))) => (contains {'code.manage (contains {'import (contains {:intro "imports a map"})})})
v 3.0
(defn display-entry
([entry]
(reduce-kv (fn [out ns vars]
(reduce (fn [out [name {:keys [source test]}]]
(cond-> out
source (update-in [:source ns] (fnil #(conj % name) []))
test (update-in [:test ns] (fnil #(conj % name) []))))
out
(sort vars)))
{}
entry)))
link
(display-entry {:ns {:a {:test {} :source {}} :b {:test {}} :c {:source {}}}}) => {:source {:ns [:a :c]} :test {:ns [:a :b]}}
v 3.0
(defn entry
([m]
(map->Entry m)))
link
(entry {:ns {:a {:test {} :source {}} :b {:test {}} :c {:source {}}}}) ;;#code{:source {:ns [:a :c]}, :test {:ns [:a :b]}} => code.framework.common.Entry
v 3.0
(defn gather-meta
([nav]
(let [mta (cond
(-> nav nav/up nav/up nav/tag (= :meta))
(-> nav nav/up nav/left nav/value)
(-> nav nav/up nav/tag (= :meta))
(-> nav nav/left nav/value))]
(when-let [sym (or (:refer mta)
(:ref mta))]
(assoc mta
:refer sym
:ns (symbol (str (.getNamespace ^clojure.lang.Symbol sym)))
:var (symbol (name sym)))))))
link
(-> (nav/parse-string "^{:refer clojure.core/+ :added "1.1"}n(fact ...)") nav/down nav/right nav/down gather-meta) => '{:added "1.1", :ns clojure.core, :var +, :refer clojure.core/+}
v 3.0
(defn gather-string
([nav]
(block/block (->> (nav/value nav)
(clojure.string/split-lines)
(map-indexed (fn [i s]
(str (if (zero? i) "" " ")
(clojure.string/triml s))))
(clojure.string/join "n")))))
link
(-> (nav/parse-string ""hellonworldnalready"") (gather-string) (block/string)) => ""hellon worldn already""
v 3.0
(defn line-lookup
([ns analysis]
(reduce-kv (fn [out func {:keys [source test] :as attrs}]
(let [{:keys [row end-row]} (or (:line source)
(:line test))
row (if (:line test) (- row 1) row)]
(reduce (fn [out i]
(assoc out i func))
out
(range row (inc end-row)))))
{}
(get analysis (project/source-ns ns)))))
link
(line-lookup 'code.manage {'code.manage {'a {:source {:line {:row 10 :end-row 12}}} 'b {:test {:line {:row 20 :end-row 22}}}}}) => {10 'a 11 'a 12 'a 19 'b 20 'b 21 'b 22 'b}
- +default-config-file+
- +default-packages-file+
- +suffix-types+
- all-linkages
- collect
- collect-entries
- collect-entries-single
- collect-external-deps
- collect-internal-deps
- collect-linkages
- collect-transfers
- create-file-lookups
- file-linkage
- make-linkages
- make-project
- missing-entries
- overlapped-entries
- overlapped-entries-single
- read-packages
- select-manifest
all-linkages ^
[project] [tag project {:keys [packages], :as deploy}]
retrieves all linkages for a given project
v 4.0
(defn all-linkages
([project]
(all-linkages (:tag project)
project
(:deploy project)))
([tag project {:keys [packages] :as deploy}]
(let [tag (or tag :public)
{:keys [type repository collect]} (get-in deploy [:releases tag])
packages (collection/map-entries (fn [[k entry]]
[k (assoc entry :name k)])
packages)
lookups (create-file-lookups project)]
(code.framework.link/collect packages lookups project collect))))
link
(all-linkages (make-project)) => map?
collect ^
[] [packages lookups project] [packages lookups project {:keys [overlapped missing], :or {overlapped :error, missing :none}}]
collects comprehensive project information, including dependencies, exports, and imports, given package and file lookups
v 3.0
(defn collect
([]
(let [project (project/project)
lookups (create-file-lookups project)]
(collect (read-packages) lookups project)))
([packages lookups project]
(collect packages lookups project nil))
([packages lookups project {:keys [overlapped missing]
:or {overlapped :error
missing :none}}]
(let [packages (collect-entries packages lookups)
_ (let [entries (missing-entries packages lookups)]
(case missing
:warn (if (seq entries)
(print/println "Missing entries" entries))
:error (if (seq entries)
(throw (ex-info "Missing entries" {:entries entries})))
true))
_ (let [entries (overlapped-entries packages)]
(case overlapped
:warn (if (seq entries)
(print/println "Overlapped entries" entries))
:error (if (seq entries)
(throw (ex-info "Overlapped entries" {:entries entries})))
true))
packages (-> packages
(collect-linkages lookups)
(collect-internal-deps)
(collect-external-deps)
(collect-transfers lookups project))]
packages)))
link
(-> (collect -packages- -lookups- (project/project)) (get 'xyz.zcaudate/std.lib) ((comp sort keys))) => [:bundle :dependencies :description :entries :exports :files :imports :include :internal :name]
collect-entries ^
[packages lookups]
splits runtime namespaces into dedicated packages
v 4.0
(defn collect-entries
([packages lookups]
(collection/pmap-vals (fn [pkg]
(->> lookups
(mapcat (fn [[suffix lookup]]
(->> (collect-entries-single pkg lookup)
(map (partial vector suffix)))))
(set)
(assoc pkg :entries)))
packages)))
link
(let [entries (collect-entries -packages- -lookups-) hara-entries (set (get-in entries '[xyz.zcaudate/hara :entries])) postgres-entries (set (get-in entries '[xyz.zcaudate/postgres :entries])) solidity-entries (set (get-in entries '[xyz.zcaudate/solidity :entries])) nginx-entries (set (get-in entries '[xyz.zcaudate/hara.runtime.nginx :entries])) graal-entries (set (get-in entries '[xyz.zcaudate/hara.runtime.graal :entries])) jep-entries (set (get-in entries '[xyz.zcaudate/hara.runtime.jep :entries])) redis-entries (set (get-in entries '[xyz.zcaudate/hara.runtime.redis :entries]))] [(boolean (hara-entries [:clj 'hara.runtime.postgres])) (boolean (hara-entries [:clj 'hara.runtime.solidity])) (boolean (hara-entries [:clj 'hara.runtime.solidity.client])) (boolean (hara-entries [:clj 'hara.runtime.graal])) (boolean (hara-entries [:clj 'hara.runtime.jep])) (boolean (hara-entries [:clj 'hara.runtime.redis])) (boolean (hara-entries [:clj 'hara.runtime.nginx])) (boolean (hara-entries [:clj 'hara.runtime.nginx.config])) (boolean (hara-entries [:clj 'xt.lang.common-lib])) (boolean (postgres-entries [:clj 'postgres.core])) (boolean (postgres-entries [:clj 'hara.runtime.postgres])) (boolean (solidity-entries [:clj 'solidity.core])) (boolean (solidity-entries [:clj 'hara.runtime.solidity])) (boolean (solidity-entries [:clj 'hara.runtime.solidity.client])) (boolean (nginx-entries [:clj 'hara.runtime.nginx])) (boolean (nginx-entries [:clj 'hara.runtime.nginx.config])) (boolean (graal-entries [:clj 'hara.runtime.graal])) (boolean (jep-entries [:clj 'hara.runtime.jep])) (boolean (redis-entries [:clj 'hara.runtime.redis])) (contains? entries 'xyz.zcaudate/xtalk.lang) (contains? entries 'xyz.zcaudate/hara.runtime.solidity)]) => [false false false false false false false false true true true true true true true true true true true false false]
collect-entries-single ^
[package lookup]
supports subtree exclusions when collecting package entries
v 4.0
(defn collect-entries-single
([package lookup]
(let [nsps (keys lookup)]
(mapcat (fn [[ns type select]]
(case type
:base (filter (fn [sym] (or (= sym ns)
(.startsWith (str sym)
(str ns ".base."))))
nsps)
:complete (filter (fn [sym] (or (= sym ns)
(.startsWith (str sym)
(str ns "."))))
nsps)
:exclude (filter (fn [sym]
(and (or (= sym ns)
(.startsWith (str sym)
(str ns ".")))
(not-any? (fn [excluded]
(or (= sym excluded)
(.startsWith (str sym)
(str excluded "."))))
select)))
nsps)
(throw (ex-info "Not supported." {:type type
:options [:base
:complete
:exclude]}))))
(:include package)))))
link
(->> (collect-entries-single '{:include [[foo :exclude [foo.bar]]]} '{foo "" foo.alpha "" foo.bar "" foo.bar.baz "" foo.baz ""}) (set)) => '#{foo foo.alpha foo.baz}
v 3.0
(defn collect-external-deps
([packages]
(collection/pmap-vals (fn [{:keys [dependencies] :as package}]
(->> dependencies
(map (fn [artifact]
(let [rep (artifact/artifact :rep artifact)
version (if (empty? (:version rep))
(deps/current-version rep)
(:version rep))]
(artifact/artifact :coord (assoc rep :version version)))))
(assoc package :dependencies)))
packages)))
link
(collect-external-deps '{:a {:dependencies [org.clojure/clojure]}}) => (contains-in {:a {:dependencies [['org.clojure/clojure string?]]}})
v 3.0
(defn collect-internal-deps
([packages]
(let [packages (collection/pmap-vals (fn [{:keys [name imports] :as package}]
(->> (dissoc packages name)
(keep (fn [[k {:keys [exports]}]]
(if-not (empty? (clojure.set/intersection imports exports))
k)))
(set)
(assoc package :internal)))
packages)
;; CHECKS FOR CONSISTENCY
_ (sort/topological-sort (collection/pmap-vals :internal packages))]
packages)))
link
(-> -packages- (collect-entries -lookups-) (collect-linkages -lookups-) (collect-internal-deps) (get-in ['xyz.zcaudate/code.test :internal]) sort) => (contains '[xyz.zcaudate/code.project xyz.zcaudate/std.fs xyz.zcaudate/std.lib] :in-any-order :gaps-ok) (-> -packages- (collect-entries -lookups-) (collect-linkages -lookups-) (collect-internal-deps) (->> (collection/map-vals :internal)))
v 3.0
(defn collect-linkages
([packages lookups]
(collection/pmap-vals (fn [{:keys [entries] :as package}]
(->> entries
(map (fn [entry]
(file-linkage (get-in lookups entry))))
(apply merge-with clojure.set/union)
(merge package)))
packages)))
link
(-> -packages- (collect-entries -lookups-) (collect-linkages -lookups-) (get 'xyz.zcaudate/std.lib) (select-keys [:imports :exports])) => map?
v 3.0
(defn collect-transfers
([packages lookups project]
(collection/pmap-vals (fn [{:keys [entries bundle] :as package}]
(let [efiles (map (fn [[suffix ns :as entry]]
(let [file (get-in lookups entry)]
[file (str (-> (str ns)
(.replaceAll "\." "/")
(.replaceAll "-" "_"))
"."
(name suffix))]))
entries)
bfiles (mapcat (fn [{:keys [include path]}]
(mapcat (fn [b]
(let [base (fs/path (:root project) path)]
(->> (fs/select (fs/path base b)
{:include [fs/file?]})
(map (juxt str #(str (fs/relativize base %)))))))
include))
bundle)]
(assoc package :files (concat efiles bfiles))))
packages)))
link
(-> -packages- (collect-entries -lookups-) (collect-linkages -lookups-) (collect-internal-deps) (collect-transfers -lookups- (project/project)) (get-in '[xyz.zcaudate/std.lib :files]) sort) => coll?
v 3.0
(defn create-file-lookups
([project]
(collection/pmap-vals (fn [suffix]
(project/all-files (:source-paths project)
{:include [suffix]}
project))
+suffix-types+)))
link
(-> (create-file-lookups (project/project)) (get-in [:clj 'std.lib.version])) => (str (fs/path "src/std/lib/version.clj"))
v 3.0
(defn file-linkage
([path]
(common/file-linkage-fn path
(-> (fs/path path)
(fs/attributes)
(:last-modified-time)))))
link
(file-linkage "src/code/framework/link/common.clj") => '{:exports #{[:class code.framework.link.common.FileInfo] [:clj code.framework.link.common]}, :imports #{[:clj std.fs] [:clj std.lib.invoke]}}
make-linkages ^
[project] [tag project {:keys [packages], :as deploy}]
creates a map of linkages for a given project
v 3.0
(defn make-linkages
([project]
(make-linkages (:tag project)
project
(:deploy project)))
([tag project {:keys [packages] :as deploy}]
(let [{:keys [manifest]} (get-in deploy [:releases tag])]
(-> (all-linkages tag project deploy)
(select-manifest manifest)))))
link
(make-linkages (make-project)) => map?
v 3.0
(defn make-project
([]
(make-project nil))
([_]
(let [project (project/project)]
(assoc project
:deploy (or (config/resolve (:deploy project))
(config/load +default-config-file+))))))
link
(make-project) => map?
v 3.0
(defn missing-entries
([packages lookups]
(reduce (fn [lookups {:keys [entries]}]
(reduce (fn [lookups entry]
(collection/dissoc-nested lookups entry))
lookups
entries))
(reduce-kv (fn [out k v]
(if (empty? v) out (assoc out k v)))
{}
lookups)
(vals packages))))
link
(missing-entries '{b {:name b :entries #{[:clj hara.1] [:clj hara.2]}}} '{:clj {hara.1 "" hara.2 "" hara.3 ""}}) => '{:clj {hara.3 ""}}
v 3.0
(defn overlapped-entries
([packages]
(loop [[x & rest] (vals packages)
heap []
overlaps []]
(cond (nil? x)
overlaps
:else
(let [ols (overlapped-entries-single x heap)]
(recur rest
(conj heap x)
(concat overlaps ols)))))))
link
(overlapped-entries '{a {:name a :entries #{[:clj hara.1]}} b {:name b :entries #{[:clj hara.1] [:clj hara.2]}}}) => '([#{a b} #{[:clj hara.1]}])
v 3.0
(defn overlapped-entries-single
([x heap]
(keep (fn [{:keys [name entries]}]
(let [ol (clojure.set/intersection (:entries x)
entries)]
(if (seq ol)
[#{name (:name x)} ol])))
heap)))
link
(overlapped-entries-single '{:name a :entries #{[:clj hara.1]}} '[{:name b :entries #{[:clj hara.1] [:clj hara.2]}}]) => '([#{a b} #{[:clj hara.1]}])
read-packages ^
[] [{:keys [root file], :as input}]
reads a list of packages from a configuration file (e.g., 'config/packages.edn')
v 3.0
(defn read-packages
([]
(read-packages {:root "."
:file +default-packages-file+}))
([{:keys [root file] :as input}]
(let [path (fs/path root file)]
(if (fs/exists? path)
(->> (read-string (slurp path))
(collection/map-entries (fn [[k entry]]
[k (assoc entry :name k)])))
(throw (ex-info "Path does not exist" {:path path
:input input}))))))
link
(-> (read-packages {:file "config/packages.edn"}) (get 'xyz.zcaudate/std.lib)) => (contains {:description string? :name 'xyz.zcaudate/std.lib})
v 3.0
(defn select-manifest
([packages manifest]
(if (= manifest :all)
packages
(let [find-deps (fn find-deps
[lookup deps entry]
(when-not (get @deps entry)
(swap! deps conj entry)
(doseq [e (get lookup entry)]
(find-deps lookup deps e))))
deps (atom #{})
lookup (collection/map-vals :internal packages)
_ (doseq [entry manifest]
(find-deps lookup deps entry))]
(select-keys packages @deps)))))
link
(select-manifest {:a {:internal #{:b}} :b {:internal #{:c}} :c {:internal #{}} :d {:internal #{}}} [:a]) => {:a {:internal #{:b}} :b {:internal #{:c}} :c {:internal #{}}}
- *memory*
- *memory-loaded*
- +cache-dir+
- +cache-suffix+
- fetch
- file-modified?
- init-memory!
- prepare-in
- prepare-out
- purge
- update
fetch ^
[ns file-path] [ns file-path current cache-dir]
reads a the file or gets it from cache
v 3.0
(defn fetch
([ns file-path]
(fetch ns file-path *memory* +cache-dir+))
([ns file-path current cache-dir]
(if-not @*memory-loaded* (init-memory!))
(let [entry (get @current ns)]
(if (and entry
(not (file-modified? ns file-path current cache-dir)))
(:data entry)))))
link
(with-redefs [fs/exists? (constantly false) fs/create-directory (constantly nil) fs/select (constantly [])] (fetch 'code.manage "src/code/manage.clj")) => (any map? nil?)
file-modified? ^
[ns file-path] [ns file-path current cache-dir]
checks if code file has been modified from the cache
v 3.0
(defn file-modified?
([ns file-path]
(file-modified? ns file-path *memory* +cache-dir+))
([ns file-path current cache-dir]
(if (and file-path (fs/exists? file-path))
(let [file-modified (fs/last-modified file-path)
entry (get @current ns)
changed (not= file-modified
(:file-modified entry))]
changed))))
link
(file-modified? 'code.manage "src/code/manage.clj") => boolean?
v 3.0
(defn init-memory!
([] (init-memory! *memory* +cache-dir+))
([current cache-dir]
(if (not (fs/exists? cache-dir))
(fs/create-directory cache-dir))
(let [files (fs/select cache-dir {:include [fs/file?]})
[run? output] (atom/swap-return!
*memory-loaded*
(fn [v] (if (nil? v)
[true (promise)]
[false v]))
true)]
(if run?
(->> (pmap (fn [file]
(let [{:keys [meta] :as data} (try (read-string (slurp file))
(catch Throwable t))
data (if data
(common/entry (prepare-in (dissoc data :meta))))
{:keys [file-modified namespace]} meta
cache-modified (fs/last-modified file)]
(when data
(swap! current assoc namespace {:cache-modified cache-modified
:file-modified file-modified
:data data})
namespace)))
files)
(vec)
(deliver output)))
@output)))
link
(let [memory (atom {}) loaded (atom nil)] (with-redefs [fs/exists? (constantly true) fs/select (constantly ["file1"]) slurp (constantly "{:meta {:namespace code.manage :file-modified 100} code.manage {var {:test {:code "(+ 1 2)"}}}}") fs/last-modified (constantly 200) *memory-loaded* loaded] (init-memory! memory "cache") (-> @memory (get-in ['code.manage :data 'code.manage 'var :test :code]) first block/string))) => "(+ 1 2)"
v 3.0
(defn prepare-in
([data]
(collection/map-vals
(fn [ns-entry]
(collection/map-vals
(fn [entry]
(if (-> entry :test :code)
(update-in entry
[:test :code]
(comp vec block/children block/parse-root))
entry))
ns-entry))
data)))
link
(-> (prepare-in '{ns {var {:test {:code "(+ 1 2 3)"}}}}) (get-in '[ns var :test :code]) (first) (block/value)) => '(+ 1 2 3)
v 3.0
(defn prepare-out
([data]
(collection/map-vals
(fn [ns-entry]
(collection/map-vals
(fn [entry]
(if (-> entry :test :code)
(update-in entry
[:test :code]
(comp block/string block/root))
entry))
ns-entry))
data)))
link
(prepare-out {'ns {'var {:test {:code [(block/block '(1 2 3))]}}}}) => '{ns {var {:test {:code "(1 2 3)"}}}}
v 3.0
(defn purge
([]
(purge *memory*))
([current]
(reset! *memory* {})
(reset! *memory-loaded* nil)))
link
(let [memory (atom {:a 1}) loaded (atom true)] (with-redefs [*memory* memory *memory-loaded* loaded] (purge) [@memory @loaded]) => [{} nil])
update ^
[ns file-path data] [ns file-path data current cache-dir cache-suffix]
updates values to the cache
v 3.0
(defn update
([ns file-path data]
(update ns file-path data *memory* +cache-dir+ +cache-suffix+))
([ns file-path data current cache-dir cache-suffix]
(if (and ns
(file-modified? ns file-path current cache-dir))
(let [file-modified (fs/last-modified file-path)
cache-path (fs/path cache-dir (str ns cache-suffix))
_ (spit cache-path (assoc (prepare-out data)
:meta {:file-modified file-modified
:namespace ns}))
cache-modified (fs/last-modified cache-path)]
(swap! current assoc ns {:cache-modified cache-modified
:file-modified file-modified
:data data})))))
link
(let [memory (atom {})] (with-redefs [file-modified? (constantly true) fs/last-modified (constantly 100) fs/path (constantly "cache/path") spit (fn [_ _] nil)] (update 'code.manage "src/code/manage.clj" {'code.manage {'var {:test {:code [(block/parse-string "(+ 1 2)")]}}}} memory "cache" ".cache") (let [entry (get @memory 'code.manage)] {:cache-modified (:cache-modified entry) :file-modified (:file-modified entry) :code (-> entry (get-in [:data 'code.manage 'var :test :code]) first block/string)})) => {:cache-modified 100 :file-modified 100 :code "(+ 1 2)"})
v 3.0
(defn ->docstring
([nodes]
(->> nodes
(mapv (fn [block]
(-> (->docstring-tag block)
(prose/escape-escapes)
(prose/escape-quotes))))
(strip-quotes)
(common/joinl))))
link
(->> (nav/parse-root "n (+ 1 2)n => 3") (nav/down) (iterate zip/step-right) (take-while zip/get) (map zip/get) (->docstring)) => "n (+ 1 2)n => 3" (->docstring [(block/block e)]) => "'e'"
v 3.0
(defn ->docstring-node
([intro nodes]
(let [docstring (->docstring nodes)
docstring (-> (str intro docstring)
(clojure.string/trim))
docstring (clojure.string/split-lines docstring)]
(->> docstring
(map-indexed (fn [i s]
(str (if-not (or (zero? i)
(= i (dec (count nodes))))
" ")
s)))
(clojure.string/join "n")
(block/block)))))
link
(->> (nav/navigator [e d newline]) (zip/step-inside) (iterate zip/step-right) (take-while zip/get) (map zip/get) (->docstring-node "") (block/value)) => "'e' 'd' 'n '"
v 3.0
(defn ->docstring-tag
([block]
(cond (= :string (block/tag block))
(block/string block)
(= :char (block/tag block))
(str "'" (str (block/value block)) "'")
:else
(block/string block))))
link
(->docstring-tag (block/block c)) => "'c'"
v 3.0
(defn ->refstring
([docs]
(->> docs
(map (fn [node]
(let [res (block/string node)]
(cond (and (not (block/void? node))
(not (block/comment? node))
(not (block/modifier? node))
(string? (block/value node)))
(prose/escape-newlines res)
:else res))))
(common/joinl))))
link
(->> (nav/parse-root ""hello"n (+ 1 2)n => 3") (iterate zip/step-right) (take-while zip/get) (map zip/get) (->refstring)) => ""hello"n (+ 1 2)n => 3"
v 3.0
(defn append-node
([nav node]
(if node
(-> nav
(zip/step-right)
(zip/insert-right node)
(zip/insert-right (block/space))
(zip/insert-right (block/space))
(zip/insert-right (block/newline))
(zip/step-left))
nav)))
link
(-> (nav/parse-string "(+)") (zip/step-inside) (append-node 2) (append-node 1) (nav/root-string)) => "(+n 1n 2)"
insert-docstring ^
[nav nsp gathered]
inserts the meta information and docstring from tests
v 3.0
(defn insert-docstring
([nav nsp gathered]
(let [sym (nav/value nav)
intro (get-in gathered [nsp sym :intro])
nodes (get-in gathered [nsp sym :test :code])
meta (get-in gathered [nsp sym :meta])
docstring (if (or intro nodes)
(->docstring-node intro nodes))
nav (cond-> nav
meta (append-node meta)
docstring (append-node docstring))]
nav)))
link
(insert-docstring (nav/parse-string "(defn foo [])") 'ns {'ns {'foo {:intro "intro" :test {:code "code"}}}}) => nav/navigator?
strip-quotes ^
[arr] [[x & more] p1 p2 out]
utility that strips quotes when not the result of a fact
v 3.0
(defn strip-quotes
([arr] (strip-quotes arr nil nil []))
([[x & more] p1 p2 out]
(cond (nil? x)
out
:else
(recur more x p1 (conj out (if (= p2 "=>")
(if (prose/has-quotes? x)
(prose/escape-newlines x)
x)
(prose/strip-quotes x)))))))
link
(strip-quotes [""hello""]) => ["hello"] (strip-quotes ["(str "hello")" " " "=>" " " ""hello""]) => ["(str "hello")" " " "=>" " " ""hello""]