[ { "path": ".gitignore", "content": "/target/*\n/.idea/*\n.nrepl-port\nautochrome.iml\n" }, { "path": "LICENSE", "content": "Eclipse Public License - v 1.0\n\nTHE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC\nLICENSE (\"AGREEMENT\"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM\nCONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.\n\n1. DEFINITIONS\n\n\"Contribution\" means:\n\na) in the case of the initial Contributor, the initial code and documentation\n distributed under this Agreement, and\nb) in the case of each subsequent Contributor:\n i) changes to the Program, and\n ii) additions to the Program;\n\n where such changes and/or additions to the Program originate from and are\n distributed by that particular Contributor. A Contribution 'originates'\n from a Contributor if it was added to the Program by such Contributor\n itself or anyone acting on such Contributor's behalf. Contributions do not\n include additions to the Program which: (i) are separate modules of\n software distributed in conjunction with the Program under their own\n license agreement, and (ii) are not derivative works of the Program.\n\n\"Contributor\" means any person or entity that distributes the Program.\n\n\"Licensed Patents\" mean patent claims licensable by a Contributor which are\nnecessarily infringed by the use or sale of its Contribution alone or when\ncombined with the Program.\n\n\"Program\" means the Contributions distributed in accordance with this\nAgreement.\n\n\"Recipient\" means anyone who receives the Program under this Agreement,\nincluding all Contributors.\n\n2. GRANT OF RIGHTS\n a) Subject to the terms of this Agreement, each Contributor hereby grants\n Recipient a non-exclusive, worldwide, royalty-free copyright license to\n reproduce, prepare derivative works of, publicly display, publicly\n perform, distribute and sublicense the Contribution of such Contributor,\n if any, and such derivative works, in source code and object code form.\n b) Subject to the terms of this Agreement, each Contributor hereby grants\n Recipient a non-exclusive, worldwide, royalty-free patent license under\n Licensed Patents to make, use, sell, offer to sell, import and otherwise\n transfer the Contribution of such Contributor, if any, in source code and\n object code form. This patent license shall apply to the combination of\n the Contribution and the Program if, at the time the Contribution is\n added by the Contributor, such addition of the Contribution causes such\n combination to be covered by the Licensed Patents. The patent license\n shall not apply to any other combinations which include the Contribution.\n No hardware per se is licensed hereunder.\n c) Recipient understands that although each Contributor grants the licenses\n to its Contributions set forth herein, no assurances are provided by any\n Contributor that the Program does not infringe the patent or other\n intellectual property rights of any other entity. Each Contributor\n disclaims any liability to Recipient for claims brought by any other\n entity based on infringement of intellectual property rights or\n otherwise. As a condition to exercising the rights and licenses granted\n hereunder, each Recipient hereby assumes sole responsibility to secure\n any other intellectual property rights needed, if any. For example, if a\n third party patent license is required to allow Recipient to distribute\n the Program, it is Recipient's responsibility to acquire that license\n before distributing the Program.\n d) Each Contributor represents that to its knowledge it has sufficient\n copyright rights in its Contribution, if any, to grant the copyright\n license set forth in this Agreement.\n\n3. REQUIREMENTS\n\nA Contributor may choose to distribute the Program in object code form under\nits own license agreement, provided that:\n\n a) it complies with the terms and conditions of this Agreement; and\n b) its license agreement:\n i) effectively disclaims on behalf of all Contributors all warranties\n and conditions, express and implied, including warranties or\n conditions of title and non-infringement, and implied warranties or\n conditions of merchantability and fitness for a particular purpose;\n ii) effectively excludes on behalf of all Contributors all liability for\n damages, including direct, indirect, special, incidental and\n consequential damages, such as lost profits;\n iii) states that any provisions which differ from this Agreement are\n offered by that Contributor alone and not by any other party; and\n iv) states that source code for the Program is available from such\n Contributor, and informs licensees how to obtain it in a reasonable\n manner on or through a medium customarily used for software exchange.\n\nWhen the Program is made available in source code form:\n\n a) it must be made available under this Agreement; and\n b) a copy of this Agreement must be included with each copy of the Program.\n Contributors may not remove or alter any copyright notices contained\n within the Program.\n\nEach Contributor must identify itself as the originator of its Contribution,\nif\nany, in a manner that reasonably allows subsequent Recipients to identify the\noriginator of the Contribution.\n\n4. COMMERCIAL DISTRIBUTION\n\nCommercial distributors of software may accept certain responsibilities with\nrespect to end users, business partners and the like. While this license is\nintended to facilitate the commercial use of the Program, the Contributor who\nincludes the Program in a commercial product offering should do so in a manner\nwhich does not create potential liability for other Contributors. Therefore,\nif a Contributor includes the Program in a commercial product offering, such\nContributor (\"Commercial Contributor\") hereby agrees to defend and indemnify\nevery other Contributor (\"Indemnified Contributor\") against any losses,\ndamages and costs (collectively \"Losses\") arising from claims, lawsuits and\nother legal actions brought by a third party against the Indemnified\nContributor to the extent caused by the acts or omissions of such Commercial\nContributor in connection with its distribution of the Program in a commercial\nproduct offering. The obligations in this section do not apply to any claims\nor Losses relating to any actual or alleged intellectual property\ninfringement. In order to qualify, an Indemnified Contributor must:\na) promptly notify the Commercial Contributor in writing of such claim, and\nb) allow the Commercial Contributor to control, and cooperate with the\nCommercial Contributor in, the defense and any related settlement\nnegotiations. The Indemnified Contributor may participate in any such claim at\nits own expense.\n\nFor example, a Contributor might include the Program in a commercial product\noffering, Product X. That Contributor is then a Commercial Contributor. If\nthat Commercial Contributor then makes performance claims, or offers\nwarranties related to Product X, those performance claims and warranties are\nsuch Commercial Contributor's responsibility alone. Under this section, the\nCommercial Contributor would have to defend claims against the other\nContributors related to those performance claims and warranties, and if a\ncourt requires any other Contributor to pay any damages as a result, the\nCommercial Contributor must pay those damages.\n\n5. NO WARRANTY\n\nEXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN\n\"AS IS\" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR\nIMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE,\nNON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each\nRecipient is solely responsible for determining the appropriateness of using\nand distributing the Program and assumes all risks associated with its\nexercise of rights under this Agreement , including but not limited to the\nrisks and costs of program errors, compliance with applicable laws, damage to\nor loss of data, programs or equipment, and unavailability or interruption of\noperations.\n\n6. DISCLAIMER OF LIABILITY\n\nEXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY\nCONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL,\nSPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION\nLOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN\nCONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)\nARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE\nEXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY\nOF SUCH DAMAGES.\n\n7. GENERAL\n\nIf any provision of this Agreement is invalid or unenforceable under\napplicable law, it shall not affect the validity or enforceability of the\nremainder of the terms of this Agreement, and without further action by the\nparties hereto, such provision shall be reformed to the minimum extent\nnecessary to make such provision valid and enforceable.\n\nIf Recipient institutes patent litigation against any entity (including a\ncross-claim or counterclaim in a lawsuit) alleging that the Program itself\n(excluding combinations of the Program with other software or hardware)\ninfringes such Recipient's patent(s), then such Recipient's rights granted\nunder Section 2(b) shall terminate as of the date such litigation is filed.\n\nAll Recipient's rights under this Agreement shall terminate if it fails to\ncomply with any of the material terms or conditions of this Agreement and does\nnot cure such failure in a reasonable period of time after becoming aware of\nsuch noncompliance. If all Recipient's rights under this Agreement terminate,\nRecipient agrees to cease use and distribution of the Program as soon as\nreasonably practicable. However, Recipient's obligations under this Agreement\nand any licenses granted by Recipient relating to the Program shall continue\nand survive.\n\nEveryone is permitted to copy and distribute copies of this Agreement, but in\norder to avoid inconsistency the Agreement is copyrighted and may only be\nmodified in the following manner. The Agreement Steward reserves the right to\npublish new versions (including revisions) of this Agreement from time to\ntime. No one other than the Agreement Steward has the right to modify this\nAgreement. The Eclipse Foundation is the initial Agreement Steward. The\nEclipse Foundation may assign the responsibility to serve as the Agreement\nSteward to a suitable separate entity. Each new version of the Agreement will\nbe given a distinguishing version number. The Program (including\nContributions) may always be distributed subject to the version of the\nAgreement under which it was received. In addition, after a new version of the\nAgreement is published, Contributor may elect to distribute the Program\n(including its Contributions) under the new version. Except as expressly\nstated in Sections 2(a) and 2(b) above, Recipient receives no rights or\nlicenses to the intellectual property of any Contributor under this Agreement,\nwhether expressly, by implication, estoppel or otherwise. All rights in the\nProgram not expressly granted under this Agreement are reserved.\n\nThis Agreement is governed by the laws of the State of New York and the\nintellectual property laws of the United States of America. No party to this\nAgreement will bring a legal action under this Agreement more than one year\nafter the cause of action arose. Each party waives its rights to a jury trial in\nany resulting litigation.\n" }, { "path": "README.md", "content": "# autochrome\n\nAutochrome is a program for structurally diffing and highlighting clojure source code. It generates diffs as static HTML from\ngithub pull requests or local git repos. For more information, some examples, and a description of how it works, please see\n[the HTML readme](https://fazzone.github.io/autochrome.html)\n (generated from [readme.clj](https://github.com/ladderlife/autochrome/blob/master/src/autochrome/readme.clj)).\n\n## Usage\n### From local git repo:\n```\n$ lein run --open --git-dir /path/to/repo []\n```\n- `old-ref` and `new-ref` are just like the arguments to `git diff`\n- `--open` tries to open the diff in a browser. With no arguments you get HTML on stdout.\n- `-o ` also works.\n\n### From github:\n```\n$ lein run -o diff.html # write a diff for a GitHub pull request\n$ lein run --token user:123abc # use supplied auth token for github api\n```\n## License\n\nCopyright © 2018 Ladder Financial, Inc.\n\nDistributed under the Eclipse Public License either version 1.0 or (at\nyour option) any later version.\n" }, { "path": "project.clj", "content": "(defproject autochrome \"0.1.0-SNAPSHOT\"\n :description \"FIXME: write description\"\n :url \"http://example.com/FIXME\"\n :license {:name \"Eclipse Public License\"\n :url \"http://www.eclipse.org/legal/epl-v10.html\"}\n :dependencies [[org.clojure/clojure \"1.8.0\"]\n [hiccup \"1.0.5\"]\n [org.omcljs/om \"1.0.0-beta1\"]\n [garden \"1.3.3\"]\n [cheshire \"5.8.0\"]\n [clj-http \"3.7.0\"]\n [org.clojure/tools.cli \"0.3.5\"]\n [com.climate/claypoole \"1.1.4\"]\n ;; explicit dependency on jaxb-api for java 9 compatibility\n [javax.xml.bind/jaxb-api \"2.3.0\"]]\n :main autochrome.core\n :target-path \"target/%s\"\n :profiles {:uberjar {:aot :all}})\n" }, { "path": "src/autochrome/align.clj", "content": "(ns autochrome.align\n (:require [autochrome.diff :as diff])\n (:import [java.util IdentityHashMap Map]))\n\n(defn get-diffs\n [source-forms target-forms]\n (let [prep (diff/diff-prep source-forms target-forms)\n ^IdentityHashMap hashes (:hashes prep)\n ^IdentityHashMap sizes (:sizes prep)\n\n hash->source-form (zipmap (map #(.get hashes %) source-forms) source-forms)\n ^IdentityHashMap matched-forms (IdentityHashMap.)\n unmatched? #(not (.containsKey matched-forms %))]\n\n (doseq [tf target-forms]\n (when-let [sf (hash->source-form (.get hashes tf))]\n (.put matched-forms tf :matched)\n (.put matched-forms sf :matched)))\n\n (loop [diffs []\n [the-source & sources] (filterv unmatched? source-forms)\n targets (filterv unmatched? target-forms)]\n (cond\n (and (nil? the-source) (empty? targets))\n diffs\n\n (nil? the-source)\n (concat diffs\n (for [t targets]\n [nil t (doto (IdentityHashMap.) (.put t :added))]))\n\n (empty? targets)\n (concat diffs\n (for [s (cons the-source sources)]\n [s nil (doto (IdentityHashMap.) (.put s :deleted))]))\n\n :else\n (let [goal (diff/dforms the-source (cons nil targets) hashes sizes)\n the-target (diff/get-target goal)]\n (.put matched-forms the-target :matched)\n (recur\n (conj diffs [the-source the-target (diff/diffstate->annotations goal)])\n sources\n (filter unmatched? targets)))))))\n" }, { "path": "src/autochrome/annotation.clj", "content": "(ns autochrome.annotation\n (:require [autochrome.common :as clj-common]\n [autochrome.scope :as scope]\n [autochrome.tree :as tree]\n [autochrome.xref :as xref])\n (:import [java.util IdentityHashMap]))\n\n(defn attach\n [{:keys [type text delim wscontents] :as form} ann]\n (let [a (.get ann form)\n rec (cond\n (or (= type :coll)\n (= type :reader-conditional)\n (= type :reader-conditional-splicing)\n (clj-common/decoration? form))\n (assoc form :wscontents (mapv #(attach % ann) wscontents))\n\n (= type :quote)\n (assoc form :val (list (attach (first (:val form)) ann)))\n\n (= type :lambda)\n (assoc form :text (attach text ann))\n\n :else form)]\n (cond-> rec\n a (assoc :annotation a))))\n\n(defn annotated?\n [form ann]\n (or\n (.get ann form)\n (when-let [children (tree/->children form)]\n (loop [[c & cs] children]\n (when c\n (if (annotated? c ann)\n true\n (recur cs)))))))\n\n(defn syntax-highlighting\n [form]\n (let [ann (IdentityHashMap.)]\n (scope/execute-writer\n (scope/walk-with-scope\n form\n (fn [c f]\n (if-let [sym (scope/form->real-symbol c f)]\n (.put ann f\n (let [locally-bound (get (:scope c) sym)\n qual (scope/qualify-symbol c f)]\n (cond\n (get (:scope c) sym)\n :local\n\n (and (nil? qual) (xref/javadoc-link (:text f)))\n :java-class\n\n (and (symbol? qual) (= \"clojure.core\" (namespace qual)))\n :core\n\n :else sym)))\n (when (some-> f :text (.startsWith \".\"))\n (.put ann f :java-class))))\n scope/default-context))\n ann))\n" }, { "path": "src/autochrome/common.clj", "content": "(ns autochrome.common)\n\n(def ^:const special-forms\n [\"def\" \"do\" \"loop\" \"if\" \"new\" \"fn\" \"try\" \"catch\" \"throw\" \"finally\"\n \"recur\" \"quote\" \"set!\"])\n\n(def special-form? (set special-forms))\n\n(def open->closed\n {\\( \\)\n \\[ \\]\n \\{ \\}\n \"#{\" \\}})\n\n(def closed->open\n {\\) \\(\n \\] \\[\n \\} \\{})\n\n(defn decoration?\n [{:keys [type]}]\n (or (= type :deref)\n (= type :syntax-quote)\n (= type :unquote)\n (= type :unquote-splicing)\n (= type :data-reader)\n (= type :meta)))\n\n(defn ->decorator\n [{:keys [type] :as arg}]\n (case type\n :deref \"@\"\n :syntax-quote \"`\"\n :unquote \"~\"\n :unquote-splicing \"~@\"\n (throw (ex-info \"what\" {:arg arg}))))\n\n(def core-scope\n (delay\n (->> (ns-publics 'clojure.core)\n (keys)\n (map (fn [s] [s (symbol (name 'clojure.core) (name s))]))\n ;; def is a special form\n (into\n (->> (mapv symbol special-forms)\n (map (fn [s] [s (symbol (name 'clojure.core) (name s))]))\n (into {}))))))\n\n(defn clojure-core-scope\n []\n @core-scope)\n" }, { "path": "src/autochrome/components.clj", "content": "(ns autochrome.components\n (:require [autochrome.common :as clj-common :refer [special-form? open->closed]]\n [autochrome.parse :as parse]\n [autochrome.xref :as xref]\n [om.dom :as dom :refer [span]]))\n\n(defmacro defcomponent\n [name & [[props children] & body]]\n `(defn ~name [& args#]\n (let [[~props & ~children] args#]\n ~@body)))\n\n(defn xref-clojure-core\n [text]\n (let [macro? (or (some-> text symbol resolve meta :macro)\n (special-form? text))]\n (dom/a {:href (xref/clojure-core-link text)}\n (span {:className (if macro? \"macro clojure-core\" \"clojure-core\")}\n text))))\n\n(defn xref-java\n [text]\n (let [link (xref/javadoc-link text)]\n (cond->> (dom/span {:className \"java-class\"} text)\n link (dom/a {:href link}))))\n\n(defcomponent symbol-component\n [{a :annotation :keys [text xref] :as the-form} _]\n ;; not much to do here now\n (if xref\n (dom/a {:href xref} (symbol-component (dissoc the-form :xref)))\n (cond\n (nil? a) text\n ;; do something more interesting with locals?\n (= :local a) text\n (= :java-class a) (xref-java text)\n (= :core a) (xref-clojure-core text)\n (= :broken a) (span {:className \"unparsed\"} text)\n (= :shead a) (span {:className \"shead\"} text)\n (= :thead a) (span {:className \"thead\"} text)\n (keyword? a) (span {:className (str (name a))} text)\n (namespace a) (dom/span {} (dom/span {:className \"ns-ref\"} (namespace a))\n \"/\" (dom/span {:className \"var-ref\"} (name a)))\n (symbol? a) (dom/span {:className \"var-ref\"} text)\n :else (throw (ex-info \"unrecognized annotation\" the-form)))))\n\n(defn meta-class\n [mf]\n (let [[c & more] (:contents mf)]\n (cond\n more \"meta\"\n\n (= (:type c) :symbol)\n (if (some-> c :text first Character/isUpperCase)\n \"java-class\"\n \"var-ref\")\n\n (= (:type c) :keyword) \"meta-keyword\"\n :else \"meta\")))\n\n(defcomponent form\n [{:keys [type text annotation] :as the-form} _]\n (let [form-annotation? (contains? #{:added :deleted :shead :thead} annotation)\n the-form (cond-> the-form form-annotation? (dissoc :annotation))\n rendered\n (case type\n :newline (span \"\\n\")\n :ws (if (= :comment (:subtype the-form))\n (span {:className \"comment\"} text)\n text)\n :symbol (symbol-component the-form)\n\n :keyword (span {:className \"keyword\"} text)\n :string (span {:className \"string\"} text)\n :data-reader (span {:className \"metadata\"}\n \"#\"\n (:text the-form)\n (mapv form (:wscontents the-form)))\n :regex (span {} \"#\" (span {:className \"string\"} text))\n :char-literal (span {:className \"string\"} text)\n :quote (span {} \"'\" (form (first (:val the-form))))\n :var-quote (span {:className \"var-ref\"} \"#'\" text)\n\n (:deref :syntax-quote :unquote :unquote-splicing)\n (span {} (clj-common/->decorator the-form)\n (mapv form (:wscontents the-form)))\n\n :hash-under\n (span {:className \"comment\"}\n (parse/render-dup the-form))\n\n :coll\n (let [left (str (:delim the-form))\n right (str (open->closed (:delim the-form)))\n inner (mapv form (:wscontents the-form))]\n (cond\n (= :parens-added annotation)\n (span {} (span {:className \"added\"} left)\n (conj inner (span {:className \"added\"} right)))\n\n (= :parens-deleted annotation)\n (span {} (span {:className \"deleted\"} left)\n (conj inner (span {:className \"deleted\"} right)))\n\n :else (span {} left (conj inner right))))\n\n :lambda\n (span {} \"#\" (form (:text the-form)))\n\n :reader-conditional\n (span {} \"#?(\" (mapv form (:wscontents the-form)) \")\")\n\n :reader-conditional-splicing\n (span {} \"#?@(\" (mapv form (:wscontents the-form)) \")\")\n\n :meta\n (span {:className (meta-class the-form)}\n \"^\" (mapv form (:wscontents the-form)))\n\n (span {:className \"unparsed\"} (pr-str the-form)))]\n (cond->> rendered\n form-annotation? (dom/span {:className (str (name annotation))}))))\n\n(defn line-numbers\n [{:keys [lines start-line linkbase] :as the-form :or {linkbase \"hahaha\"}}]\n (for [i (range start-line (+ start-line lines))]\n (cond->> (dom/div {} (str i))\n linkbase (dom/a {:href (str linkbase i)}))))\n\n(defcomponent code\n [{:keys [lines start-line linkbase things annotation id] :as the-form} children]\n (dom/div\n {:className \"code-card\"\n :id id}\n (dom/div {:className \"code-card-heading\"}\n (first children)\n (dom/div {:className \"code-card-heading-extra\"} (rest children)))\n (dom/div {:className \"container\"}\n (dom/pre {:className \"gutter\"}\n (dom/code {:className \"punctuation\"} (line-numbers the-form)))\n (dom/div {:style {:width \"1px\"}})\n (dom/pre\n {:className\n (cond-> \"source\"\n annotation (str \" \" (name annotation)))}\n (for [th things]\n (if (map? th) (form th) th))))))\n\n(defcomponent top-level-comment\n [{:keys [lines start-line text] :as the-form} _]\n (dom/div\n {:className \"code-card top-comment\"}\n (dom/div {:className \"container\"}\n (dom/pre {:className \"gutter\"}\n (dom/code\n {:className \"punctuation\"}\n (line-numbers the-form)))\n (dom/div {:style {:width \"1px\"}})\n (dom/pre {:className \"source\"}\n (dom/span {:className \"comment\"} text)))))\n\n(defcomponent panes\n [props children]\n (let [[left right] children]\n (dom/div\n {:style {:display \"flex\"\n :flex-direction \"row\"}}\n (dom/div {:className \"diffpane\"} left)\n (dom/div {:className \"diffpane\"} right))))\n\n(defcomponent root\n [_ children]\n (dom/div\n {:style {:display \"flex\"\n :flex-direction \"column\"}}\n children))\n\n(defn heading\n [text]\n (dom/div {:className \"filename-heading\"} text))\n\n(defn spacer\n []\n (dom/div {:className \"spacer\"}))\n" }, { "path": "src/autochrome/core.clj", "content": "(ns autochrome.core\n (:require [autochrome.diff :as diff]\n [autochrome.github :as github]\n [autochrome.page :as page]\n [clojure.java.io :as io]\n [clojure.tools.cli :as cli])\n (:import [java.awt Desktop]\n [java.io File])\n (:gen-class))\n\n(def cli-options\n [[nil \"--open\" \"If set, write HTML to a temp file and try to open it in a browser\"]\n [\"-t\" \"--token TOKEN\" \"github api bearer auth token e.g. username:123abcdef\"]\n [\"-o\" \"--output FILE\" \"output filename\"]\n [nil \"--clojure-only\" \"only show clojure diffs\"]\n [nil \"--git-dir PATH\" \"path to the git repo\"]])\n\n(defn do-main\n [& args]\n (let [{:keys [options arguments]} (cli/parse-opts args cli-options)\n [a b c] arguments\n the-page (binding [github/*auth-token* (:token options)\n page/*clojure-only* (:clojure-only options)\n github/*git-dir* (or (:git-dir options) \".\")]\n (cond\n c (page/pull-request-diff a b (Integer/parseInt c))\n b (page/local-diff a b)\n a (page/local-diff-work-tree a)))\n output-file (if (:output options)\n (io/file (:output options))\n (File/createTempFile \"diff\" \".html\"))]\n (binding [*out* *err*] (println 'processed @diff/nprocessed 'states))\n (if-not the-page\n (println \"expected 2 or 3 args [treeA treeB] or [owner repo pr-id] \")\n (spit output-file the-page))\n (if (and (:open options) (Desktop/isDesktopSupported))\n (.browse (Desktop/getDesktop)\n (.toURI output-file))\n (when-not (:output options)\n (io/copy output-file *out*)))))\n\n(defn -main\n [& args]\n (apply do-main args)\n (shutdown-agents))\n" }, { "path": "src/autochrome/diff.clj", "content": "(ns autochrome.diff\n (:require [autochrome.tree :as tree])\n (:import [clojure.lang Util]\n [java.util HashMap PriorityQueue IdentityHashMap]))\n\n(set! *warn-on-reflection* true)\n\n(defn compare-vectors-by-identity\n [a b]\n (let [na (count a)]\n (if-not (= na (count b))\n false\n (loop [i 0]\n (if (= i na)\n true\n (when (identical? (nth a i) (nth b i))\n (recur (inc i))))))))\n\n(deftype DiffContext [prevsources prevtargets]\n ;; `prevsources` and `prevtargets` are basically two independent stacks\n Object\n (hashCode [this]\n (Util/hashCombine\n (System/identityHashCode (peek prevsources))\n (System/identityHashCode (peek prevtargets))))\n (equals ^boolean [this that-obj]\n (let [^DiffContext that that-obj]\n (boolean\n (and (compare-vectors-by-identity (.-prevsources this) (.-prevsources that))\n (compare-vectors-by-identity (.-prevtargets this) (.-prevtargets that)))))))\n\n(deftype DiffState [cost source target context changes origtarget]\n ;; `source` and `target` are seqs, and we are diffing their heads\n ;; `cost` is the sum of the size of all the added or deleted nodes in this diff\n ;; `context` is how we know 'where we are' in the source & target structures\n ;; without context, we can't tell when we're finished, since all states\n ;; where source=target=nil would be indistinguishable.\n ;; `changes` is a vector of [form change] where change is :added, :deleted etc\n ;; `origtarget` is the whole target form we are diffing against\n Object\n (hashCode [this]\n (unchecked-add-int\n (.hashCode context)\n (unchecked-add-int (System/identityHashCode source)\n (System/identityHashCode target))))\n (equals [this that-obj]\n (let [^DiffState that that-obj]\n (and (identical? (.-source this) (.-source that))\n (identical? (.-target this) (.-target that))\n (.equals (.-context this) (.-context that)))))\n Comparable\n (compareTo [this that-obj]\n (let [^DiffState that that-obj]\n (- (.-cost this) (.-cost that)))))\n\n(defn get-target\n [^DiffState ds]\n (.-origtarget ds))\n\n;; for difflog\n(def explored-states (atom []))\n(def state-info (atom {}))\n(def nprocessed (atom 0))\n\n(defn diff-prep\n [sources targets]\n (let [hashes (IdentityHashMap.)\n sizes (IdentityHashMap.)]\n (doseq [f (concat sources targets)]\n (tree/put-hashes hashes f)\n (tree/put-sizes sizes f))\n {:hashes hashes :sizes sizes}))\n\n(defn dforms\n ([source targets]\n (let [{:keys [hashes sizes]} (diff-prep [source] targets)]\n (dforms source targets hashes sizes)))\n ([source targets ^IdentityHashMap hashes ^IdentityHashMap sizes]\n (let [real-cost (HashMap.)\n pq (PriorityQueue.)\n explore (fn [ncost ^DiffState predstate nsource ntarget nctx changes]\n (let [ds (DiffState. ncost nsource ntarget nctx changes (.-origtarget predstate))\n prev-cost (.get real-cost ds)]\n (swap! state-info update (System/identityHashCode ds) assoc :pred (System/identityHashCode predstate))\n (when (and (or (nil? prev-cost) (< ncost prev-cost)))\n (.put real-cost ds ncost)\n (.offer pq ds))))]\n (reset! explored-states [])\n (reset! state-info {})\n (doseq [t targets\n :let [start-state (DiffState. 0 (list source) (list t) (DiffContext. [] []) [] t)]]\n (.offer pq start-state)\n (.put real-cost start-state 0))\n (loop []\n (when-let [^DiffState c (.poll pq)]\n (swap! nprocessed inc)\n (swap! explored-states conj c)\n (let [[shead & smore :as sforms] (.-source c)\n [thead & tmore :as tforms] (.-target c)\n cost (.get real-cost c)\n ^DiffContext context (.-context c)\n prevsources (.-prevsources context)\n prevtargets (.-prevtargets context)]\n (swap! state-info update (System/identityHashCode c) update :attrib conj :popped)\n (if (and (nil? shead) (nil? thead) (empty? prevsources) (empty? prevtargets))\n c\n (let [ssize (.get sizes shead)\n tsize (.get sizes thead)]\n ;; if we can match subtrees, don't bother doing anything else\n (if (and shead thead (= (.get hashes shead) (.get hashes thead)))\n (explore cost c smore tmore context (.-changes c))\n (do\n (if shead\n ;; addition/deletion costs an extra point so that we prefer removing entire lists\n (explore (inc (+ cost ssize)) c smore tforms context (conj (.-changes c) [shead :deleted]))\n ;; if we are at the end of the source seq, pop back out if we can\n (when (not= 0 (count prevsources))\n (explore cost c (peek prevsources) tforms\n (DiffContext. (pop prevsources) prevtargets) (.-changes c))))\n\n (if thead\n ;; addition\n (explore (inc (+ cost tsize)) c sforms tmore context (conj (.-changes c) [thead :added]))\n ;; pop back out\n (when (not= 0 (count prevtargets))\n (explore cost c sforms (peek prevtargets)\n (DiffContext. prevsources (pop prevtargets)) (.-changes c))))\n\n ;; going into matching collections is not costless, again to prefer deleting entire lists\n (when (and (tree/branch? shead) (tree/branch? thead) (= (:delim shead) (:delim thead)))\n (explore (inc cost) c (tree/->children shead) (tree/->children thead)\n (DiffContext. (conj prevsources smore) (conj prevtargets tmore)) (.-changes c)))\n\n ;; going into source node corresponds to stripping a pair of parens\n (when (tree/branch? shead)\n (explore (+ 2 cost) c (tree/->children shead) tforms\n (DiffContext. (conj prevsources smore) prevtargets) (conj (.-changes c) [shead :parens-deleted])))\n\n ;; going into target node is wrapping with a new set of parens\n (when (and (tree/branch? thead))\n (explore (+ 2 cost) c sforms (tree/->children thead)\n (DiffContext. prevsources (conj prevtargets tmore)) (conj (.-changes c) [thead :parens-added])))))\n (recur)))))))))\n\n(defn diffstate->annotations\n [^DiffState dst]\n (let [ann (IdentityHashMap.)]\n (doseq [[ptr a] (.-changes dst)]\n (.put ann ptr a))\n ann))\n\n(defn diff-forms\n [source target]\n (diffstate->annotations (dforms source target)))\n" }, { "path": "src/autochrome/difflog.clj", "content": "(ns autochrome.difflog\n (:require [autochrome.annotation :as ann]\n [autochrome.components :as comp]\n [autochrome.diff :as diff]\n [autochrome.page :as page]\n [autochrome.parse :as parse]\n [om.dom :as dom]))\n\n(defn diff2\n [ann a b]\n (comp/panes\n {}\n (when a\n (page/render-top-level-form\n (ann/attach a (doto (ann/syntax-highlighting a) (.putAll ann)))))\n (when b\n (page/render-top-level-form\n (ann/attach b (doto (ann/syntax-highlighting b) (.putAll ann)))))))\n\n(defn diff-log\n [aroot broots]\n (let [goalstate (diff/dforms aroot broots)\n maxdigits (count (str (count @diff/explored-states)))]\n (for [index (range (count @diff/explored-states))\n :let [c (nth @diff/explored-states index)\n idhc (System/identityHashCode c)\n info (get @diff/state-info idhc)]]\n (let [shead (first (.-source c))\n thead (first (.-target c))]\n (dom/div\n {:id (str idhc)}\n (comp/heading\n (dom/span\n {:style {:font-size \"16px\"}}\n (str\n (format (str \"#%0\" maxdigits \"d \") index)\n (if (identical? c goalstate) \"goal! \" \"\")\n ; \"(\" (string/join \" \" (map name (:attrib info))) \")\"\n \" -\" (count (filter (comp #{:deleted :parens-deleted} second) (.-changes c)))\n \",+\" (count (filter (comp #{:added :parens-added} second) (.-changes c)))\n \" cost \" (.-cost c)\n ;; \"/\" (- (.-cost c) (max (.-sremain c) (.-tremain c)))\n ; \" remain \" (.-sremain c)\n ;\"/\" (.-tremain c)\n (if (nil? shead) \" (nil S)\" \"\")\n (if (nil? thead) \" (nil T)\" \"\"))\n #_(dom/span {} \" (\" (Integer/toHexString idhc) \" from \"\n (dom/a {:href (str \"#\" (:pred info))} (some-> (:pred info) Integer/toHexString))\n \")\")))\n (diff2\n (doto (diff/diffstate->annotations c)\n (.put shead :shead)\n (.put thead :thead))\n aroot\n (.-origtarget c))\n #_(comp/spacer))))))\n\n\n(defn write-difflog\n [title astr bstrs]\n (let [a (parse/parse-one astr)\n bs (map parse/parse-one bstrs)]\n (spit (str title \".html\")\n (page/page\n title\n (comp/root {}\n (diff-log a bs))))))\n\n(comment\n (write-difflog\n \"difflog2\"\n \"#:: {:foo :bar}\"\n [\"#::some-ns{:foo :bar}\"]))\n" }, { "path": "src/autochrome/github.clj", "content": "(ns autochrome.github\n (:require [clj-http.client :as http]\n [clojure.java.io :as io]\n [clojure.java.shell :as sh]\n [clojure.string :as string]))\n\n(def ^:dynamic *auth-token* nil)\n\n(defn pr-request-params\n [owner repo num]\n (let [url (format \"https://api.github.com/repos/%s/%s/pulls/%s\" owner repo num)]\n (cond-> {:method :get :url url :content-type :json}\n *auth-token* (assoc :basic-auth *auth-token*))))\n\n(defn pr-diffinfo\n [owner repo num]\n (let [params (pr-request-params owner repo num)]\n {:info (try (-> params\n (assoc :as :json)\n http/request :body)\n (catch Exception e\n (throw (Exception. (str \"getting info params=\" (pr-str params))))))\n :diff (try (-> params\n (assoc :accept \"application/vnd.github.VERSION.diff\")\n http/request :body)\n (catch Exception e\n (throw (Exception. \"getting diff\"))))}))\n\n(defn parse-hunk-spec\n [hunk]\n (zipmap\n [:old-start :old-lines :new-start :new-lines]\n (map read-string ; fine to read the numbers we just regex'd out\n (rest (re-find #\"@@ -(\\d+),(\\d+) \\+(\\d+),(\\d+) @@\" hunk)))))\n\n(defn strip-prefix\n [s pre]\n (if-not (.startsWith s pre)\n s\n (.substring s (count pre))))\n\n(defn parse-diff\n [diff]\n (let [lines (string/split-lines diff)\n put-line (fn [c k l] (update c k conj (.substring l 1)))\n line->path #(-> (second (.split % \" \"))\n (strip-prefix \"a/\")\n (strip-prefix \"b/\"))\n hunks (volatile! (transient []))\n filechanges (volatile! (transient []))\n default-ctx {:new [] :old [] :start 0}]\n (loop [context default-ctx\n line-index 0]\n (let [^String line (get lines line-index)]\n (if-not line\n {:hunks (persistent! (vswap! hunks conj! context))\n :filechanges\n (persistent!\n (vswap! filechanges conj!\n (assoc context :raw\n (subvec lines (:start context) line-index))))}\n (cond\n (.startsWith line \"diff --git\")\n (do (when (:hunk context)\n (vswap! hunks conj! context)\n (vswap! filechanges conj!\n (assoc context :raw\n (subvec lines (:start context) line-index))))\n (recur (assoc default-ctx :start line-index) (inc line-index)))\n\n (.startsWith line \"---\")\n (recur (assoc context :old-path (line->path line)) (inc line-index))\n\n (.startsWith line \"+++\")\n (recur (assoc context :new-path (line->path line)) (inc line-index))\n\n (.startsWith line \"@@\")\n (do (when (:hunk context)\n (vswap! hunks conj! context))\n (recur\n (merge context {:new [] :old [] :hunk (parse-hunk-spec line)})\n (inc line-index)))\n\n (.startsWith line \"+\")\n (recur (put-line context :new line) (inc line-index))\n\n (.startsWith line \"-\")\n (recur (put-line context :old line) (inc line-index))\n\n :else\n (if-let [{:keys [old-lines new-lines]} (:hunk context)]\n (let [nnew (count (:new context))\n nold (count (:old context))]\n (if (and (= nnew new-lines) (= nold old-lines))\n (do (vswap! hunks conj! context)\n (recur (dissoc context :hunk) (inc line-index)))\n (recur (-> context\n (put-line :new line)\n (put-line :old line))\n (inc line-index))))\n (recur context (inc line-index)))))))))\n\n;; need to apply patches in reverse because I don't know how to get the\n;; old text to diff from using the github api\n(defn reverse-apply-patches\n [new-text patches]\n (if-not new-text\n (string/join \"\\n\" (conj (mapcat :old patches) \"\"))\n (let [lines (.split new-text \"\\n\")\n line->patch (into {} (map (juxt (comp :new-start :hunk) identity) patches))\n sb (StringBuilder.)]\n (loop [idx 0]\n (if-not (< idx (count lines))\n (.toString sb)\n (let [linenum (inc idx)]\n (if-let [{:keys [hunk] :as patch} (line->patch linenum)]\n (do\n (doseq [line (:old patch)]\n (.append sb line)\n (.append sb \"\\n\"))\n (recur (dec (+ (:new-start hunk) (:new-lines hunk)))))\n (do (.append sb (nth lines idx))\n (.append sb \"\\n\")\n (recur (inc idx))))))))))\n\n(defn slurp-blob-from-github\n [owner repo tree path]\n (let [url (format \"https://raw.githubusercontent.com/%s/%s/%s/%s\" owner repo tree path)]\n (try\n (:body\n (http/request\n (cond->\n {:method :get\n :url url\n :content-type :json\n :accept \"application/vnd.github.VERSION.raw\"}\n *auth-token* (assoc :basic-auth *auth-token*))))\n (catch Exception e\n (throw (Exception. (str \"slurping \" (pr-str url)) e))))))\n\n;; local git stuff\n\n(def ^:dynamic *git-dir* \".\")\n\n(defn ls-tree\n [rev]\n (reduce\n (fn [m line]\n (let [sp (.split line \"\\\\s\")\n ;; [mode type sha path]\n sha (aget sp 2)\n path (aget sp 3)]\n (assoc m path sha)))\n {}\n (-> (sh/sh \"git\" \"ls-tree\" \"-r\" rev :dir *git-dir*)\n :out\n (.split \"\\n\"))))\n\n(defn ->changed-files\n [rawdiff slurp-new-blob-fn]\n (let [{:keys [hunks filechanges]} (parse-diff rawdiff)\n new-path->text\n (into {}\n (for [new-path (set (map :new-path hunks))]\n [new-path (future (slurp-new-blob-fn new-path))]))\n new-path->rawdiff (group-by :new-path filechanges)\n old-path->rawdiff (group-by :old-path filechanges)]\n (concat\n (for [[new-path patches] (group-by :new-path hunks)\n :when (not= \"/dev/null\" new-path)]\n (let [new-path (:new-path (first patches))\n new-text (deref (new-path->text new-path))\n old-path (:old-path (first patches))\n old-text (reverse-apply-patches new-text patches)]\n (cond-> {:new-path new-path :new-text new-text\n :rawdiff (-> new-path new-path->rawdiff first :raw)}\n old-path (assoc :old-path old-path)\n old-text (assoc :old-text old-text))))\n (for [[old-path patches] (->> hunks\n (filter #(= \"/dev/null\" (:new-path %)))\n (group-by :old-path))]\n {:old-path old-path\n :old-text (string/join \"\\n\" (conj (mapcat :old patches) \"\"))\n :new-path \"/dev/null\"\n :new-text \"\"\n :rawdiff (-> old-path old-path->rawdiff first :raw)}))))\n\n(defn pull-request-diff\n [owner repo num]\n (let [{:keys [diff info]} (pr-diffinfo owner repo num)\n src (-> info :head :repo)]\n (->changed-files\n diff\n #(slurp-blob-from-github (-> src :owner :login) (:name src) (-> info :head :sha) %))))\n\n(defn slurp-blob-from-local-git\n [sha]\n (let [result (sh/sh \"git\" \"cat-file\" \"blob\" sha :dir *git-dir*)]\n (when (= 0 (:exit result))\n (:out result))))\n\n(defn local-diff\n [oldref newref]\n (let [new-tree (ls-tree newref)\n rawdiff (:out (sh/sh \"git\" \"diff\" oldref newref :dir *git-dir*))]\n (->changed-files\n rawdiff\n #(when-let [sha (get new-tree %)]\n (slurp-blob-from-local-git sha)))))\n\n(defn local-diff-work-tree\n [oldref]\n (let [rawdiff (:out (sh/sh \"git\" \"diff\" oldref :dir *git-dir*))\n basedir (io/file *git-dir*)]\n (->changed-files rawdiff #(slurp (io/file basedir %)))))\n" }, { "path": "src/autochrome/page.clj", "content": "(ns autochrome.page\n (:require [autochrome.align :as align]\n [autochrome.annotation :as annotation]\n [autochrome.common :as clj-common]\n [autochrome.components :as comp]\n [autochrome.github :as github]\n [autochrome.parse :as parse]\n [autochrome.styles :as styles]\n [com.climate.claypoole :as cp]\n [hiccup.page :as hp]\n [om.dom :as dom])\n (:import [java.security MessageDigest]\n [javax.xml.bind DatatypeConverter]))\n\n(defn clojure-file?\n [s]\n (and s\n (or (.endsWith s \".clj\")\n (.endsWith s \".cljc\")\n (.endsWith s \".cljs\"))))\n\n(defn remove-react-stuff\n \"no need for this until we have a client-side...\"\n [html]\n (-> html\n (.replaceAll \"\" \"\")\n (.replaceAll \" data-reactid=\\\"[0-9]+\\\"\" \"\")))\n\n(defn page\n [title root]\n (hp/html5\n [:head\n [:style styles/styles]\n [:title (str title)]]\n [:body (remove-react-stuff (dom/render-to-str root))]))\n\n(defn unnest\n [form]\n (let [acc (volatile! (transient []))\n sb (StringBuilder.)]\n (letfn [(emit [thing]\n (if (map? thing)\n (do (vswap! acc conj! (.toString sb))\n (.setLength sb 0)\n (vswap! acc conj! thing))\n (.append sb thing)))\n (go [{:keys [type text delim wscontents] :as form}]\n (cond\n (and (= :coll type) (nil? (:annotation form)))\n (do (emit delim)\n (run! go wscontents)\n (emit (clj-common/open->closed delim)))\n\n (= :comment (:subtype form))\n (emit form)\n\n (= :ws type) (emit (:text form))\n :else (emit form)))]\n (go form)\n (persistent! (conj! @acc (.toString sb))))))\n\n(defn md5sum\n [s]\n (-> (MessageDigest/getInstance \"MD5\")\n (.digest (.getBytes s))\n ;; https://stackoverflow.com/a/25758008\n DatatypeConverter/printHexBinary\n (.toLowerCase)))\n\n(defn render-top-level-form\n [form]\n (comp/code (assoc form :things (unnest form))))\n\n(defn diff-pane\n [linkbase ann contents]\n (for [f contents]\n (-> (annotation/attach f (doto (annotation/syntax-highlighting f) (.putAll ann)))\n (assoc :linkbase linkbase)\n render-top-level-form)))\n\n(defn two-file-diff\n [linkbase old new]\n (->> (align/get-diffs (:contents (:root old)) (:contents (:root new)))\n (sort-by\n (fn [[s t _]]\n (or (:start-line t) (:start-line s))))\n (map\n (fn [[s t ann]]\n (comp/panes\n {}\n (some->> s list (diff-pane (str linkbase (md5sum (:path old)) \"L\") ann))\n (some->> t list (diff-pane (str linkbase (md5sum (:path new)) \"R\") ann)))))\n (interpose (comp/spacer))))\n\n(defn delete-everything\n [root]\n (assoc root :contents (map #(assoc % :annotation :deleted) (:contents root))))\n\n;; don't restrict width to 50% when there is no other file to display\n(defn one-file-diff\n [linkbase path lr root]\n (comp/root {} (diff-pane (str linkbase (md5sum path) lr) {} (:contents root))))\n\n(defn patch-heading\n [{:keys [old-path new-path]}]\n (comp/heading\n (cond\n (= old-path \"/dev/null\") (str new-path \" (new file)\")\n (= new-path \"/dev/null\") (str old-path \" (deleted)\")\n (not= old-path new-path) (str new-path \" -> \" new-path)\n :else new-path)))\n\n(defn clojure-diff\n [linkbase {:keys [old-path old-text new-path new-text]}]\n (cond\n (= old-path \"/dev/null\")\n (one-file-diff linkbase new-path \"R\" (parse/parse new-text))\n\n (= new-path \"/dev/null\")\n (one-file-diff linkbase old-path \"L\"\n (-> old-text parse/parse delete-everything))\n\n :else\n (let [the-diff\n (two-file-diff\n linkbase\n {:path old-path :root (parse/parse old-text)}\n {:path new-path :root (parse/parse new-text)})]\n (if-not (seq the-diff)\n (dom/span {:className \"comment\"} \";; no code changes\")\n the-diff))))\n\n(defn raw-diff\n [linkbase {:keys [rawdiff]}]\n (->> (for [line (drop 4 rawdiff)]\n (cond->> (.substring line 1)\n (.startsWith line \"+\") (dom/span {:className \"added\"})\n (.startsWith line \"-\") (dom/span {:className \"deleted\"})))\n (interpose \"\\n\")\n (dom/pre {})))\n\n(def ^:dynamic *clojure-only* false)\n\n(defn diff-page\n [linkbase title changed-files]\n (println (count changed-files) \"changed files\")\n (->> changed-files\n (cp/upmap\n (cp/threadpool (cp/ncpus))\n (fn [{:keys [old-path new-path] :as patch}]\n (let [file-diff\n (if (or (clojure-file? new-path)\n (and (= \"/dev/null\" new-path)\n (clojure-file? old-path)))\n (clojure-diff linkbase patch)\n (when-not *clojure-only*\n (raw-diff linkbase patch)))]\n (when file-diff\n [(patch-heading patch) file-diff (comp/spacer) (comp/spacer)]))))\n (apply concat)\n (comp/root {})\n (page title)))\n\n(defn github-pr-diff-linkbase\n [owner repo num]\n (format \"https://github.com/%s/%s/pull/%s/files#diff-\" owner repo num))\n\n;; these return the html as string\n(defn pull-request-diff\n [owner repo num]\n (diff-page\n (github-pr-diff-linkbase owner repo num)\n (str owner \"/\" repo \" #\" num)\n (github/pull-request-diff owner repo num)))\n\n(defn local-diff\n [a b]\n (diff-page\n \"local\"\n (str a \"...\" b)\n (github/local-diff a b)))\n\n(defn local-diff-work-tree\n [a]\n (diff-page\n \"local\"\n (str a \"... current\")\n (github/local-diff-work-tree a)))\n" }, { "path": "src/autochrome/parse.clj", "content": "(ns autochrome.parse\n (:require [autochrome.common :refer [open->closed closed->open]]\n [clojure.java.io :as io]\n [clojure.string :as string]))\n\n(defn ns->source-string\n [ns]\n (when-let [path (some-> ns ns-publics first val meta :file)]\n (-> path io/resource slurp)))\n\n(defn clj-whitespace\n [c]\n (case c\n ;; (\\, \\space \\newline \\tab)\n (\\, \\space \\tab) true\n false))\n\n(defn clj-special\n [c]\n (case c\n (\\( \\) \\{ \\} \\[ \\] \\, \\space \\newline \\tab \\\") true\n false))\n\n(defn whitespace-string\n [{:keys [^String buf pos]}]\n (loop [idx pos]\n (if (and (< idx (.length buf)) (clj-whitespace (.charAt buf idx)))\n (recur (inc idx))\n (.substring ^String buf pos idx))))\n\n(defn symbol-string\n [{:keys [^String buf pos]}]\n (loop [idx pos]\n (if (and (< idx (.length buf)) (not (clj-special (.charAt buf idx))))\n (recur (inc idx))\n (.substring ^String buf pos idx))))\n\n(defn count-newlines-in-string\n [s]\n (let [n (volatile! 0)]\n (dotimes [i (.length s)]\n (when (= \\newline (.charAt s i))\n (vswap! n inc)))\n @n))\n\n(def ^:dynamic *line-number* (atom 0))\n\n(defn lex\n [orig-ctx]\n (loop [{:keys [^String buf pos] :as ctx} (transient orig-ctx)\n tokens (transient [])]\n (if (>= pos (.length buf))\n (persistent! tokens)\n (case (.charAt buf pos)\n \\newline\n (recur (assoc! ctx :pos (inc pos))\n (conj! tokens \\newline))\n\n (\\, \\space \\tab)\n (let [^String whitespace (whitespace-string ctx)]\n (recur (assoc! ctx :pos (+ pos (.length whitespace)))\n (conj! tokens {:type :ws :text whitespace})))\n\n \\# (let [nt (.charAt buf (inc pos))]\n (if (= \\_ nt)\n (recur (assoc! ctx :pos (+ 2 pos)) (conj! tokens \"#_\"))\n (recur (assoc! ctx :pos (inc pos))\n (conj! tokens (.charAt buf pos)))))\n\n (\\( \\) \\{ \\} \\[ \\] \\` \\~ \\^ \\')\n (recur (assoc! ctx :pos (inc pos))\n (conj! tokens (.charAt buf pos)))\n\n \\\" (let [string-end (loop [i (inc pos)\n escaped false]\n (cond\n (and (not escaped) (= \\\" (.charAt buf i)))\n (inc i)\n\n (= \\\\ (.charAt buf i))\n (recur (inc i) (not escaped))\n\n :else\n (recur (inc i) false)))\n text (.substring buf pos string-end)]\n (recur (assoc! ctx :pos string-end)\n (conj! tokens {:type :string :text text :nlines (count-newlines-in-string text)})))\n\n \\; (let [comment-end (loop [i pos]\n (cond\n (>= i (.length buf))\n i\n ;; coalesce multiline comments\n (= \\newline (.charAt buf i))\n (let [past-end? (>= (inc i) (.length buf))]\n (if (and (not past-end?)\n (= \\; (.charAt buf (inc i))))\n (recur (+ 2 i))\n i))\n :else (recur (inc i))))\n comment-text (.substring buf pos comment-end)]\n (recur (assoc! ctx :pos comment-end)\n (conj! tokens {:type :ws\n :subtype :comment\n :nlines (count-newlines-in-string comment-text)\n :text comment-text})))\n\n \\\\ (let [literal-end (loop [i (+ 2 pos)]\n (if (clj-special (.charAt buf i))\n i\n (recur (inc i))))]\n (recur (assoc! ctx :pos literal-end)\n (conj! tokens {:type :char-literal :text (.substring buf pos literal-end)})))\n\n \\@ (recur (assoc! ctx :pos (inc pos))\n (conj! tokens (.charAt buf pos)))\n\n \\: (let [^String sym (symbol-string ctx)]\n (recur (assoc! ctx :pos (+ pos (.length sym)))\n (conj! tokens {:type :keyword :text sym})))\n\n (let [^String sym (symbol-string ctx)]\n (recur (assoc! ctx :pos (+ pos (.length sym)))\n (conj! tokens {:type :symbol :text sym})))))))\n\n(def ^:const clojure-core-ns (find-ns 'clojure.core))\n\n(declare parse-list)\n\n(declare -parse-one)\n\n;; 'decoration' precedes one form eg deref, quote, data reader etc.\n(defn parse-decoration\n ([base ts] (parse-decoration base ts []))\n ([base ts init]\n ;; collect leading whitespace\n (loop [ws init\n [t & more :as ts] ts]\n (cond\n (= :ws (:type t))\n (recur (conj ws t) more)\n\n (char? t)\n (let [{:keys [val rest]} (-parse-one ts)]\n {:val (-> (assoc base :wscontents (conj ws val))\n (assoc :contents (conj init val)))\n :rest rest})\n\n (map? t)\n {:val (-> (assoc base :wscontents (conj ws t))\n (assoc :contents (conj init t)))\n :rest more}))))\n\n(defn collect-hash-unders\n [ts]\n (loop [n 0\n hashes []\n [t & more :as ts] ts]\n (cond\n (= t \"#_\") (recur (inc n) (conj hashes t) more)\n (= :ws (:type t)) (recur n (conj hashes (:text t)) more)\n :else {:hashes hashes :n n :rest ts })))\n\n(defn next-n-forms\n [n ts]\n (loop [n n\n forms []\n ts ts]\n (cond\n (or (zero? n) (empty? ts)) {:forms forms :rest ts}\n :else\n (let [{:keys [val rest]} (-parse-one ts)]\n (recur\n (if (not= :ws (:type val)) (dec n) n)\n (conj forms val) rest)))))\n\n(defn ignore-whitespace\n [ts]\n (loop [ts ts]\n (if-not (= :ws (:type (first ts)))\n ts\n (recur (next ts)))))\n\n;; :contents needs to be a list, due to object identity shenanigans in DiffContext\n(defn vec->list\n [v]\n (loop [head nil\n idx (dec (count v))]\n (if (< idx 0)\n head\n (recur (cons (nth v idx) head) (dec idx)))))\n\n(defn nows\n [forms]\n (vec->list (filterv #(not= :ws (:type %)) forms)))\n\n(defn -parse-one\n [ts]\n (when-let [t (first ts)]\n (if-let [closing-delimiter (open->closed t)]\n (parse-list closing-delimiter (next ts))\n (case t\n \\#\n (let [ts (next ts)\n nt (first ts)]\n ;; dispatch\n (case nt\n ;; \\_ (-> (parse-one nt) :rest parse-one)\n \\( (let [{:keys [val rest]} (-parse-one ts)]\n {:val {:type :lambda :text val} :rest rest})\n \\{ (assoc-in (-parse-one ts) [:val :delim] \"#{\")\n\n \\' (let [{:keys [val rest]} (-parse-one (next ts))]\n {:val {:type :var-quote :text (:text val)} :rest rest})\n\n ;; reader conditional\n {:type :symbol :text \"?\"}\n (let [{:keys [val rest]} (-parse-one (ignore-whitespace (next ts)))]\n {:val (assoc val :type :reader-conditional) :rest rest})\n\n {:type :symbol :text \"?@\"}\n (let [{:keys [val rest]} (-parse-one (ignore-whitespace (next ts)))]\n {:val (assoc val :type :reader-conditional-splicing) :rest rest})\n\n (case (:type nt)\n :string\n (let [{:keys [val rest]} (-parse-one ts)]\n {:val {:type :regex :text (:text val)} :rest rest})\n (:symbol :keyword)\n (parse-decoration {:type :data-reader} (next ts) [nt])\n (throw (ex-info \"bad dispatch form\" {:bad-token nt})))))\n\n \"#_\"\n (let [{:keys [n hashes rest]} (collect-hash-unders ts)\n {:keys [forms rest]} (next-n-forms n rest)]\n {:val {:type :hash-under\n :hashes hashes\n :wscontents forms\n :contents (nows forms)}\n :rest rest})\n\n \\^ (parse-decoration {:type :meta} (next ts))\n \\@ (parse-decoration {:type :deref} (next ts))\n \\~ (if (= \\@ (second ts))\n (parse-decoration {:type :unquote-splicing} (nnext ts))\n (parse-decoration {:type :unquote} (next ts)))\n \\` (parse-decoration {:type :syntax-quote} (next ts))\n\n ;; quote has :val instead of :contents because most of the time\n ;; you don't want to recurse into quote forms\n \\' (let [{:keys [val rest]} (-parse-one (next ts))]\n {:val {:type :quote :val (list val)} :rest rest})\n\n \\newline (do (swap! *line-number* inc)\n {:val {:type :ws :text \"\\n\"}\n :rest (next ts)})\n (do\n (when-let [nlines (:nlines t)]\n (swap! *line-number* + nlines))\n {:val t :rest (next ts)})))))\n\n(defn parse-list\n [closer ots]\n (loop [forms []\n ts ots]\n (if-let [t (first ts)]\n (if-let [sub-closer (open->closed t)]\n (let [{:keys [val rest]} (parse-list sub-closer (next ts))]\n (recur (conj forms val) rest))\n (if (= closer t)\n {:val {:type :coll\n :delim (closed->open closer)\n :wscontents forms\n :contents (nows forms)}\n :rest (next ts)}\n (let [{:keys [val rest]} (-parse-one ts)]\n (recur (if (vector? val)\n (into forms val)\n (conj forms val))\n rest))))\n (let [msg {:msg \"expecting closer\" :closer closer :ts ts :forms forms}]\n (println (pr-str msg))\n #_(fipp.edn/pprint forms)\n (throw (ex-info \"expecting closer\" {:closer closer :ts ts}))))))\n\n(defn parse-many\n [ts]\n (binding [*line-number* (atom 1)]\n (loop [forms []\n ts ts]\n (if (some? ts)\n (let [start-line @*line-number*\n {:keys [val rest]} (-parse-one ts)]\n (recur\n (cond\n (vector? val) (into forms val)\n (map? val) (conj forms (-> val\n (assoc :start-line start-line)\n (assoc :lines (inc (- @*line-number* start-line)))))\n :else (conj forms val))\n rest))\n forms))))\n\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;; Public API\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n(defn parse\n [s]\n {:pre [(string? s)]}\n (let [wscontents (parse-many (lex {:pos 0 :buf s}))]\n {:type :root\n :wscontents wscontents\n :contents (nows wscontents)}))\n\n(defn parse-one\n [s]\n (-> s parse :contents first))\n\n(declare render*)\n\n(defn render-contents\n [the-form ->cts]\n (let [rendered (for [f (->cts the-form)] (render* f ->cts))]\n (apply str (if (= :contents ->cts)\n (interpose \" \" rendered)\n rendered))))\n\n(defn render*\n [t ->cts]\n (cond\n (sequential? t) (apply str (for [f (->cts t)] (render* f ->cts)))\n (string? t) t\n :else\n (case (:type t)\n (:ws :symbol :string :comment :keyword) (:text t)\n :data-reader (str \"#\" (:text t))\n :regex (str \"#\" (:text t))\n :char-literal (:text t)\n :meta (apply str \"^\" (for [f (->cts t)] (render* f ->cts)))\n :quote (str \"'\" (render* (:val t) ->cts))\n :syntax-quote (apply str \"`\" (for [f (->cts t)] (render* f ->cts)))\n :unquote (apply str \"~\" (for [f (->cts t)] (render* f ->cts)))\n :deref (apply str \"@\" (for [f (->cts t)] (render* f ->cts)))\n :var-quote (str \"#'\" (:text t))\n :hash-under (str (string/join (:hashes t))\n (render-contents t ->cts))\n\n :coll\n (str (:delim t)\n (render-contents t ->cts)\n (open->closed (:delim t)))\n\n :lambda (str \"#\" (render* (:text t) ->cts))\n :root (apply str\n (for [f (->cts t)]\n (render* f ->cts)))\n\n (case t\n (\\` \\~ \\@) t\n (pr-str t)))))\n\n(defn render\n [t]\n (render* t :contents))\n\n(defn render-dup\n [t]\n (render* t :wscontents))\n" }, { "path": "src/autochrome/readme.clj", "content": "(ns autochrome.readme\n (:refer-clojure :exclude [comment])\n (:require [autochrome.annotation :as annotation]\n [autochrome.components :as comp]\n [autochrome.diff :as diff]\n [autochrome.difflog :as difflog]\n [autochrome.page :as page]\n [autochrome.parse :as parse]\n [autochrome.styles :as styles]\n [garden.core :refer [css]]\n [hiccup.page :as hp]\n [om.dom :as dom]))\n\n(def readme-styles\n (css\n [:body {:color \"white\"}]\n [:p :.caption\n {:font-family \"sans-serif\"\n :text-align \"left\"\n :font-size \"18px\"}]\n [:.caption {:font-size \"14px\"}]\n [:p {:text-indent \"2em\"}]\n [:.diffpane {:width \"unset\"}]\n [:.text {:font-family \"sans-serif\"}]\n [:.textcontainer {:width \"57%\"\n :font-size \"18px\"}]\n [:.title {:font-size \"32px\"}]\n [:.sectiontitle {:font-size \"24px\"\n :text-decoration \"underline\"}]\n [:.insetcontainer {:display \"flex\"\n :justify-content \"space-between\"}]\n [:.insetcenter {:display \"flex\"\n :justify-content \"center\"}]\n [:.logside {:width \"50%\"}]\n [:.inset {:border \"2px solid\"\n :border-color \"#969896\"\n :padding \"10px\"\n :display \"flex\"\n ;:margin \"10px auto\"\n }]\n [:.examplesection {:font-size \"16px\"\n :width \"70%\"\n :margin \"auto\"}]\n [:.fixed {:font-family \"monospace\"\n :background-color \"#111\"}]))\n\n(def page-title \"Autochrome - Structural diffs for Clojure source code\")\n\n(defn readme-page\n [outfile root]\n (spit outfile\n (hp/html5\n [:head\n [:title page-title]\n [:style styles/styles]\n [:style readme-styles]]\n [:body (page/remove-react-stuff (dom/render-to-str root))])))\n\n(defn inset\n [thing]\n (dom/div {:className \"insetcontainer\"}\n (dom/div {:className \"inset\"} thing)\n (dom/div {:style {:width \"100%\"}})))\n\n(defn inset-center\n [thing]\n (dom/div {:className \"insetcenter\"}\n (dom/div {:className \"inset\"} thing)))\n\n(defn loginset\n [log & more]\n (inset log)\n (dom/div\n {:style {:margin-bottom \"40px\"}\n :className \"insetcontainer\"}\n (dom/div\n {:style [[\"min-width\" \"fit-content\"]\n [\"min-width\" \"-moz-fit-content\"]]\n :className \"inset\"}\n log)\n (dom/div {})\n (dom/div {:className \"logside\"} more)))\n\n(defn term\n [& children]\n (inset-center (dom/pre {} children)))\n\n(defn diff2\n [atext btext]\n (let [aroot (parse/parse-one atext)\n broot (parse/parse-one btext)]\n (difflog/diff2 (diff/diff-forms aroot [broot]) aroot broot)))\n\n(defn side-caption\n [& body]\n (dom/div {:style {:display \"flex\"\n :height \"100%\"\n :flex-direction \"column\"\n :justify-content \"center\"}}\n (dom/div {})\n (dom/div {:className \"caption\"} body)))\n\n(defn code-inset\n [text]\n (let [parsed (parse/parse-one text)]\n (inset\n (comp/code\n (merge\n parsed\n {:linkbase \"more hacks\"\n :things (-> parsed\n (annotation/attach\n (annotation/syntax-highlighting parsed))\n page/unnest)})))))\n\n(defn p\n [& args]\n (dom/p {} args))\n\n(defn caption\n [& args]\n (dom/div {:className \"caption\"} args))\n\n(defn section*\n [props title & children]\n (dom/div\n props\n (dom/div {:className \"sectiontitle\"} title)\n children))\n\n(defn section\n [title & children]\n (apply section* {} title children))\n\n(def example1\n [\"(defn example\n [x]\n (println \\\"hello!\\\")\n {:more (inc x)\n :less (dec x)})\"\n\n \"(defn example\n [x]\n (-> {:more (inc x)\n :less (dec x)}\n (assoc :twice (+ x x))))\"])\n\n(def highlight-example\n \"(let [keyword :hello/world\n name (name keyword)\n [a b :as vec] (map inc [1 2 3])]\n (str (namespace keyword) name))\")\n\n(def wrap-example\n [\"{:a :really\n :big :thing\n :these :entries\n :which :is\n :were :removed\n :very :annoying\n :to :read}\"\n \"(keys\n (merge\n {:a :really\n :big :thing\n :which :is\n :very :annoying\n :to :read}\n {:more :stuff}))\"])\n\n(def ws-example\n [\"(def Y(fn[f]((fn[x](x,x))\n(fn[x](f(fn[y]((x,x),y)))))))\"\n \"(def Y\n (fn [f]\n ((fn [x] (x x))\n (fn [x] (f (fn [y] ((x x) y)))))))\"])\n\n(defn comment\n [text]\n (dom/span {:className \"comment\"} text))\n\n(defn fixed\n [text]\n (dom/span {:className \"fixed\"} text))\n\n(defn gen-readme\n []\n (readme-page\n \"readme.html\"\n (dom/div\n {}\n (dom/div {:className \"filename-heading\"}\n (dom/div {:className \"title\"} page-title))\n (dom/div\n {:className \"textcontainer\" :style {:margin \"auto\"}}\n (dom/div {:style {:margin-top \"35px\"}}\n (inset-center (diff2 (first example1) (second example1))))\n (dom/p\n {}\n (section\n \"Abstract\"\n (p (dom/a {:href \"https://github.com/ladderlife/autochrome\"} \"Autochrome (repo here)\")\n \" uses a full parse to highlight and structurally diff Clojure source code. \"\n \"It aims to make the experience of reviewing Clojure code just as nice as writing it. \"\n \"It takes the form of a command-line tool which generates diffs as static HTML: \")\n (term\n \"$ lein run \" (dom/i {} \"owner\") \" \" (dom/i {} \"repo\") \" \" (dom/i {} \"num\") \" -o diff.html\"\n (comment \" # write a diff for a github pull request\")\n\n \"\\n$ lein run --token user:123abc \"(dom/i {} \"owner\") \" \" (dom/i {} \"repo\") \" \" (dom/i {} \"num\")\n (comment \" # use supplied auth token for github api\")\n\n \"\\n$ lein run --git-dir \" (dom/i {} \"/your/repo/ \") (dom/i {} \"old-tree\") \" \" (dom/i {} \"new-tree\")\n (comment \" # like git diff, using specified repo\")\n\n \"\\n$ lein run --open ...\"\n (comment \" # try to open the diff in a browser\"))\n (p \"If generated from GitHub, the line numbers in Clojure diffs link back to the PR. \"\n \"Bold symbols link to documentation.\"))\n (section\n \"Features\"\n (p (dom/ul {:className \"text\"}\n (dom/li {:style {:margin-bottom \"30px\"}} \"Scope-aware highlighting (no regular expressions):\"\n (code-inset highlight-example))\n (dom/li {:style {:margin-bottom \"30px\"}} \"Structural diff which can cope with wrapping/stripping parens:\"\n (inset (diff2 (first wrap-example) (second wrap-example))))\n (dom/li {:style {:margin-bottom \"30px\"}} \"Naturally, whitespace is ignored completely: (h/t \"\n (dom/a {:href \"http://blog.klipse.tech/lambda/2016/08/07/pure-y-combinator-clojure.html\"}\n \"@viebel\") \")\"\n (inset (diff2 (first ws-example) (second ws-example)))))))\n (section\n \"Misfeatures\"\n (p (dom/ul {:className \"text\"}\n (dom/li {} \"Symbols can only have one annotation. (diff color overwrites highlight)\")\n (dom/li {} \"Terrible for viewing non-clojure diffs. \")\n (dom/li {} \"Difficult to port to ClojureScript. \")\n (dom/li {} \"Uses its own custom clojure parser.\")\n (dom/li {} \"Occasionally gets strange ideas.\"))))\n (section\n \"How it works\"\n (p \"Structural diffing is something I always wanted for Clojure. \"\n \"When I saw \"\n (dom/a {:href \"http://thume.ca/2017/06/17/tree-diffing/\"}\n \"Tristan Hume's article about tree diffing\")\n \", I was inspired to give it a shot myself using the same A* pathfinding technique he described. \"\n \"I ended up ditching A* for plain old Dijkstra's algorithm however - \"\n (dom/a {:href \"#alignment\"} \"more on that later\") \". \"\n \"Either way, in order to frame tree diffing as a pathfinding problem, you need to extend the concepts \"\n \"of location, cost, and adjacency to tree diffs. Location is clearly needed to know where you are, \"\n \"but in addition locations need to be comparable, so you know not to bother when you already have a better \"\n \"path to the same place. \"\n \"Cost is what makes some paths preferred over others. For pathfinding on a road network, this would be \"\n \"the total distance traveled along the roads used. \"\n \"Adjacency is what states are reachable from a particular state. For roads you might say that intersections are \"\n \"the nodes and adjacency means there is a road connecting them. \"\n \"In autochrome:\"\n (dom/ul {:className \"text\"}\n (dom/li {} \"Location is a pair of pointers into the source and target lists, \"\n \"plus the stack of previous locations. Intuitively, the pointers represent a pair of \"\n \"'cursors' over the tree structure. Without the stack of previous locations, \"\n \"comparison would break, since all locations at the end of two lists would be indistinguishable \"\n \"from the goal (the end of both root lists)\")\n (dom/li {} \"Cost is the total size of all subtrees added and deleted, plus the number of subtree added and deleted. \"\n \"Subtree size is 1 for empty collections, character count for text nodes, and sum size of children for branch nodes. \"\n \"The number of subtrees changed is included in the cost so that the algorithm prefers deleting/adding entire\"\n \"lists, rather than all their elements (since they have the same cost otherwise).\")\n (dom/li {} \"Adjacency is a bit complicated:\"\n (dom/ul {}\n (dom/li {} \"When the source and target cursors are over identical subtrees, we always advance both cursors.\")\n (dom/li {} \"When the source cursor is not at the end of its list, we may advance it while keeping the same \"\n \"target cursor. This corresponds to deleting a subtree from the source list.\")\n (dom/li {} \"Likewise for the target cursor: we advance it and keep the source cursor, corresponding to a subtree addition.\")\n (dom/li {} \"When both cursors are over matching collection types, we can move both cursors into the lists. \"\n \"We also need to push the next location onto the stack.\")\n (dom/li {} \"When both cursors are nil, it means we have reached the end of both lists, and we need to \"\n \"pop the next location in the parent sequences off the stack.\"))\n (p \"This is the basic version of adjacency that I started with. However, when implemented this way, \"\n \"the algorithm cannot match subtrees at different levels of nesting, since the cursors always move \"\n \"up or down together. \"\n \"To handle changes in nesting, the cursors need to be allowed to move up and down independently, \"\n \"like they are allowed to do within lists. This means that instead of one stack of pairs of pointers, \"\n \"we need a pair of stacks of pointers, one per cursor. Then we need to add some state transitions: \")\n (dom/ul {}\n (dom/li {} \"When only the source cursor is nil, pop the source stack only.\")\n (dom/li {} \"Likewise for target cursor.\")\n (dom/li {} \"When the source cursor is over a branch node, move it to the first child, \"\n \"and push the next position on the source stack.\")\n (dom/li {} \"Likewise for target cursor.\"))\n (p \"Since there are quite a lot of branch nodes, this creates a ton of extra states for the algorithm to explore. \"\n \"So although it seems like the steps which move both cursors up/down would obsolete, since they can \"\n \"be replicated with two single-cursor movements, they are needed so that performance is not terrible \"\n \"on mostly identical subtrees (ie the common case). It is also helpful to make single-cursor movement cost \"\n \"more than two-cursor movement, so that we only try a single-cursor move after matched movement fails. \"\n \"The extra cost accounts for the fact that single-cursor movement corresponds to \"\n \"adding or removing a set of parens.\"))))))\n (section\n \"Worked Example\"\n (p \"I don't know about you, but I'm not the type who can absorb the essence of a complicated algorithm from a wall of text as seen above. \"\n \"So let's look at a detailed log of the states we popped from our priority queue while generating the example diff at the top of this page. \"\n \"The states are numbered in the order in which they were processed. We will look at the goal state and each of its predecessors, \"\n \"starting from the initial state.\")))\n (let [a (parse/parse-one (first example1))\n b (parse/parse-one (second example1))\n logs (vec (difflog/diff-log a [b]))]\n (dom/div {:className \"examplesection\"}\n (loginset (first logs)\n (side-caption \"The source cursor is blue, and the target cursor is purple. \"\n \"As you can see, we start with each cursor over its entire subtree. \"))\n (loginset\n (nth logs 1)\n (side-caption \"After we enter the main loop and pop the start state, we can start exploring. \"\n \"In this state we have matched the parentheses and descended into the defn body. \"\n \"Going into lists has cost 1, so that deleting an entire list \"\n \"is cheaper than deleting each of its elements.\"))\n (loginset\n (nth logs 2)\n (side-caption \"We matched \" (fixed \"defn\") \" with \" (fixed \"defn\") \" and advanced both cursors. \"\n \"Now we can now match \" (fixed \"example\") \" with \" (fixed \"example\") \".\"))\n (loginset\n (nth logs 3)\n (side-caption \"Since matching is done with subtree hashes, we can match \" (fixed \"[x]\")\n \" without going into the vector at all.\"))\n (loginset\n (nth logs 4)\n (side-caption\n \"Now we have our first mismatch. We have a few options here:\"\n (dom/ol {}\n (dom/li {} \"Delete source (blue) subtree\")\n (dom/li {} \"Add target (purple) subtree\")\n (dom/li {} \"Go into both subtrees\")\n (dom/li {} \"Go into blue subtree only\")\n (dom/li {} \"Go into purple subtree only\"))))\n (loginset\n (nth logs 8)\n (side-caption \"We explore all of those options, but eventually we choose the last. \"\n \"Since we moved the target cursor into a list while the source cursor stayed put, \"\n \"it follows that if we finish diffing, the parens which create that extra list must have been added, \"\n \"so we can go ahead and paint them green, and add 2 to the cost.\"))\n (loginset\n (nth logs 11)\n (side-caption \"Add the \" (fixed \"->\") \". It has size 2, but the new cost is 6. This is because \"\n \"each addition/deletion costs 1 extra point, so that \"\n \"minimal diffs are cheaper than equivalent diffs with more changes. \"))\n (loginset\n (nth logs 60)\n (side-caption \" Delete \" (fixed \"(println \\\"hello\\\")\") \". Note that this is state #60 while the previous \"\n \"state was #11 - we explored a whole bunch of dead-end states in between. \"\n \"This is because the deletion has a relatively high cost, so Dijkstra prefers to do \"\n \"low- or no-cost movement before eventually getting around to this state.\"))\n (loginset\n (nth logs 63)\n (side-caption \"Match the identical maps and advance each cursor. \"\n \"Since the map was the last element in the source defn body, the \"\n \"source cursor has reached the end of its list, so there is nothing to highlight \"\n \"in blue and it says \" (fixed \"(nil S)\") \" in the header.\"))\n (loginset\n (nth logs 65)\n (side-caption \"It may look like nothing happened, but we popped out of the left subtree only here. \"\n \"This is an example of how movement operations get processed before any additions/deletions. \"\n \"It's completely free to explore here, so we might as well!\"))\n (loginset\n (nth logs 197)\n (side-caption \"Add \" (fixed \"(assoc :twice (+ x x))\") \". Another costly change means another big gap in state number. \"\n \"That was the last element in the \"\n \"target sequence, so now we have \" (fixed \"(nil S)\") \" and \" (fixed \"(nil T)\") \". \"))\n (loginset\n (nth logs 200)\n (side-caption \"Pop out of the \" (fixed \"(-> ...)\") \".\"))\n (loginset\n (nth logs 203)\n (side-caption \"Pop out of the target defn body. \"\n \"Now that we have popped all the way out of both forms, \"\n \"both stacks are empty and there are no more forms to diff, so we are done!\"))))\n (dom/div\n {:className \"textcontainer\"\n :style {:margin \"auto\"}\n :id \"alignment\"}\n (section\n \"Alignment\"\n (p \"I had originally implemented the diff algorithm as A*, which was a lot better at finding diffs with fewer explored states. \"\n \"What made me decide to switch to plain Dijkstra's algorithm was the problem of alignment. When multiple forms in a file \"\n \"are changed, inserted, renamed or deleted, how do you figure out which pairs to diff?\"\n \"A* works great when you know both the source and the target forms, but this proved difficult in practice. \")\n (p \"My first idea was to simply diff the entire source file with the entire target file, basically treating each file \"\n \"as if it had [] surrounding the entire thing. This led to a lot of weird diffs; for example when you deleted \"\n \"something and inserted something else in its place, the diff would show how to transform the deleted thing \"\n \"into the new thing, which was confusing. \"\n \"Top-level forms are the basic unit of clojure code, so diffs which span them are unnatural and hard to read. \"\n \"When the change-of-nesting support was implemented, things really got out of hand.\")\n (p \"Something had to be done. My next idea was to basically hack it by trying to match forms by their top-level text, \"\n \"for example 'defn somefn' or 'defmethod foo :dval'. This has a lot of obvious problems, including docstrings, but \"\n \"especially renames. It worked better than I expected but the problem was still not solved.\")\n (p \"The solution I came up with is to diff each target form in the old file against \" (dom/i {} \"all\") \" forms in the new file. \"\n \"This is done by adding N start states to the priority queue, instead of only one, where N is the number of candidate target forms. \"\n \"Since A* really only makes sense in the context of single-source shortest paths, I decided to just switch to Dijkstra's algorithm, \"\n \"which can deal just fine with multiple origins. Since the diffs are processed in order of increasing cost, we know that \"\n \"the first complete diff we see will be the lowest-cost-possible diff of the source form with any of the target forms. \"\n \"So we trade away single-target diff performance, but in return we get the guaranteed optimal solution to the alignment problem. \")\n (p \"Doing diffs this way is technically quadratic, since in the worst case it requires every source form to be diffed against every \"\n \"target form, but there are a couple tricks that can be used to make it more palatable. \"\n \"Most of the time, the majority of the forms in a file will be unchanged, so we can just hash everything first and match those \"\n \"right away. That means the runtime is only quadratic with respect to the number of changed forms, which is better. \"\n \"Second, each target form can only be matched to one source form, so we if we have to diff the first source against N targets, \"\n \"we only need to diff the second against N-1, and so on. Still quadratic but oh well, parsing is usually slower anyway. \"\n \"Finally, in each list of candidate targets we always include nil, representing the cost of deleting the entire source form. \"\n \"This means no states more expensive than that are considered, which kind of controls the number of states we need to explore.\")\n (p \"There are a couple of slow cases, but for the most part I think the gains are worth the switch to Dijkstra. \"\n \"Probably the slowest type of change to diff is splitting a very large form into two or more smaller forms, since we will spend \"\n \"a huge amount of time trying to figure out which smaller form is most similar to the original large form. For example, \"\n \"If you split a 100-line function into two pieces and also make a bunch of changes, it might take like 30 seconds to diff. \"\n \"That's not great, but you'll probably spend more than 30 seconds looking at a diff like that anyway.\"))))))\n\n(clojure.core/comment\n (gen-readme)\n (difflog/write-difflog \"difflog\" (first example1) [(second example1)]))\n" }, { "path": "src/autochrome/scope.clj", "content": "(ns autochrome.scope\n (:require [autochrome.common :as clj-common]\n [autochrome.parse :as parse]\n [clojure.test :refer [deftest is are]])\n (:import [java.io Writer]))\n\n;; crude Writer monad (can't be nested artibrarily/lexically)\n;; The only reason this needs to work with pseudo-writer-monad instead\n;; of simply returning the results like it used to do, is because\n;; you can depend on things while destructuring if you use :or.\n;; This means that `restructure` has to both return a value (the bound names)\n;; and also potentially emit results (:or deps). So everything had to be changed.\n\n(def ^:dynamic *writer-output* nil)\n\n(defn write!\n \"Emit a value to the output/stream/log\"\n [v]\n (when v\n (vswap! *writer-output* conj! v)))\n\n(defmacro execute-writer\n \"run body and discard the result. returns vector of all values written\"\n [& body]\n `(binding [*writer-output* (volatile! (transient []))]\n ~@body\n (persistent! @*writer-output*)))\n\n(defn key->bound-sym\n \"`{:keys [foo/bar]}` binds `bar`\"\n [{:keys [text]}]\n (or (some->> text (re-find #\".+?/(.+)\") second) text))\n\n;; mostly just to keep track of all the fields...\n(defrecord Context [root? scope globals lang alias quote-depth])\n\n(def default-context\n (map->Context {:root? true\n :globals (clj-common/clojure-core-scope)\n :scope {}\n :quote-depth 0}))\n\n(defmethod print-method Context\n [ctx ^Writer w]\n (print-method (into {} ctx) w))\n\n(defn add-to-scope\n \"add local binding(s) to the current context scope\"\n [^Context ctx name which info]\n (cond\n (or (nil? name) (pos? (:quote-depth ctx))) ctx\n ;(empty? name) (throw (ex-info \"empty name\" {:context (dissoc ctx :globals)}))\n (sequential? name) (reduce (fn [a n] (add-to-scope a n which info)) ctx name)\n (map? name) (update ctx which assoc (symbol (:text name)) info)\n :else (update ctx which assoc (symbol name) info)))\n\n(declare walk-with-scope)\n\n(defn walk-body\n \"when you don't know what else to do\"\n [forms func ^Context ctx]\n (when (nil? ctx)\n (throw (ex-info \"nil ctx\" {:forms forms})))\n (when (map? forms)\n (throw (ex-info \"walk-body expectes sequence of forms, use walk-with-scope for single forms\")))\n (doseq [form forms]\n (walk-with-scope form func ctx)))\n\n(defn restructure\n [{:keys [type text delim contents] :as binding-form} func ^Context ctx]\n (when binding-form\n (when-not (map? binding-form) (throw (ex-info \"restructure expects forms\" {:not-a-form binding-form})))\n (cond\n (= :symbol type) (list text)\n ;; map destructuring\n (and (= :coll type) (= \\{ delim))\n (mapcat\n (fn [[binding-key binding-val]]\n (if (not= :keyword (:type binding-key))\n (restructure binding-key func ctx)\n (case (:text binding-key)\n \":keys\" (map key->bound-sym (:contents binding-val))\n \":strs\" (map :text (:contents binding-val))\n \":as\" (list (:text binding-val))\n \":or\" (walk-body (take-nth 2 (rest (:contents binding-val))) func ctx)\n (if (.endsWith (:text binding-key) \"/keys\")\n (map key->bound-sym (:contents binding-val))\n (throw (ex-info (str \"unsupported map destructuring (\" (:text binding-key) \")\")\n {:binding-form binding-form\n :rendered (parse/render binding-form)}))))))\n (partition 2 contents))\n ;; vector destructuring\n (and (= :coll type) (= \\[ delim))\n (loop [bound []\n [form & forms] contents]\n (cond (nil? form) bound\n (= form {:type :keyword :text \":as\"}) (recur (conj bound (:text (first forms))) (next forms))\n (= form {:type :symbol :text \"&\"}) (recur bound forms)\n :else (recur (into bound (restructure form func ctx)) forms))))))\n\n(defn local\n [^Context ctx arg]\n (add-to-scope ctx arg :scope :local))\n\n(defn +bindings\n [form func ^Context ctx]\n (local ctx (restructure form func ctx)))\n\n(defn walk-fnspec\n \"fnspec is like `([x] (inc x))`\"\n [[argv & body] func ^Context ctx]\n (walk-body body func (+bindings argv func ctx)))\n\n(defn without-meta\n \"gross hack so we don't get destroyed by (def ^:dynamic foo ...)\"\n [cts]\n (filter #(not= :meta (:type %)) cts))\n\n(defn walk-bindings*\n \"each binding in a let is in scope for subsequent bindings\"\n [bvec body func ^Context context]\n (loop [[b & bs] (partition 2 (without-meta (:contents bvec)))\n ctx context]\n (if (nil? b)\n (walk-body body func ctx)\n (let [[name expr] b]\n ;; might as well handle these here (for, doseq, etc)\n (case (:text name)\n \":let\" (recur (concat (partition 2 (:contents expr)) bs) ctx)\n (\":when\" \":while\") (do (walk-with-scope expr func ctx)\n (recur bs ctx))\n ;; normal let binding\n (do (walk-with-scope expr func ctx)\n (recur bs (+bindings name func ctx))))))))\n\n;;; `binding` is different from `let` because the LEFT hand side\n;;; can contain dependencies as well as the right\n(defn walk-literal-binding-form\n [bvec body func ^Context context]\n (loop [[b & bs] (partition 2 (without-meta (:contents bvec)))\n ctx context]\n (if (nil? b)\n (walk-body body func ctx)\n (let [[name expr] b]\n (do (walk-body [name expr] func ctx)\n (recur bs (+bindings name func ctx)))))))\n\n(defn walk-fn-form\n [[first-param & more :as contents] func ^Context ctx]\n (if (= :symbol (:type first-param))\n (recur more func (+bindings first-param func ctx))\n (cond\n (= \\[ (:delim first-param)) (walk-fnspec contents func ctx)\n (= \\( (:delim first-param)) (doseq [form more] (walk-fnspec (:contents form) func ctx))\n (nil? name) (throw (ex-info \"unsupported fn form?\" {:contents contents}))\n :else (walk-body more func ctx))))\n\n(defn walk-defn-form\n [{[_ name & body] :contents} func ^Context ctx]\n ;; ignore docstring (we don't care about any strings really)\n (let [body (filter #(not= :string (:type %)) body)\n [argv? & more] body\n fnscope (+bindings name func ctx)]\n (case (:delim argv?)\n \\[ (walk-fnspec body func fnscope)\n \\( (doseq [form body] (walk-fnspec (:contents form) func fnscope))\n \\{ (do (walk-body (:contents argv?) func fnscope)\n (walk-defn-form {:contents (list* 'defn name more)} func ctx))\n (throw (ex-info \"wtf defn\" {:name name})))))\n\n(defn walk-defmacro-form\n [form func ^Context ctx]\n (walk-defn-form form func (local ctx [\"&env\" \"&form\"])))\n\n(defn walk-defprotocol-form\n [{[_ & entire-body] :contents :keys [delim] :as form} func ^Context ctx]\n (let [[name & body] (filter #(not= :string (:type %)) entire-body)]\n #_(walk-with-scope name func ctx)\n (doseq [{[name & fnspec] :contents} body]\n (walk-fnspec fnspec func (+bindings name func ctx)))))\n\n(defn walk-defrecord-form\n [{[_ & body] :contents :keys [delim] :as form} func ^Context ctx]\n (let [[name fields & body] (filter #(not= :string (:type %)) body)\n record-ctx (+bindings name func (+bindings fields func ctx))]\n (doseq [{:keys [contents] :as elem} body]\n (if contents\n ;; hopefully an fnspec\n (walk-fnspec (rest contents) func record-ctx)\n ;; hopefully a protocol name\n (write! (func ctx elem))))))\n\n;; (defmethod method dispatch-val [args] body)\n(defn walk-defmethod-form\n [{[_ name dispatch-val & fnspec] :contents :keys [delim] :as form} func ^Context ctx]\n (do (walk-with-scope name func ctx) ; defmethod depends on the defmulti\n (walk-fnspec fnspec func ctx)))\n\n(defn walk-letfn-form\n [{[_ bindings & body] :contents} func ^Context ctx]\n (let [names? (mapcat #(restructure (first (:contents %)) func ctx) (:contents bindings))\n letfn-scope (local ctx names?)]\n (doseq [form (:contents bindings)]\n (walk-fn-form (rest (:contents form)) func letfn-scope))\n (walk-body body func letfn-scope)))\n\n(defn ->fq-symbol\n [scope alias s]\n (if-let [s-ns (some-> s (namespace) (symbol))]\n (symbol\n (name (or (get alias s-ns)\n s-ns))\n (name s))\n (get scope s)))\n\n(defn qualify-symbol\n [{:keys [globals alias]} {:keys [text] :as form}]\n (->fq-symbol globals alias (symbol text)))\n\n(defn walk-case-form\n [{[_ expr & cases] :contents} func ^Context ctx]\n ;; test constants in `case` forms are implicitly quoted\n (walk-with-scope expr func ctx)\n (doseq [[const expr] (partition-all 2 cases)]\n (walk-with-scope (or expr const) func ctx)))\n\n(defn form->func\n \"return fully-qualified symbol in funcall position of form\"\n [form ^Context ctx]\n (let [func (first (:contents form))]\n (when (and (= \\( (:delim form))\n (= :symbol (:type func))\n (zero? (:quote-depth ctx)))\n (qualify-symbol ctx func))))\n\n(defn walk-def-form\n [{[_ name & more] :contents} func ^Context ctx]\n (walk-body more func ctx))\n\n(def ^:const reader-lambda-scope\n (into {} (map #(vector (symbol (str \"%\" %)) :implicit)\n (list* \"\" \"&\" (range 1 10)))))\n\n(defn top-level-walker-fn\n \"given fully-qualified function/macro name, return fn to correctly walk top-level form\"\n [sym]\n (case sym\n (clojure.core/defn\n clojure.core/defn-) walk-defn-form\n (clojure.core/defrecord\n clojure.core/deftype\n potemkin/defprotocol+) walk-defrecord-form\n clojure.core/defmacro walk-defmacro-form\n clojure.core/defprotocol walk-defprotocol-form\n clojure.core/defmethod walk-defmethod-form\n (clojure.core/def\n clojure.core/defonce\n clojure.test/deftest) walk-def-form\n (clojure.core/comment\n clojure.core/declare\n clojure.core/quote) (constantly [])\n\n nil))\n\n(defn walk-binding-form\n \"try to walk a form which can have bindings - returns nil if form is not recognized as a binding form\"\n [{[func-pos & params :as contents] :contents :keys [delim] :as form} func ^Context ctx]\n (walk-with-scope func-pos func ctx)\n (let [dispatch-form (form->func form ctx)]\n (case dispatch-form\n (clojure.core/for clojure.core/doseq clojure.core/dotimes clojure.core/let clojure.core/loop\n clojure.core/when-let clojure.core/if-let clojure.core/if-some clojure.core/when-some)\n (walk-bindings* (first params) (rest params) func ctx)\n\n (clojure.core.async/go-loop manifold.deferred/let-flow)\n (do (walk-with-scope func-pos func ctx)\n (walk-bindings* (first params) (rest params) func ctx))\n\n clojure.core/recur (walk-body params func ctx)\n clojure.core/fn (walk-fn-form params func ctx)\n clojure.core/case (walk-case-form form func ctx)\n clojure.core/letfn (walk-letfn-form form func ctx)\n clojure.core/binding (walk-literal-binding-form (first params) (rest params) func ctx)\n clojure.core/reify (walk-defprotocol-form form func ctx)\n ;; TODO proxy\n\n (if-let [tlw (top-level-walker-fn dispatch-form)]\n (tlw (update form :contents without-meta) func ctx)\n (walk-body params func ctx)))))\n\n(defn walk-with-scope\n \"walk an AST, calling (func context form) for every terminal/leaf form,\n collecting return values in a FLAT sequence, omitting nils\"\n [{:keys [type text contents delim] :as form} func ^Context original-ctx]\n (try\n (let [ctx (assoc original-ctx :root?\n (and (:root? original-ctx)\n (or (= type :reader-conditional)\n (= type :reader-conditional-splicing))))]\n (cond\n (= type :lambda)\n (let [lambda-ctx (-> ctx\n (update :scope merge reader-lambda-scope)\n (assoc :root? false))]\n ;; if you do #(let ...) we need to do walk-binding-form-here\n (walk-binding-form text func lambda-ctx))\n\n (nil? contents)\n (write! (func ctx form))\n\n (= type :syntax-quote)\n (walk-body contents func (update ctx :quote-depth inc))\n\n (or (= type :unquote) (= type :unquote-splicing))\n (walk-body contents func (update ctx :quote-depth dec))\n\n :else (walk-binding-form form func ctx)))\n (catch Exception e (throw (Exception. (str \"walking \" (parse/render form)) e)))))\n\n(defn numeric?\n [text]\n (some? (re-find #\"^[-+]?\\d+(\\.\\d+)?M?$\" text)))\n\n(defn form->real-symbol\n [context {:keys [text] :as form}]\n (when (and (= :symbol (:type form))\n (not (or (contains? #{\"true\" \"false\" \"nil\"} text)\n ;; hacks - consider syntax-quoted symbols as \"real\" only within macros\n (and (pos? (:quote-depth context)) (nil? (get (:scope context) (symbol \"&env\"))))\n (and (pos? (:quote-depth context)) (.endsWith text \"#\"))\n (.startsWith text \".\")\n (.startsWith text \"js/\")\n (numeric? text))))\n (symbol text)))\n\n(defn form->free-symbol\n \"Walking calls your fn on every leaf form, use this fn to get free symbols only\"\n [context {:keys [text] :as form}]\n (when-let [sym (form->real-symbol context form)]\n (when (not (contains? (:scope context) sym))\n sym)))\n" }, { "path": "src/autochrome/styles.clj", "content": "(ns autochrome.styles\n (:require [garden.core :refer [css]]))\n\n(def code-fonts\n \"some nice programming fonts, ordered by how much I like them\"\n \"\\\"Iosevka Term\\\", \\\"Fira Code\\\", Inconsolata, Menlo, Monaco, Consolas, monospace\")\n\n(def styles\n (css\n [:body {:background \"#000000\"\n :font-family code-fonts\n :font-size \"16px\"}]\n [:a {:text-decoration :none\n :font-weight :bolder}]\n [:code :pre\n {:color \"#ffffff\"\n :background \"#000000\"\n ;; pre does not inherit font from body\n :font-family code-fonts\n :white-space :pre\n :word-spacing :normal\n :word-break :normal\n :word-wrap :normal\n :line-height 1.24\n :hyphens :none}]\n [:code :a {:text-decoration :none\n :font-weight :bolder\n :color :inherit}]\n [:pre {:margin \"0px\"\n :overflow :auto\n :border-radius \"0.3em\"\n :font-weight :normal\n :overflow-y :hidden}]\n [:.gutter {:text-align :right\n :padding-right \"4px\"\n :padding-left \"2px\"}]\n [:.code-card {:margin-buttom \"16px\"\n :padding \"6px 6px 0px 6px\"\n :color \"#ae81ff\"\n :font-weight :bold}]\n [:.code-card-heading {:background \"linear-gradient(#632697, #000)\"\n :font-size \"22px\"\n :display :flex\n :justify-content :space-between}]\n [:.filename-heading {:background \"linear-gradient(#632697, #000)\"\n :font-size \"22px\"\n :color :white}]\n [:.spacer {:margin-bottom \"30px\"}]\n [:.code-card-heading-extra {:display :flex}]\n [:.container {:display :flex\n :flex-direction :row}]\n [:.usages {:font-size \"16px\"\n :margin :auto}]\n [:.top-comment {:margin-bottom \"17px\"}]\n [:.ns-ref {:color \"#f0c674\"}]\n [:.keyword {:color \"#8abeb7\"}]\n [:.var-ref {:color \"#81a2be\"}]\n [:.clojure-core {:font-weight :bolder :color \"#81a2be\"}]\n [:.macro {:color \"#b294bb\"}]\n [:.punctuation {:color \"#a6a6a0\"}]\n [:.ns-ref {:color \"#f0c674\"}]\n [:.string {:color \"#b5bd68\"}]\n [:.keyword {:color \"#70c0b1\"}]\n [:.meta-keyword {:color \"#ea731c\"}]\n [:.java-class {:color \"#de9f25\"}]\n [:.punctuation {:color \"#a6a6a0\"}]\n [:.highlight {:background-color \"#5d007a\"}]\n [:.unparsed {:background-color \"#ff0000\"}]\n [:.added {:background-color \"#225d2d\"}]\n [:.deleted {:background-color \"rgba(200, 38, 38, 0.81)\"}]\n [:.deleted [:.deleted {:background-color \"unset\"}]]\n [:.added [:.added {:background-color \"unset\"}]]\n [:.first-seen {:text-decoration :underline}]\n [:.comment {:color \"#969896\" :font-style :italic :font-weight :normal}]\n [:.diffpane {:width \"50%\"}]\n\n ;; for difflog\n\n [:.shead {:background-color \"#1224b1\" :border-radius \"10px\"}]\n [:.thead {:background-color \"#5d007a\" :border-radius \"10px\"}]))\n" }, { "path": "src/autochrome/tree.clj", "content": "(ns autochrome.tree\n (:require [autochrome.common :as clj-common])\n (:import [clojure.lang Util]))\n\n(defn branch?\n [{:keys [type] :as form}]\n (or (clj-common/decoration? form)\n (= type :coll)\n (= type :lambda)\n (= type :data-reader)\n (= type :reader-conditional)\n (= type :reader-conditional-splicing)\n (= type :quote)))\n\n(defn ->children\n [{:keys [type] :as form}]\n ;; The parser is unfortunately designed so that recursing into everything\n ;; is a little bit... involved.\n (cond\n (= type :quote) (:val form)\n (= type :lambda) (:contents (:text form))\n :else (:contents form)))\n\n(defn put-sizes\n [szmap form]\n (let [children (->children form)\n size (if-not children\n (if-let [t (:text form)]\n (count t)\n ;; empty collection\n 1)\n (let [tcost (volatile! 0)]\n (loop [i 0\n [c & cs] children]\n (when c\n (vswap! tcost + (put-sizes szmap c))\n (recur (inc i) cs)))\n @tcost))]\n (.put szmap form size)\n size))\n\n(defn put-hashes\n [hmap form]\n (let [children (->children form)\n size (if-not children\n (if-let [t (:text form)]\n (Util/hashCombine (.hashCode t) (.hashCode (:type form)))\n (if (= :coll (:type form))\n ;; empty collection\n (.hashCode (:delim form))\n (if (nil? form)\n 0\n (throw (ex-info \"unhashable\" {:form form})))))\n (let [type-hash (Util/hashCombine (.hashCode (:type form)) (hash (:delim form)))\n parent-hash (volatile! (Util/hashCombine 0x1a814d0 type-hash))]\n (loop [i 0\n [c & cs] children]\n (when c\n (vreset! parent-hash (Util/hashCombine @parent-hash (put-hashes hmap c)))\n (recur (inc i) cs)))\n @parent-hash))]\n (.put hmap form size)\n size))\n" }, { "path": "src/autochrome/xref.clj", "content": "(ns autochrome.xref\n (:require [autochrome.common :as clj-common]))\n\n(def ^:const special->doc\n {\"set!\" \"https://clojure.org/reference/vars#set\"\n \"catch\" \"https://clojure.org/reference/special_forms#try\"\n \"finally\" \"https://clojure.org/reference/special_forms#try\"})\n\n(defn clojure-core-link\n [text]\n (if (clj-common/special-form? text)\n (or (special->doc text)\n (str \"https://clojure.org/reference/special_forms#\" text))\n (str \"https://clojuredocs.org/clojure.core/\" text)))\n\n(defn javadoc-link\n ([text] (or (javadoc-link \"java.lang\" text)\n (javadoc-link \"java.util\" text)\n (javadoc-link \"java.io\" text)))\n ([package text]\n (when (Character/isUpperCase (.charAt text 0))\n (try\n (let [text (if (.endsWith text \".\")\n (.substring text 0 (dec (count text)))\n text)\n classname (str package \".\" text)]\n (Class/forName classname)\n (str \"https://docs.oracle.com/javase/8/docs/api/\"\n (.replace classname \".\" \"/\")\n \".html\"))\n (catch ClassNotFoundException e nil)))))\n" } ]