Skip to content

Commit 9c347db

Browse files
tonskytonsky
committed
hashp
1 parent d25a2f6 commit 9c347db

7 files changed

Lines changed: 245 additions & 33 deletions

File tree

‎deps.edn‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,10 @@
1-
{:paths ["src" "resources"]
2-
:deps
1+
{:deps
32
{org.clojure/clojure {:mvn/version "1.12.0"}}
43
:aliases
54
{:dev
65
{:extra-paths ["dev" "test"]
76
:extra-deps
8-
{io.github.tonsky/duti {:git/sha "e36d65296a4f9758664309ec35b00887e88c405a"}}
7+
{io.github.tonsky/clj-reload {:mvn/version "0.9.4"}}
98
:jvm-opts ["-ea"
109
"-Dclojure.main.report=stderr"
1110
"-Duser.language=en"

‎dev/user.clj‎

Lines changed: 40 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,17 +1,50 @@
11
(ns user
22
(:require
3-
[duti.core :as duti]))
3+
[clj-reload.core :as reload]
4+
[clojure.core.server :as server]
5+
[clojure.java.io :as io]
6+
[clojure.test :as test]))
47

5-
(duti/set-dirs "src" "dev" "test")
8+
(reload/init
9+
{:dirs ["src" "dev" "test"]
10+
:no-reload '#{user}
11+
:output :quieter})
612

713
(def reload
8-
duti/reload)
14+
reload/reload)
915

10-
(def -main
11-
duti/-main)
16+
(defn -main [& args]
17+
(let [{port "--port"} args
18+
port (if port
19+
(parse-long port)
20+
(+ 1024 (rand-int 64512)))
21+
_ (println "Started Server Socket REPL on port" port)
22+
file (io/file ".repl-port")]
23+
(spit file port)
24+
(.deleteOnExit file)
25+
(server/start-server
26+
{:name "repl"
27+
:accept 'clojure.core.server/repl
28+
:server-daemon false
29+
:port port})))
30+
31+
(defn- run-tests [re]
32+
(reload/reload {:only re})
33+
(let [vars (for [ns (reload/find-namespaces re)
34+
var (vals (ns-interns (the-ns ns)))
35+
:when (:test (meta var))
36+
:when (:only (meta var))]
37+
var)]
38+
(if (empty? vars)
39+
(test/run-all-tests re)
40+
(binding [test/*report-counters* (ref test/*initial-report-counters*)]
41+
(test/test-vars vars)
42+
(test/do-report (assoc @test/*report-counters* :type :summary))
43+
@test/*report-counters*))))
1244

1345
(defn test-all []
14-
(duti/test #"clojure\+\.(?!test-test$).*"))
46+
(run-tests #"clojure\+\.(?!test-test$).*"))
1547

1648
(defn -test-main [_]
17-
(duti/test-exit #"clojure\+\.(?!test-test$).*"))
49+
(let [{:keys [fail error]} (run-tests #"clojure\+\.(?!test-test$).*")]
50+
(System/exit (+ fail error))))

‎src/clojure+/error.clj‎

Lines changed: 3 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -2,36 +2,17 @@
22
(:require
33
[clojure.java.io :as io]
44
[clojure.stacktrace :as stacktrace]
5-
[clojure.string :as str])
5+
[clojure.string :as str]
6+
[clojure+.util :as util])
67
(:import
78
[clojure.lang Compiler ExceptionInfo MultiFn]
89
[java.io Writer]))
910

10-
(defn- color? []
11-
(cond
12-
(System/getenv "NO_COLOR")
13-
false
14-
15-
(= "true" (System/getProperty "clojure-plus.color"))
16-
true
17-
18-
(System/getProperty "clojure-plus.color")
19-
false
20-
21-
(find-ns 'nrepl.core)
22-
true
23-
24-
(System/console)
25-
true
26-
27-
:else
28-
true))
29-
3011
(defn- default-config []
3112
{:clean? true
3213
:trace-transform nil
3314
:collapse-common? true
34-
:color? (color?)
15+
:color? (util/color?)
3516
:reverse? false
3617
:root-cause-only? false
3718
:indent 2})

‎src/clojure+/hashp.clj‎

Lines changed: 104 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,104 @@
1+
(ns clojure+.hashp
2+
(:require
3+
[clojure.string :as str]
4+
[clojure.pprint :as pprint]
5+
[clojure.walk :as walk]
6+
[clojure+.util :as util])
7+
(:import
8+
[clojure.lang Compiler TaggedLiteral]))
9+
10+
(defn- default-config []
11+
{:symbol 'p
12+
:color? (util/color?)})
13+
14+
(def config
15+
(default-config))
16+
17+
(def ^:private lock
18+
(Object.))
19+
20+
(defn- pos []
21+
(let [trace (->> (Thread/currentThread)
22+
(.getStackTrace)
23+
(seq))
24+
el ^StackTraceElement (nth trace 7)
25+
cls (Compiler/demunge (.getClassName el))
26+
file (.getFileName el)
27+
line (.getLineNumber el)]
28+
(str "["
29+
cls
30+
(when file (str " " file))
31+
(when line (str ":" line))
32+
"]")))
33+
34+
(defn- ansi-blue []
35+
(when (:color? config)
36+
"\033[34m"))
37+
38+
(defn- ansi-grey []
39+
(when (:color? config)
40+
"\033[37m"))
41+
42+
(defn- ansi-reset []
43+
(when (:color? config)
44+
"\033[0m"))
45+
46+
(defn hashp-impl [form res]
47+
(let [position (pos)
48+
form (walk/postwalk
49+
(fn [form]
50+
(if (and (list? form) (::form (meta form)))
51+
(TaggedLiteral/create (:symbol config) (::form (meta form)))
52+
form))
53+
form)]
54+
(locking lock
55+
(println (str (ansi-blue) "#" (:symbol config) " " form " " (ansi-grey) position (ansi-reset)))
56+
(pprint/pprint res))
57+
res))
58+
59+
(defn- add-first [x form]
60+
(if (seq? form)
61+
(list* (first form) x (next form))
62+
(list form x)))
63+
64+
(defn- add-last [x form]
65+
(if (seq? form)
66+
(list* (concat form [x]))
67+
(list form x)))
68+
69+
(defn hashp
70+
"Add #p before any form to quickly print its value to output next time
71+
it’s evaluated. Works inside -> ->> too!"
72+
[form]
73+
(let [x-sym (gensym "x")
74+
y-sym (gensym "y")
75+
form-first (add-first x-sym form)
76+
form-last (add-last y-sym form)]
77+
`^{::form ~form}
78+
((fn
79+
([_#]
80+
(hashp-impl '~form ~form))
81+
([~x-sym ~y-sym]
82+
(hashp-impl '~form
83+
(cond
84+
(= ::undef ~x-sym) ~form-last
85+
(= ::undef ~y-sym) ~form-first
86+
:else (throw (Exception. "Impossible!"))))))
87+
::undef)))
88+
89+
(defn install!
90+
([]
91+
(install! {}))
92+
([opts]
93+
(let [config (merge (default-config) opts)
94+
_ (.doReset #'config config)
95+
sym (:symbol config)]
96+
(alter-var-root #'*data-readers* assoc sym #'hashp)
97+
(when (thread-bound? #'*data-readers*)
98+
(set! *data-readers* (assoc *data-readers* sym #'hashp))))))
99+
100+
(defn uninstall! []
101+
(let [sym (:symbol config)]
102+
(alter-var-root #'*data-readers* dissoc sym)
103+
(when (thread-bound? #'*data-readers*)
104+
(set! *data-readers* (dissoc *data-readers* sym)))))

‎src/clojure+/print.clj‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -540,7 +540,7 @@
540540
(let [readers (data-readers opts)]
541541
(alter-var-root #'*data-readers* merge readers)
542542
(when (thread-bound? #'*data-readers*)
543-
(set! *data-readers* (.getRawRoot #'*data-readers*))))))
543+
(set! *data-readers* (merge *data-readers* readers))))))
544544

545545
(defn install!
546546
"Install both printers and readers for most of Clojure built-in data structures.

‎src/clojure+/util.clj‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
(ns clojure+.util)
2+
3+
(defn color? []
4+
(cond
5+
(System/getenv "NO_COLOR")
6+
false
7+
8+
(= "true" (System/getProperty "clojure-plus.color"))
9+
true
10+
11+
(System/getProperty "clojure-plus.color")
12+
false
13+
14+
(find-ns 'nrepl.core)
15+
true
16+
17+
(System/console)
18+
true
19+
20+
:else
21+
true))

‎test/clojure+/hashp_test.clj‎

Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
1+
(ns clojure+.hashp-test
2+
(:refer-clojure :exclude [eval])
3+
(:require
4+
[clojure.string :as str]
5+
[clojure.test :as test :refer [are deftest is testing use-fixtures]]
6+
[clojure+.hashp :as hashp])
7+
(:import
8+
[java.io StringWriter]))
9+
10+
(defn eval [s]
11+
(let [sw (StringWriter.)
12+
res (binding [*out* sw]
13+
(clojure.core/eval (read-string s)))]
14+
{:out (-> (str sw)
15+
(str/replace #"(?<!\033)\[[^\]]+\]" "[<pos>]"))
16+
:res res}))
17+
18+
(defmacro with-hashp [opts & body]
19+
`(try
20+
(hashp/install! ~opts)
21+
~@body
22+
(finally
23+
(hashp/uninstall!))))
24+
25+
(deftest color-test
26+
(with-hashp {:color? true}
27+
(testing "Result is passed through"
28+
(is (= 1 (:res (eval "#p 1")))))
29+
30+
(testing "Colored output"
31+
(is (= "\033[34m#p 1 \033[37m[<pos>]\033[0m\n1\n"
32+
(:out (eval "#p 1")))))))
33+
34+
(deftest basic-test
35+
(with-hashp {:color? false}
36+
(testing "Black & white output"
37+
(is (= "#p 1 [<pos>]\n1\n"
38+
(:out (eval "#p 1")))))
39+
40+
(testing "Nesting"
41+
(is (= "#p 1 [<pos>]
42+
1
43+
#p 2 [<pos>]
44+
2
45+
#p (+ #p 1 #p 2) [<pos>]
46+
3
47+
"
48+
(:out (eval "#p (+ #p 1 #p 2)")))))
49+
50+
(testing "Thread first"
51+
(is (= "#p (+ 2) [<pos>]\n3\n"
52+
(:out (eval "(-> 1 #p (+ 2) (* 3))")))))
53+
54+
(testing "Thread last"
55+
(is (= "#p (+ 2) [<pos>]\n3\n"
56+
(:out (eval "(->> 1 #p (+ 2) (* 3))")))))
57+
58+
(testing "Thread naked"
59+
(is (= "#p str [<pos>]\n\"1\"\n"
60+
(:out (eval "(-> 1 #p str count)"))))
61+
(is (= "#p str [<pos>]\n\"1\"\n"
62+
(:out (eval "(->> 1 #p str count)")))))))
63+
64+
(deftest symbol-test
65+
(with-hashp {:symbol 'pp
66+
:color? false}
67+
(is (= "#pp 1 [<pos>]
68+
1
69+
#pp 2 [<pos>]
70+
2
71+
#pp (+ #pp 1 #pp 2) [<pos>]
72+
3
73+
"
74+
(:out (eval "#pp (+ #pp 1 #pp 2)"))))))

0 commit comments

Comments
 (0)