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* ^

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

all-string ^

[nav]

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]
Added 3.0

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]]
Added 3.0

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]
Added 3.0

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}})

analyse-source-entry ^

[nsp nav]
Added 4.1

expands `defimpl` forms with constructor entries

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]
Added 3.0

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)"})})

analyse-test-code ^

[s]
Added 3.0

analyses a test file for docstring forms

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 ""})

compile-regex ^

[obj]
Added 3.0

compiles a regex string from an input string

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]
Added 3.0

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]
Added 4.0

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?

find-test-frameworks ^

[ns-form]
Added 3.0

find test frameworks given a namespace form

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}]
Added 3.0

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}]
Added 3.0

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?

import-selector ^

[] [var]
Added 3.0

creates an import selector

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}]
Added 3.0

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?

no-test ^

[ns params lookup project]
Added 4.0

checks that a namespace does not require test

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

read-ns-form ^

[path]
Added 4.0

memoised version of fs/read-ns

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]
Added 3.0

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"}

search-regex ^

[obj]
Added 3.0

constructs a search regex (for line numbers)

v 3.0
(defn search-regex
  ([obj]
   (re-pattern (str "^(.*?)" "(" (compile-regex obj) ")"))))
link
(search-regex "hello") => #"^(.*?)(hello)"

toplevel-selector ^

[] [var]
Added 3.0

creates a selector for querying toplevel forms

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}]
Added 3.0

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})

var-function ^

[full]
Added 3.0

constructs a var, with or without namespace

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]
Added 3.0

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* ^

NONE
(def ^:dynamic *path* nil)
link

*test-examples* ^

NONE
(def ^:dynamic *test-examples* false)
link

*test-full* ^

NONE
(def ^:dynamic *test-full* false)
link

+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 ^

Added 3.0

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"})})})

display-entry ^

[entry]
Added 3.0

creates a map represenation of the entry

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]}}

entry ^

[m]
Added 3.0

creates an entry for analysis

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

entry? ^

[x]
Added 3.0

checks if object is an entry

v 3.0
(defn entry?
  ([x]
   (instance? Entry x)))
link
(entry? (entry {})) => true

gather-meta ^

[nav]
Added 3.0

gets the metadata for a particular form

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/+}

gather-string ^

[nav]
Added 3.0

creates correctly spaced code string from normal docstring

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""

line-lookup ^

[ns analysis]
Added 3.0

creates a function lookup for the project

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}

test-frameworks ^

Added 3.0

lists the framework that a namespace uses

v 3.0
(defmulti test-frameworks
  (fn [sym] sym))
link
(test-frameworks 'code.test) => :fact (test-frameworks 'clojure.test) => :clojure


+default-config-file+ ^

NONE
(def +default-config-file+)
link

+default-packages-file+ ^

NONE
(def +default-packages-file+)
link

+suffix-types+ ^

NONE
(def +suffix-types+)
link

all-linkages ^

[project] [tag project {:keys [packages], :as deploy}]
Added 4.0

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}}]
Added 3.0

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]
Added 4.0

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]
Added 4.0

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}

collect-external-deps ^

[packages]
Added 3.0

collects dependencies from the local system

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?]]}})

collect-internal-deps ^

[packages]
Added 3.0

collects all internal dependencies

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)))

collect-linkages ^

[packages lookups]
Added 3.0

collects all imports and exports of a package

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?

collect-transfers ^

[packages lookups project]
Added 3.0

collects all files that are packaged

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?

create-file-lookups ^

[project]
Added 3.0

creates file-lookups for clj, cljs and cljc files

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"))

file-linkage ^

[path]
Added 3.0

returns the exports and imports of a given file

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}]
Added 3.0

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?

make-project ^

[] [_]
Added 3.0

makes a maven compatible project

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?

missing-entries ^

[packages lookups]
Added 3.0

finds missing entries given packages and lookup

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 ""}}

overlapped-entries ^

[packages]
Added 3.0

finds any overlapped entries for given map

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]}])

overlapped-entries-single ^

[x heap]
Added 3.0

finds any overlaps between entries

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}]
Added 3.0

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})

select-manifest ^

[packages manifest]
Added 3.0

selects all related manifests

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* ^

NONE
(defonce ^:dynamic *memory* (atom {}))
link

*memory-loaded* ^

NONE
(defonce ^:dynamic *memory-loaded* (atom nil))
link

+cache-dir+ ^

NONE
(defonce +cache-dir+)
link

+cache-suffix+ ^

NONE
(defonce +cache-suffix+)
link

fetch ^

[ns file-path] [ns file-path current cache-dir]
Added 3.0

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]
Added 3.0

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?

init-memory! ^

[] [current cache-dir]
Added 3.0

initialises memory with cache files

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)"

prepare-in ^

[data]
Added 3.0

prepares input string to code blocks

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)

prepare-out ^

[data]
Added 3.0

prepares code block for output

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)"}}}}

purge ^

[] [current]
Added 3.0

clears all entries from the cache

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]
Added 3.0

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)"})


->docstring ^

[nodes]
Added 3.0

converts nodes to a docstring

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'"

->docstring-node ^

[intro nodes]
Added 3.0

converts nodes to a docstring node

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 '"

->docstring-tag ^

[block]
Added 3.0

converts a string representation of block

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'"

->refstring ^

[docs]
Added 3.0

creates a refstring for use in html blocks

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"

append-node ^

[nav node]
Added 3.0

adds node as well as whitespace and newline on right

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]
Added 3.0

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]
Added 3.0

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""]