├── .gitignore ├── .travis.yml ├── README.md ├── docs └── sleight.jpg ├── lein-sleight ├── .gitignore ├── .lein-classpath ├── project.clj └── src │ └── leiningen │ └── sleight.clj ├── project.clj ├── src └── sleight │ ├── core.clj │ ├── reader.clj │ └── rt.clj └── test └── sleight ├── core_test.clj └── transform_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /pom.xml 2 | *jar 3 | /lib 4 | /classes 5 | /native 6 | /.lein-failures 7 | /checkouts 8 | /.lein-deps-sum 9 | target/** 10 | DS_Store 11 | push 12 | *.nrepl* 13 | *pom.xml.asc -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: lein2 3 | script: lein2 sleight test :make-odd; lein2 test 4 | jdk: 5 | - openjdk7 6 | - oraclejdk7 7 | - openjdk6 -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![](docs/sleight.jpg) 2 | 3 | Sleight allows pervasive transforms to Clojure code, akin to wrapping all your code and the code in the libraries you depend on in the same macro. 4 | 5 | ### what is this good for? 6 | 7 | Possible uses include: 8 | 9 | * language extensions 10 | * pervasive inversion-of-control transforms 11 | * automatic instrumentation 12 | * test coverage metrics 13 | * anything else you can dream up 14 | 15 | ### is this a good idea? 16 | 17 | Maybe! 18 | 19 | ### how do I use it? 20 | 21 | Sleight can be used via the `lein-sleight` plugin. To use in all projects, add `[lein-sleight "0.2.2"]` to the `:plugins` vector of your `:user` profile in `~/.lein/profiles.clj`. 22 | 23 | To use for a specific project, add `[lein-sleight "0.2.2"]` to the `:plugins` vector in `project.clj`. 24 | 25 | --- 26 | 27 | Once this is done, define a transform in your project or one of its dependencies. 28 | 29 | ```clj 30 | (def reverse-vectors 31 | {:pre (fn [] (println "Get ready for some confusion...")) 32 | :transform (fn [x] (riddley.walk/walk-exprs vector? reverse x)) 33 | :post (fn [] (println "That probably didn't go very well"))}) 34 | ``` 35 | 36 | A transform is defined as a map containing one or more of the keys `:pre`, `:transform`, and `:post`. The `:pre` callback is invoked before the reader is hijacked to perform the transformation, the `:transform` function is passed each form as it's read it, and returns a modified form. The `:post` callback is invoked as the process is closed. 37 | 38 | To perform safe code transformations, use [Riddley](https://github.com/ztellman/riddley). 39 | 40 | Then, in your `project.clj`, add something like this: 41 | 42 | ```clj 43 | (project your-project "1.0.0" 44 | :sleight {:default {:transforms [a.namespace/reverse-vectors]} 45 | :partial {:transforms [a.namespace/reverse-vectors] 46 | :namespaces ["another.namespace*"]}}) 47 | ``` 48 | 49 | The `:transforms` key maps onto a list of transforms, which are applied left to right. The `:namespaces` key maps onto a list of namespace filters, which confines the transformation to namespaces which match one of the filters. 50 | 51 | `lein sleight` is not a standalone task, it's meant to modify other tasks. For instance, if we want to apply our transform to code while testing, we'd run: 52 | 53 | ``` 54 | lein sleight test 55 | ``` 56 | 57 | Since we haven't given a selector before the `test` task, the `:default` transform is selected. To specify the `:partial` transform, we'd run: 58 | 59 | ``` 60 | lein sleight :partial test 61 | ``` 62 | 63 | ### license 64 | 65 | Copyright (C) 2013 Zachary Tellman 66 | 67 | Distributed under the MIT License 68 | -------------------------------------------------------------------------------- /docs/sleight.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ztellman/sleight/788d7c11164713cc393058cc8fc5f6ec9c441d7f/docs/sleight.jpg -------------------------------------------------------------------------------- /lein-sleight/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | -------------------------------------------------------------------------------- /lein-sleight/.lein-classpath: -------------------------------------------------------------------------------- 1 | /Users/zach/clj/sleight/lein-sleight/src 2 | /Users/zach/clj/sleight/src 3 | -------------------------------------------------------------------------------- /lein-sleight/project.clj: -------------------------------------------------------------------------------- 1 | (defproject lein-sleight "0.2.2" 2 | :description "A plugin for whole-program transformations via sleight" 3 | :license {:name "MIT License"} 4 | :eval-in-leiningen true 5 | :dependencies [[leinjacker "0.4.1"]]) 6 | -------------------------------------------------------------------------------- /lein-sleight/src/leiningen/sleight.clj: -------------------------------------------------------------------------------- 1 | (ns leiningen.sleight 2 | (:require 3 | [leinjacker.eval :as eval] 4 | [leinjacker.utils :as utils])) 5 | 6 | (defn arguments [args] 7 | (if (and (first args) 8 | (.startsWith ^String (first args) ":")) 9 | [(.substring (first args) 1) (second args) (drop 2 args)] 10 | ["default" (first args) (rest args)])) 11 | 12 | (defn update-project-dependencies 13 | [project] 14 | (utils/merge-projects project {:dependencies [['sleight "0.2.2"]]})) 15 | 16 | (defn switch-form [transforms namespaces] 17 | `(do 18 | (sleight.core/unwrap-reader) 19 | (sleight.core/wrap-reader 20 | (sleight.core/merge-transforms 21 | ~transforms 22 | ~namespaces)))) 23 | 24 | (defn load-form [transforms] 25 | `(do 26 | (require 'sleight.core) 27 | ~@(->> transforms 28 | (map namespace) 29 | (remove nil?) 30 | (map symbol) 31 | (map (fn [ns] `(require '~ns)))))) 32 | 33 | (defn new-eval-in-project [{:keys [transforms namespaces]}] 34 | (fn [eip project form pre-form] 35 | (eip 36 | project 37 | `(do 38 | ~(switch-form transforms namespaces) 39 | ~form) 40 | `(do 41 | ~(load-form transforms) 42 | ~pre-form)))) 43 | 44 | (defn add-built-ins [sleight-options] 45 | (merge 46 | {:identity {:transforms ['sleight.core/identity-transform]}} 47 | sleight-options)) 48 | 49 | (defn sleight 50 | [project & args] 51 | (let [[transform-name task args] (arguments args) 52 | transform (-> project 53 | :sleight 54 | add-built-ins 55 | (get (keyword transform-name)))] 56 | 57 | ;; make sure the reader switch occurs in the sub-task 58 | (if transform 59 | (-> transform 60 | new-eval-in-project 61 | eval/hook-eval-in-project) 62 | (println (str "No sleight transform defined for " (keyword transform-name) ", skipping."))) 63 | 64 | ;; run the sub-task 65 | (eval/apply-task task (update-project-dependencies project) args))) 66 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject sleight "0.2.2" 2 | :description "whole-program transformations for clojure" 3 | :dependencies [] 4 | :profiles {:dev {:dependencies [[org.clojure/clojure "1.9.0-alpha15"] 5 | [riddley "0.1.12"]]}} 6 | :plugins [[lein-sleight "0.2.2"]] 7 | :sleight {:default {:transforms [sleight.transform-test/make-odd]} 8 | :identity {:transforms []}} 9 | :test-selectors {:make-odd :make-odd 10 | :default (complement :make-odd)}) 11 | -------------------------------------------------------------------------------- /src/sleight/core.clj: -------------------------------------------------------------------------------- 1 | (ns sleight.core 2 | (:require 3 | [sleight.rt :as rt])) 4 | 5 | ;;; adapted from clojure.core 6 | 7 | (def ^:private check-cyclic-dependency #'clojure.core/check-cyclic-dependency) 8 | (def ^:private root-resource #'clojure.core/root-resource) 9 | (def ^:private root-directory #'clojure.core/root-directory) 10 | 11 | (defn- load* 12 | [transform & paths] 13 | (doseq [^String path paths] 14 | (let [^String path (if (.startsWith path "/") 15 | path 16 | (str (root-directory (ns-name *ns*)) \/ path))] 17 | (check-cyclic-dependency path) 18 | (let [pending-paths @#'clojure.core/*pending-paths*] 19 | (when-not (= path (first pending-paths)) 20 | (with-bindings {#'clojure.core/*pending-paths* (conj pending-paths path)} 21 | (rt/load* transform (.substring path 1)))))))) 22 | 23 | (def ^:private original-load @#'clojure.core/load) 24 | (def ^:private original-eval @#'clojure.core/eval) 25 | 26 | ;;; 27 | 28 | (defn- merge-functions [merge-fn a b] 29 | (cond 30 | (and a (not b)) a 31 | (and b (not a)) b 32 | (and a b) (merge-fn a b) 33 | :else nil)) 34 | 35 | (defn- filtered-transform [namespaces transform] 36 | (when transform 37 | (if namespaces 38 | (let [namespace-regex (->> namespaces 39 | (map #(str "^" (.replace % "*" ".*"))) 40 | (interpose "|") 41 | (apply str) 42 | re-pattern)] 43 | (fn [x] 44 | (if (re-find namespace-regex (name (ns-name *ns*))) 45 | (transform x) 46 | x))) 47 | transform))) 48 | 49 | (defn merge-transforms 50 | "Given a list of transform descriptors and namespaces in which they should be applied, 51 | returns a merged descriptor which will only transform code within the specified namespaces. 52 | 53 | If `namespaces` is nil, transforms will be applied to all namespaces." 54 | [transforms namespaces] 55 | (->> transforms 56 | (map #(update-in % [:transform] (partial filtered-transform namespaces))) 57 | (reduce 58 | (fn [a b] 59 | {:pre (merge-functions #(do (%1) (%2)) (:pre a) (:pre b)) 60 | :post (merge-functions #(do (%1) (%2)) (:post a) (:post b)) 61 | :transform (merge-functions comp (:transform b) (:transform a))}) 62 | {}))) 63 | 64 | (defn wrap-reader 65 | "Takes a descriptor of a code transform consisting of a `:pre` no-arg callback that is 66 | invoked before the transform, a `:transform` function which takes a form and returns 67 | a modified form, and a `:post` no-arg callback which is invoked when the process is 68 | terminated. All values are optional." 69 | [{:keys [pre post transform]}] 70 | 71 | (when pre 72 | (pre)) 73 | 74 | (when transform 75 | 76 | (alter-var-root #'clojure.core/load 77 | (constantly (partial load* transform))) 78 | 79 | (alter-var-root #'clojure.core/eval 80 | (fn [eval] 81 | (fn [form] 82 | (eval (transform form)))))) 83 | 84 | (when post 85 | (.addShutdownHook (Runtime/getRuntime) 86 | (Thread. post)))) 87 | 88 | (defn unwrap-reader 89 | "Returns the reader to its original state, undoing all invocations to wrap-reader." 90 | [] 91 | (alter-var-root #'clojure.core/load (constantly original-load)) 92 | (alter-var-root #'clojure.core/eval (constantly original-eval))) 93 | 94 | (def identity-transform 95 | {:transform identity}) 96 | -------------------------------------------------------------------------------- /src/sleight/reader.clj: -------------------------------------------------------------------------------- 1 | (ns sleight.reader 2 | (:require 3 | [clojure.java.io :as io]) 4 | (:import 5 | [java.io 6 | Writer 7 | Reader 8 | StringReader 9 | PushbackReader] 10 | [clojure.lang 11 | LispReader 12 | LineNumberingPushbackReader])) 13 | 14 | ;;; 15 | 16 | (def ^:dynamic *newlines* nil) 17 | 18 | (def switched-printer 19 | (delay 20 | (alter-var-root #'clojure.core/pr-on 21 | (fn [pr-on] 22 | (fn [x ^Writer w] 23 | 24 | ;; special print instructions 25 | (when *newlines* 26 | (.write w (*newlines* (-> x meta :line))) 27 | (when-let [m (meta x)] 28 | (.write w (str "^" (pr-str m) " ")))) 29 | 30 | (pr-on x w)))))) 31 | 32 | ;;; 33 | 34 | (defn ->line-numbering-reader [r] 35 | (if (instance? LineNumberingPushbackReader r) 36 | r 37 | (LineNumberingPushbackReader. r))) 38 | 39 | (defn reader->forms [r] 40 | (let [r (->line-numbering-reader r)] 41 | (->> #(LispReader/read r false ::eof false) 42 | repeatedly 43 | (take-while #(not= ::eof %))))) 44 | 45 | ;;; 46 | 47 | (defn newline-generator [] 48 | (let [counter (atom 1)] 49 | (fn [current-line] 50 | (if-not current-line 51 | "" 52 | (let [diff (max 0 (- current-line @counter))] 53 | (swap! counter + diff) 54 | (->> "\n" (repeat diff) (apply str))))))) 55 | 56 | (defn line-and-meta-preserving-pr-str [newlines x] 57 | (binding [*newlines* newlines 58 | *print-dup* true] 59 | (str 60 | (when-let [m (meta x)] 61 | (str "^" (pr-str m) " ")) 62 | (pr-str x)))) 63 | 64 | ;;; 65 | 66 | (defn lazy-reader-seq [s] 67 | (let [s (atom s)] 68 | (proxy [Reader] [] 69 | (close [] 70 | ) 71 | (read [cbuf offset len] 72 | (if-let [^Reader r (first @s)] 73 | (let [c (.read r)] 74 | (if (= -1 c) 75 | (do 76 | (swap! s rest) 77 | (.read this cbuf offset len)) 78 | (do 79 | (aset cbuf offset (char c)) 80 | 1))) 81 | -1))))) 82 | 83 | (defn dechunk [s] 84 | (when-not (empty? s) 85 | (cons 86 | (first s) 87 | (lazy-seq 88 | (dechunk (rest s)))))) 89 | 90 | ;;; 91 | 92 | (defn transform-reader [transform r] 93 | (let [_ @switched-printer ;; prime the switched printer 94 | newlines (newline-generator)] 95 | (->> r 96 | reader->forms 97 | dechunk 98 | (map transform) 99 | (map #(line-and-meta-preserving-pr-str newlines %)) 100 | (map #(StringReader. %)) 101 | lazy-reader-seq 102 | LineNumberingPushbackReader.))) 103 | -------------------------------------------------------------------------------- /src/sleight/rt.clj: -------------------------------------------------------------------------------- 1 | (ns sleight.rt 2 | (:require 3 | [sleight.reader :as reader] 4 | [clojure.java.io :as io]) 5 | (:import 6 | [java.io 7 | InputStreamReader 8 | InputStream 9 | FileNotFoundException] 10 | [clojure.lang 11 | RT 12 | Compiler])) 13 | 14 | (defn resource [file] 15 | (RT/getResource (RT/baseLoader) file)) 16 | 17 | (defn ^InputStream resource->stream [file] 18 | (RT/resourceAsStream (RT/baseLoader) file)) 19 | 20 | (defn ^InputStreamReader resource->reader [file] 21 | (InputStreamReader. (resource->stream file))) 22 | 23 | (defn file->name [^String file] 24 | (let [slash (.lastIndexOf file "/")] 25 | (if (pos? slash) 26 | (.substring file (inc slash)) 27 | file))) 28 | 29 | ;; RT.compile 30 | 31 | (defn compile* [transform ^String file] 32 | (let [in (resource->reader file)] 33 | (if in 34 | (try 35 | (Compiler/compile 36 | (reader/transform-reader transform in) 37 | file 38 | (file->name file)) 39 | (finally 40 | (.close in))) 41 | (throw (FileNotFoundException. (str "Could not locate Clojure resource on classpath: " file)))))) 42 | 43 | ;; RT.loadResourceScript 44 | 45 | (defn load-resource-script* [transform ^String file] 46 | (let [in (resource->reader file)] 47 | (if in 48 | (try 49 | (Compiler/load 50 | (reader/transform-reader transform in) 51 | file 52 | (file->name file)) 53 | (finally 54 | (.close in))) 55 | (throw (FileNotFoundException. (str "Could not locate Clojure resource on classpath: " name)))))) 56 | 57 | ;; RT.load 58 | 59 | (defn push-bindings [] 60 | (let [fields [#'*ns* #'*warn-on-reflection* #'*unchecked-math*]] 61 | (push-thread-bindings (zipmap fields (map deref fields))))) 62 | 63 | (defn load-class? [class-file clj-file] 64 | (let [class-url (resource class-file) 65 | clj-url (resource clj-file)] 66 | (and 67 | class-url 68 | (or (not clj-url) 69 | (> (RT/lastModified class-url class-file) 70 | (RT/lastModified clj-url clj-file)))))) 71 | 72 | (defn load* [transform script-base] 73 | (let [class-file (str script-base RT/LOADER_SUFFIX ".class") 74 | clj-file (str script-base ".clj") 75 | loaded? (when (load-class? class-file clj-file) 76 | (try 77 | (push-bindings) 78 | (RT/loadClassForName (str (.replace script-base "/" ".") RT/LOADER_SUFFIX)) 79 | (finally 80 | (pop-thread-bindings))))] 81 | 82 | (when-not loaded? 83 | (if (resource clj-file) 84 | (if @Compiler/COMPILE_FILES 85 | (compile* transform clj-file) 86 | (load-resource-script* transform clj-file)) 87 | (throw (FileNotFoundException. (format "Could not locate %s or %s on classpath" class-file clj-file))))))) 88 | 89 | 90 | -------------------------------------------------------------------------------- /test/sleight/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns sleight.core-test 2 | (:require 3 | [clojure.test :refer :all])) 4 | 5 | (deftest ^:make-odd test-make-odd 6 | (is (= 2 3)) 7 | (is (not= 1 2)) 8 | (is (= 2 2)) 9 | (is (= 3 3))) 10 | 11 | (deftest test-normal 12 | (is (not= 2 3)) 13 | (is (not= 1 2)) 14 | (is (= 2 2)) 15 | (is (= 3 3))) 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /test/sleight/transform_test.clj: -------------------------------------------------------------------------------- 1 | (ns sleight.transform-test 2 | (:require 3 | [riddley.walk :as r])) 4 | 5 | (def make-odd 6 | {:transform (fn [x] 7 | (r/walk-exprs 8 | #(and (number? %) (even? %)) 9 | inc 10 | x))}) 11 | --------------------------------------------------------------------------------