Skip to content

Commit

Permalink
Allow to optionally skip shading of the blob
Browse files Browse the repository at this point in the history
  • Loading branch information
@kotarak
kotarak committed Mar 26, 2018
1 parent 3ea60c9 commit d501963
Show file tree
Hide file tree
Showing 3 changed files with 65 additions and 40 deletions.
8 changes: 5 additions & 3 deletions UPGRADE.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,13 +8,15 @@ Either you get `[:unrepl.upgrade/failed]` or `[:unrepl/hello ...]` on the repl o

Each use of the blob creates gensymed namespaces.

You can customize the blob: enter `clj -m unrepl.make-blob <target-file> <session actions map>`. Where the session actions map can be either a string or a `.edn` file. For example:
You can customize the blob: enter `clj -m unrepl.make-blob -o <target-file> -a <session actions map>`. Where the session actions map can be either a string or a `.edn` file. For example:

```
# As a string
$> clj -m unrepl.make-blob foo-blob.clj '{:my.own/action (foo/bar #unrepl/param :baz)}'
$> clj -m unrepl.make-blob -o foo-blob.clj -a '{:my.own/action (foo/bar #unrepl/param :baz)}'
# As a file
$> clj -m unrepl.make-blob foo-blob.clj custom-actions.edn
$> clj -m unrepl.make-blob -o foo-blob.clj -a custom-actions.edn
```

If a custom action has a qualified symbol as the first element (function symbol) for its topmost form, this qualified symbol's namespace will automatically be required on the first use of the action.

Shading of the blob may be optionally turned of with the `--noshade` option.
78 changes: 50 additions & 28 deletions src/unrepl/make_blob.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,36 +56,58 @@
regular s))
(str sb)))

(defn- gen-blob [session-actions]
(defn- gen-blob [session-actions shade?]
(let [template (slurp (io/resource "unrepl/blob-template.clj"))
shaded-code-sb (StringBuilder.)
shaded-libs (shade/shade 'unrepl.repl
{:writer (fn [_ ^String code] (.append shaded-code-sb code))
:except [#"clojure\..*" 'unrepl.core]})
code (-> template
(str/replace "unrepl.repl"
(str (shaded-libs 'unrepl.repl)))
(str/replace "<BLOB-PAYLOAD>" (str shaded-code-sb)))]
code (if shade?
(let [shaded-code-sb (StringBuilder.)
shaded-libs (shade/shade 'unrepl.repl
{:writer (fn [_ ^String code] (.append shaded-code-sb code))
:except [#"clojure\..*" 'unrepl.core]})]
(-> template
(str/replace "unrepl.repl"
(str (shaded-libs 'unrepl.repl)))
(str/replace "<BLOB-PAYLOAD>" (str shaded-code-sb))))
(let [read-deps (fn read-deps [deps nspace]
(reduce read-deps (conj deps nspace) (shade/deps nspace)))
code (StringBuilder.)]
(doseq [nspace (remove #(shade/exception % #"clojure\..*") (distinct (read-deps () 'unrepl.repl)))]
(when-let [rdr (shade/ns-reader nspace)]
(with-open [rdr rdr]
(.append code (slurp rdr)))))
(str/replace template "<BLOB-PAYLOAD>" (str code))))]
(str (strip-spaces-and-comments code) "\n" session-actions "\n"))) ; newline to force eval by the repl

(defn -main
([] (-main "resources/unrepl/blob.clj" "{}"))
([target session-actions]
(-> target io/file .getParentFile .mkdirs)
(let [session-actions-source (if (re-find #"^\s*\{" session-actions) session-actions (slurp session-actions))
session-actions-map (edn/read-string {:default (fn [tag data] (tagged-literal 'unrepl-make-blob-unquote (list 'tagged-literal (tagged-literal 'unrepl-make-blob-quote tag) data)))} session-actions-source)]
(if (map? session-actions-map)
(let [session-actions-map (into session-actions-map
(map (fn [[k v]]
[k (tagged-literal 'unrepl-make-blob-syntaxquote
(if (and (seq? v) (symbol? (first v)) (namespace (first v)))
(list 'unrepl.repl/ensure-ns v)
v))]))
session-actions-map)
session-actions (-> session-actions-map pr-str
(str/replace #"#unrepl-make-blob-(?:syntax|un)?quote " {"#unrepl-make-blob-syntaxquote " "`"
"#unrepl-make-blob-unquote " "~"
"#unrepl-make-blob-quote " "'"}))]
(spit target (gen-blob session-actions)))
(println "The arguments must be: a target file name and an EDN map.")))))
([& args]
(let [options (loop [args (seq args)
options {:shade? true
:session-actions "{}"
:target "resources/unrepl/blob.clj"}]
(if args
(condp contains? (first args)
#{"-s" "--noshade"} (recur (next args) (assoc options :shade? false))
#{"-o" "--output"} (recur (nnext args) (assoc options :target (fnext args)))
#{"-a" "--actions"} (recur (nnext args) (assoc options :session-actions (fnext args)))
#{"-h" "--help"} (do
(println "clj -m unrepl.make-blob [--noshade|-s] [--output|-o <file>] [--actions|-a <map-or-file>]")
(System/exit 1))
(throw (ex-info "Unknown argument" {:arg (first args)})))
options))
session-actions-source (if (re-find #"^\s*\{" (:session-actions options)) (:session-actions options) (slurp (:session-actions options)))
session-actions-map (edn/read-string {:default (fn [tag data] (tagged-literal 'unrepl-make-blob-unquote (list 'tagged-literal (tagged-literal 'unrepl-make-blob-quote tag) data)))} session-actions-source)]
(-> options :target io/file .getAbsoluteFile .getParentFile .mkdirs)
(if (map? session-actions-map)
(let [session-actions-map (into session-actions-map
(map (fn [[k v]]
[k (tagged-literal 'unrepl-make-blob-syntaxquote
(if (and (seq? v) (symbol? (first v)) (namespace (first v)))
(list 'unrepl.repl/ensure-ns v)
v))]))
session-actions-map)
session-actions (-> session-actions-map pr-str
(str/replace #"#unrepl-make-blob-(?:syntax|un)?quote " {"#unrepl-make-blob-syntaxquote " "`"
"#unrepl-make-blob-unquote " "~"
"#unrepl-make-blob-quote " "'"}))]
(spit (:target options) (gen-blob session-actions (:shade? options))))
(println "The arguments must be: a target file name and an EDN map.")))))

19 changes: 10 additions & 9 deletions src/unrepl/shade_libs.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,15 @@
(defn hash64 [s]
(-> s (.getBytes "UTF-8") sha1 java.io.ByteArrayInputStream. base64-encode))

(defn exception
[ns-name except]
(cond
(or (map? except) (set? except)) (except ns-name)
(symbol? except) (when (= except ns-name) ns-name)
(instance? java.util.regex.Pattern except) (when (re-matches except (name ns-name)) ns-name)
(coll? except) (some #(exception ns-name %) except)
:else (throw (ex-info (str "Unexpected shading exception rule: " except) {:except except}))))

(defn shade
"Shade all namespaces (transitively) required by ns-name.
Shaded code is written using the writer function: a function of two arguments:
Expand All @@ -54,15 +63,7 @@
The default exceptions is #\"clojure\\..*\", don't forget to reassert that if
you specify your own exceptions."
[ns-name {:keys [writer except] :or {except #"clojure\..*"}}]
(letfn [(rename
([ns-name] (rename ns-name except))
([ns-name except]
(cond
(or (map? except) (set? except)) (except ns-name)
(symbol? except) (when (= except ns-name) ns-name)
(instance? java.util.regex.Pattern except) (when (re-matches except (name ns-name)) ns-name)
(coll? except) (some #(rename ns-name %) except)
:else (throw (ex-info (str "Unexpected shading exception rule: " except) {:except except})))))
(letfn [(rename [ns-name] (exception ns-name except))
(shade [shaded-nses ns-name]
(if (or (shaded-nses ns-name) (rename ns-name))
shaded-nses
Expand Down

0 comments on commit d501963

Please sign in to comment.