-
Notifications
You must be signed in to change notification settings - Fork 13
/
core.cljc
3426 lines (2949 loc) · 128 KB
/
core.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
; Copyrigh (c) Alan Thompson. All rights reserved.
; The use and distribution terms for this software are covered by the Eclipse Public License 1.0
; (http://opensource.org/licenses/eclipse-1.0.php) which can be found in the file epl-v10.html at
; the root of this distribution. By using this software in any fashion, you are agreeing to be
; bound by the terms of this license. You must not remove this notice, or any other, from this
; software.
(ns tupelo.core
"Tupelo - Making Clojure even sweeter"
; We use the self-require trick to force separate compilation stages for macros
; See "ClojureScript Macro Tower & Loop" by Mike Fikes (2015-12-18)
; https://code.thheller.com/blog/shadow-cljs/2019/10/12/clojurescript-macros.html
; http://blog.fikesfarm.com/posts/2015-12-18-clojurescript-macro-tower-and-loop.html
#?(:cljs ; http://blog.fikesfarm.com/posts/2015-12-18-clojurescript-macro-tower-and-loop.html
(:require-macros
[tupelo.core.impl]
[tupelo.core :refer [it-> cond-it-> some-it->
vals->map with-map-vals forv
with-spy-indent spyx spyxx spy-pretty spyx-pretty
let-spy let-spy-pretty let-some map-let* map-let lazy-cons
try-catchall with-exception-default verify
if-java-1-7-plus if-java-1-8-plus
when-clojure-1-8-plus when-clojure-1-9-plus when-not-clojure-1-9-plus
destruct lazy-gen yield yield-all matches?]]))
(:require
; [tupelo.core.impl :as impl]
[clojure.core :as cc]
[clojure.core.async :as async]
[clojure.data.avl :as avl]
[clojure.pprint :as pprint]
[clojure.set :as set]
[clojure.string :as str]
[clojure.test]
[clojure.walk :as walk]
[schema.core :as s]
[tupelo.lexical :as lex]
[tupelo.schema :as tsk])
#?(:clj
(:require [cheshire.core :as cheshire]
[clojure.core.match :as ccm]
[tupelo.types :as types]))
#?(:clj
(:import [java.io BufferedReader ByteArrayOutputStream PrintStream StringReader OutputStream]
[java.nio ByteBuffer])))
;---------------------------------------------------------------------------------------------------
; #todo unify terminolgy (atom/ref/agent)
; -> reset!/ref-set => set
; -> swap!/alter => update
; #todo include this stuff:
; git@github.com:r0man/noencore.git - noencore/src/no/en/core.cljc
;(defmacro xxx [& forms]
; `(i/xxx ~@forms))
; #todo need (defkw :fred) and (kw :fred) to catch errors like
; (when (= person :frid) ; (kw :frid) -> throws
; (println "Hi Barney!"))
; WARNING: cannot use Plumatic schema for functions that may receive an infinite lazy sequence
; as input. See: https://groups.google.com/forum/#!topic/clojure/oM1PH4sXzoA
; #todo need (dbg :awt122 (some-fn 1 2 3)) -> (spy :msg :awt122 (some-fn 1 2 3))
; #todo replace clojure.core/map => tupelo.lazy/map if (t/refer-tupelo :strict)
; #todo replace clojure.core/map : not lazy; can add one of :trunc or :lazy modifiers
; (map + (range 5))
; (map + 0 (range 5))
; (map + (range 5) :lazy)
; (map vector [:a :b :c] (range 9) :trunc) ; error w/o :trunc
;(defn mapper [& args] ; alts: mapr onto morph vmap
; "An eager version of clojure.core/map
; Use (zip ... :trunc) if you want to truncate all inputs to the lenght of the shortest.
; Use (zip ... :lazy) if you want it to be lazy. "
; (apply clojure.core/map args))
; #todo (map-indexed ... :lazy) vmap-indexed
; #todo (mapcat ... :lazy) vmapcat
; #todo (for ... :lazy) vfor
; #todo (concat ... :lazy) vconcat
; #todo: add in clear-nil-entries to recursively delete all k-v pairs where val is nil or empty?
; #todo: create safe-map ns with non-nil/non-dup versions of assoc-in, update-in, dissoc-in (&
; singles). Basically like compiler-like guarentees against misspellings, duplicate entries, missing
; entries.
;(defmacro ^:private safe-> ; #todo: remove this
; [expr & forms]
; (throw (RuntimeException. "Obsolete: replace with: (validate not-nil? (-> <expr> <forms> ))" )))
; (defn round [dblVal :incr (/ 1 3)] ; #todo add
; (let [factor (Math/pow 10 *digits*)]
; (it-> dblVal
; (* it factor)
; (Math/round it)
; (/ it factor))))
; (defn round [dblVal :exp -2]
; (round dblVal :incr (Math/pow 10 *digits*)))
; (defn round [dblVal :digits 2]
; (round dblVal :exp (- *digits*)))
;; #todo delete old definition
;(defn set=
; "Returns true if two collections are equal when converted into sets."
; [& colls]
; (assert (< 1 (count colls))) ; #todo add msg
; (apply = (mapv set colls)))
;-----------------------------------------------------------------------------
; #todo maybe unify update & set for all state types:
; atom-set / atom-update
; ref-set / ref-update
; var-set / var-update
; agent-set / agent-update
; atom-set-both / atom-update-both ; to return [old new] vector
; xxxx-reset / xxxx-alter ; other names
; atom-set-old / atom-update-old ; to return old value, not new
;-----------------------------------------------------------------------------
; "1234.4567.89ab.cdef" also valid for read
; #todo need conversion from Long -> hex string="1234-4567-89ab-cdef" (& inverse)
; #todo need rand-id/randid/rid/rid-str (rand id) -> 64 bit hex string="1234-4567-89ab-cdef"
; i[12] = Random.nextInt(); bytes += i[12].toHexString()
; #todo fix usage docs
; #todo: add (throwed? ...) for testing exceptions
;---------------------------------------------------------------------------------------------------
; #todo make sure works with cljdoc
; #todo wrap = < <= et al to throw ArityException if only 1 arg
; #todo or if not number?
; #todo wrap contains? get etc to enforce "normal" input types: map/set vs vec/list
; #todo contains-key? for map/set, contains-val? for map/set/vec/list (disable contains? for strict) (use .contains for -val)
; #todo (fnil inc 0) => (with-default-args [0 "hello" :cc]
; #todo some-fn-of-3-or-more-args)
; #todo like (some-fn* (glue {0 0 1 "hello" 2 :cc} {<user args here>} ))
(defmacro try-catchall ; from plumatic schema/macros.clj
"A cross-platform variant of try-catch that catches all exceptions.
Does not (yet) support finally, and does not need or want an exception class."
[& body]
(let [try-body (butlast body)
[catch-op ex-symbol & catch-body :as catch-form] (last body)]
(assert (= catch-op 'catch))
(assert (symbol? ex-symbol))
`(tupelo.core.impl/if-cljs
(try ~@try-body (catch js/Object ~ex-symbol ~@catch-body))
(try ~@try-body (catch Throwable ~ex-symbol ~@catch-body)))))
(defmacro type-name-str
"Returns the type/class name of a value as a string. Works for both CLJ and CLJS."
[arg]
`(tupelo.core.impl/if-cljs
(cljs.core/type->str (cljs.core/type ~arg))
(.getName (clojure.core/class ~arg))))
;-----------------------------------------------------------------------------
; for tupelo.string
; #todo move to tupelo.impl
(s/defn ^:no-doc string-increasing? :- s/Bool ; #todo merge with general in tupelo.core
"Returns true if a pair of strings are in increasing lexicographic order."
[a :- s/Str
b :- s/Str ]
(neg? (compare a b)))
(s/defn ^:no-doc string-increasing-or-equal? :- s/Bool ; #todo merge with general in tupelo.core
"Returns true if a pair of strings are in increasing lexicographic order, or equal."
[a :- s/Str
b :- s/Str ]
(or (= a b)
(string-increasing? a b)))
;-----------------------------------------------------------------------------
#?(:clj
(do
(defmacro with-err-str
"Evaluates exprs in a context in which *err* is bound to a fresh
StringWriter. Returns the string created by any nested printing
calls."
[& body]
`(let [s# (new java.io.StringWriter)]
(binding [*err* s#]
~@body
(str s#))))
(defmacro with-system-err-str
"Evaluates exprs in a context in which JVM System/err is bound to a fresh
PrintStream. Returns the string created by any nested printing calls."
[& body]
`(let [baos# (ByteArrayOutputStream.)
ps# (PrintStream. baos#)]
(System/setErr ps#)
~@body
(System/setErr System/err)
(.close ps#)
(.toString baos#)))
(defmacro with-system-out-str
"Evaluates exprs in a context in which JVM System/out is bound to a fresh
PrintStream. Returns the string created by any nested printing calls."
[& body]
`(let [baos# (ByteArrayOutputStream.)
ps# (PrintStream. baos#)]
(System/setOut ps#)
~@body
(System/setOut System/out)
(.close ps#)
(.toString baos#)))
(defmacro discarding-system-err
"Evaluates exprs in a context in which JVM System/err is bound to a fresh PrintStream that is discarded."
[& body]
`(let [ps# (PrintStream. (OutputStream/nullOutputStream))]
(System/setErr ps#)
(let [result# ~@body]
(System/setErr System/err)
(.close ps#)
result#)))
(defmacro discarding-system-out
"Evaluates exprs in a context in which JVM System/out is bound to a fresh PrintStream that is discarded."
[& body]
`(let [ps# (PrintStream. (OutputStream/nullOutputStream))]
(System/setOut ps#)
(let [result# ~@body]
(System/setOut System/out)
(.close ps#)
result#)))
(defn exception-message
"Returns the message from an exception => (.getMessage exception)"
[exception]
(.getMessage exception))
(defn exception-stacktrace
"Returns the stacktrace from an exception "
[exception]
(with-system-err-str
(.printStackTrace exception)))
))
;-----------------------------------------------------------------------------
(declare
glue xfirst xrest append prepend grab fetch-in indexed clip-str validate
walk-with-parents with-nil-default vals->map
spy spyx spy-pretty spyx-pretty let-spy let-spy-pretty
)
;-----------------------------------------------------------------------------
(defn const-fn ; #todo or const-fn or always
"Returns a function that always returns the specified value, and accepts any number of args
(synonym for `clojure.core/constantly`)."
[val]
(constantly val))
(def noop
"A function that accepts any number of args, does nothing, and returns `nil`."
(constantly nil))
(defn truthy?
"Returns true if arg is logical true (neither nil nor false); otherwise returns false."
[arg]
(if arg true false))
(defn falsey?
"Returns true if arg is logical false (either nil or false); otherwise returns false. Equivalent
to (not (truthy? arg))."
[arg]
(if arg false true))
(defn listy?
"Returns true if arg is a list or a seq, else false."
[arg]
(or (list? arg) (seq? arg)))
; #todo keep these? at least do docstring
(defn ->true
"A function that accepts any number of args, does nothing, and returns `true`."
[& args] true)
(defn ->false
"A function that accepts any number of args, does nothing, and returns `false`."
[& args] false)
(defn ->nil
"A function that accepts any number of args, does nothing, and returns `nil`."
[& args] nil)
(defn ->zero
"A function that accepts any number of args, does nothing, and returns the number zero."
[& args] 0)
(defn ->one
"A function that accepts any number of args, does nothing, and returns the number one."
[& args] 1)
(defn nl
"Abbreviated name for `newline`. Accepts varargs to be printed 1 per line after initial newline. "
[& args]
(newline)
(doseq [arg args]
(println arg)))
;-----------------------------------------------------------------------------
(s/defn int-pos? :- s/Bool
"Returns true iff x is an integer and is positive"
[arg] (and (int? arg) (pos? arg) ) )
(s/defn int-neg? :- s/Bool
"Returns true iff x is an integer and is negative"
[arg] (and (int? arg) (neg? arg) ) )
(s/defn int-nonneg? :- s/Bool
"Returns true iff x is an integer and is not negative"
[arg] (and (int? arg) (not (neg? arg))) )
(s/defn int-nonpos? :- s/Bool
"Returns true iff x is an integer and is not positive"
[arg] (and (int? arg) (not (pos? arg))) )
(s/defn nonneg? :- s/Bool
"Returns true iff x is not negative"
[arg] (not (neg? arg)) )
(s/defn nonpos? :- s/Bool
"Returns true iff x is not positive"
[arg] (not (pos? arg)) )
; #todo add not-zero?
;-----------------------------------------------------------------------------
; #todo make coercing versions of these ->sym ->str ->kw ->int for args of (kw, str, sym, int)
(s/defn kw->sym :- s/Symbol
"Converts a keyword to a symbol"
[arg :- s/Keyword]
(symbol (name arg)))
(s/defn kw->str :- s/Str
"Converts a keyword to a string"
[arg :- s/Keyword]
(name arg))
(s/defn sym->str :- s/Str
"Converts a symbol to a string"
[arg :- s/Symbol]
(name arg))
(s/defn sym->kw :- s/Keyword
"Converts a symbol to a keyword"
[arg :- s/Symbol]
(keyword arg))
(s/defn str->sym :- s/Symbol
"Converts a string to a symbol"
[arg :- s/Str]
(symbol arg))
; #todo throw if bad string
(s/defn str->kw :- s/Keyword
"Converts a string to a keyword"
[arg :- s/Str]
(keyword arg))
(s/defn str->chars :- [s/Any] ; #todo make tighter
"Converts a string to a vector of chars"
[arg :- s/Str]
(vec arg))
(defn int->kw [arg]
(keyword (str arg)))
(s/defn ->kw :- s/Keyword
"Coerce arg to a keyword"
[arg :- (s/cond-pre s/Keyword s/Str s/Symbol s/Num)]
(cond
(keyword? arg) arg
(symbol? arg) (sym->kw arg)
(string? arg) (str->kw arg)
(number? arg) (str->kw (str arg))
:else (throw (ex-info "bad arg" {:arg arg})) ))
(s/defn ->str :- s/Str
"Coerce arg to a string"
[arg :- (s/cond-pre s/Keyword s/Str s/Symbol s/Num)]
(cond
(string? arg) arg
(symbol? arg) (sym->str arg)
(keyword? arg) (kw->str arg)
(number? arg) (str arg)
:else (throw (ex-info "bad arg" {:arg arg})) ))
(s/defn ->sym :- s/Symbol
"Coerce arg to a symbol"
[arg :- (s/cond-pre s/Keyword s/Str s/Symbol)]
(cond
(symbol? arg) arg
(keyword? arg) (kw->sym arg)
(string? arg) (str->sym arg)
:else (throw (ex-info "bad arg" {:arg arg}))))
(s/defn codepoint->char :- s/Any ; #todo need clj/cljs char? test
"Convert a unicode int to a char"
[arg :- s/Int]
#?(:clj (char arg))
#?(:cljs
(do
(assert (int? arg))
(.fromCharCode js/String arg) ; #todo just use cljs.core/char ???
)))
(s/defn char->codepoint :- s/Int
"Convert a char to an unicode int"
[arg :- s/Any ] ; #todo need clj/cljs char? test
#?(:clj (int arg))
#?(:cljs
(do
(assert (= 1 (count arg)))
(.charCodeAt arg 0))))
#?(:clj (defn kw->int [arg]
(Integer/parseInt (kw->str arg)))
:cljs (defn kw->int [arg]
(js/parseInt (kw->str arg) 10)))
; #todo add edn->js
; #todo add js->edn (:keywordize-keys true)
#?(:clj (do
; #todo add test & README
(s/defn json->edn
"Shortcut to cheshire.core/parse-string"
[json-str :- s/Str]
(cheshire/parse-string json-str true)) ; true => keywordize-keys
; #todo add test & README
(s/defn edn->json :- s/Str
"Shortcut to cheshire.core/generate-string"
[arg]
(cheshire/generate-string arg)))
:cljs (do
; #todo add test & README
(s/defn json->edn
"Convert from json -> edn"
[json-str :- s/Str]
(js->clj (.parse js/JSON json-str) :keywordize-keys true)) ; true => keywordize-keys
; #todo add test & README
(s/defn edn->json :- s/Str
"Convert from edn -> json "
[arg]
(.stringify js/JSON (clj->js arg)))))
;-----------------------------------------------------------------------------
(s/defn not-nil? :- s/Bool
"Returns true if arg is not nil; false otherwise. Equivalent to (not (nil? arg)),
or the poorly-named clojure.core/some? "
[arg :- s/Any]
(not (nil? arg)))
;(s/defn empty? :- s/Bool
; "Synonym for clojure.core/empty? "
; ; [coll :- [s/Any]] ; #todo extend Prismatic Schema to accept this for strings
; [coll]
; (cc/empty? coll))
(s/defn not-empty? :- s/Bool
"For any collection coll, returns true if coll contains any items; otherwise returns false.
Equivalent to (not (empty? coll))."
; [coll :- [s/Any]] ; #todo extend Prismatic Schema to accept this for strings
[coll]
(not (cc/empty? coll)))
; #todo -> README
(s/defn has-some? :- s/Bool ; #todo rename to has-any? Add warning re new clj/any?
"For any predicate pred & collection coll, returns true if (pred x) is logical true for at least one x in
coll; otherwise returns false. Like clojure.core/some, but returns only true or false."
[pred :- s/Any
coll :- [s/Any] ]
(truthy? (some pred coll)))
; NOTE: was `any?` prior to new `clojure.core/any?` added in clojure 1.9.0-alpha10
; #todo -> README
(s/defn has-none? :- s/Bool
"For any predicate pred & collection coll, returns false if (pred x) is logical true for at least one x in
coll; otherwise returns true. Equivalent to clojure.core/not-any?, but inverse of has-some?."
[pred :- s/Any
coll :- [s/Any] ]
(falsey? (some pred coll))) ; #todo -> (not (has-some? pred coll))
(s/defn contains-elem? :- s/Bool
"For any collection coll & element tgt, returns true if coll contains at least one
instance of tgt; otherwise returns false. Note that, for maps, each element is a
vector (i.e MapEntry) of the form [key value]."
[coll :- s/Any
elem :- s/Any ]
(has-some? truthy?
(mapv #(= elem %) (seq coll))))
(s/defn contains-key? :- s/Bool
"For any map or set, returns true if elem is a map key or set element, respectively"
[map-or-set :- (s/pred #(or (map? %) (set? %)))
elem :- s/Any ]
(contains? map-or-set elem))
(s/defn contains-val? :- s/Bool
"For any map, returns true if elem is present in the map for at least one key."
[map :- tsk/Map
elem :- s/Any ]
(has-some? truthy?
(mapv #(= elem %) (vals map))))
(s/defn dissoc-in :- s/Any ; #todo upgrade tupelo.core
"A sane version of dissoc-in that will not delete intermediate keys.
When invoked as
(dissoc-in the-map [:k1 :k2 :k3... :kZ])
acts like
(clojure.core/update-in the-map [:k1 :k2 :k3...] dissoc :kZ)
That is, only the map entry containing the last key `:kZ` is removed, and all map entries
higher than `:kZ` in the hierarchy are unaffected."
[the-map :- tsk/Map
keys-vec :- [s/Any]] ; #todo Primitive?
(let [num-keys (count keys-vec)
key-to-clear (last keys-vec)
parent-keys (butlast keys-vec)]
(cond
(zero? num-keys) the-map
(= 1 num-keys) (dissoc the-map key-to-clear)
:else (update-in the-map parent-keys dissoc key-to-clear))))
;(defn case
; [& args]
; (throw (ex-info "`case` is evil, use `cond` instead" {:args args} )))
(s/defn ->set :- tsk/Set
"Converts arg to a set."
[arg] (cc/set arg) )
(s/defn ->sorted-set :- tsk/Set
"Coerces a set into a sorted-set"
[set-in :- tsk/Set] (glue (sorted-set) set-in))
(s/defn ->sorted-map :- tsk/Map
"Coerces a map into a sorted-map"
[map-in :- tsk/Map] (glue (sorted-map) map-in))
(defn walk-maps->sorted
"Recursively walks form, converting all maps to sorted-maps. "
[form]
(walk/postwalk (fn [item]
(if (map? item)
(->sorted-map item)
item))
form))
(defn sorted-map-generic
"Returns a generic sorted map, able to accept keys of different classes"
[] (sorted-map-by lex/compare-generic))
(s/defn ->sorted-map-generic :- tsk/Map
"Coerces a map into a sorted-map"
[map-in :- tsk/Map] (glue (sorted-map-generic) map-in))
(defn sorted-set-generic
"Returns a generic sorted set, able to accept keys of different classes"
[] (sorted-set-by lex/compare-generic))
(s/defn ->sorted-set-generic :- tsk/Set
"Coerces a set into a sorted-set-generic"
[set-in :- tsk/Set] (glue (sorted-set-generic) set-in))
(defn unlazy ; #todo need tests & docs. Use for datomic Entity?
"Converts a lazy collection to a concrete (eager) collection of the same type."
[coll]
(let [unlazy-item (fn [item]
(cond
(sequential? item) (vec item)
#?@(:clj [ (map? item) (into (sorted-map-generic) item)
(set? item) (into (sorted-set-generic) item) ]
:cljs [ (map? item) (into (sorted-map) item) ; #todo => (sorted-map-generic)
(set? item) (into (sorted-set) item) ; #todo => (sorted-map-generic)
] )
#?@(:clj [
(instance? java.io.InputStream item) (slurp item) ; #todo need test
(instance? java.util.List item) (vec item) ; #todo need test
(instance? java.util.Map item) (into {} item) ; #todo need test
(instance? java.lang.Iterable item) (into [] item) ; #todo need test
])
:else item))
result (walk/prewalk unlazy-item coll) ]
result))
; #todo impl-merge *****************************************************************************
(defn has-length?
"Returns true if the collection has the indicated length. Does not hang for infinite sequences."
[coll n]
(when (nil? coll) (throw (ex-info "has-length?: coll must not be nil" {:coll coll})))
(let [take-items (cc/take n coll)
rest-items (cc/drop n coll)]
(and (= n (count take-items))
(empty? rest-items))))
(defn only
"Ensures that a sequence is of length=1, and returns the only value present.
Throws an exception if the length of the sequence is not one.
Note that, for a length-1 sequence S, (first S), (last S) and (only S) are equivalent."
[coll]
(when-not (has-length? coll 1)
(throw (ex-info "only: num-items must=1" {:coll coll})))
(clojure.core/first coll))
(defn onlies
"Given an outer collection of length-1 collections, returns a sequence of the unwrapped values.
(onlies [ [1] [2] [3] ]) => [1 2 3]
(onlies #{ [1] [2] [3] }) => #{1 2 3}
"
[coll] (into (unlazy (empty coll)) (mapv only coll)))
(defn only2
"Given a collection like `[[5]]`, returns `5`. Equivalent to `(only (only coll))`."
[coll] (only (only coll)))
;#todo: maybe make functions `only?` and `only2?`
(defn single?
"Returns true if the collection contains a single item.`"
[coll] (and (sequential? coll) (has-length? coll 1)))
(defn pair?
"Returns true if the collection contains exactly 2 items."
[coll] (and (sequential? coll) (has-length? coll 2)))
(defn triple?
"Returns true if the collection contains exactly 3 items."
[coll] (and (sequential? coll) (has-length? coll 3)))
(defn quad?
"Returns true if the collection contains exactly 4 items."
[coll] (and (sequential? coll) (has-length? coll 4)))
(defn first-or-nil
"Returns the first item in a sequence, or nil"
[seq-arg]
(clojure.core/first seq-arg))
(defn second-or-nil
"Returns the second item in a sequence, or nil"
[seq-arg]
(clojure.core/first (drop 1 seq-arg)))
(defn third-or-nil
"Returns the third item in a sequence, or nil"
[seq-arg]
(clojure.core/first (drop 2 seq-arg)))
(defn fourth-or-nil
"Returns the fourth item in a sequence, or nil"
[seq-arg]
(clojure.core/first (drop 3 seq-arg)))
(defn last-or-nil
"Returns the last item in a sequence, or nil"
[seq-arg]
(first-or-nil (reverse seq-arg)))
(defn rest-or-empty
"Returns a sequence with the first item removed, or a zero-length seq if there are no more items"
[seq-arg]
(rest seq-arg))
(defn rest-or-nil
"Returns a sequence with the first item removed, or nil if there are no more items"
[seq-arg]
(next seq-arg))
(defn get-or-nil
[mappy key] (clojure.core/get mappy key))
(defn get-or-default
[mappy key default] (clojure.core/get mappy key default))
; NOTE: Plumatic Schema doesn't handle infininite sequences
(defn xtake ; :- tsk/Collection
"Returns the first n values from a collection. Returns map for map colls.
Throws if empty."
[n ; :- s/Num
coll ; :- tsk/Collection
]
(assert (number? n))
(assert (or (sequential? coll) (map? coll) (set? coll)))
(when (or (nil? coll) (empty? coll))
(throw (ex-info "xtake: invalid coll: " {:coll coll})))
(let [items (cc/take n coll)
actual (count items)]
(when (< actual n)
(throw (ex-info "xtake: insufficient items" {:n n :actual actual})))
(cond
(sequential? coll) (vec items)
(map? coll) (into {} items)
(set? coll) (into #{} items)
:else (throw (ex-info "Invalid collection type" {:coll coll})))))
(s/defn xdrop :- tsk/Collection
"Returns a collection as a vector with the first n values removed. Returns map for map colls.
Throws if empty."
[n :- s/Num
coll :- tsk/Collection]
(assert (number? n))
(assert (or (sequential? coll) (map? coll) (set? coll)))
(when (or (nil? coll) (empty? coll))
(throw (ex-info "xdrop: invalid coll: " {:coll coll})))
(let [taken (cc/take n coll)
taken-cnt (count taken)
remaining (cc/drop n coll)]
(when (not= taken-cnt n)
(throw (ex-info "xdrop: insufficient taken" {:n n :actual taken-cnt})))
(cond
(sequential? coll) (vec remaining)
(map? coll) (into {} remaining)
(set? coll) (into #{} remaining)
:else (throw (ex-info "Invalid collection type" {:coll coll})))))
(defn xfirst ; #todo -> tests
"Returns the first value in a list or vector. Throws if empty."
[coll]
(when (or (nil? coll) (empty? coll))
(throw (ex-info "xfirst: invalid coll: " {:coll coll})))
(nth coll 0))
; #todo fix up for maps
; #todo (it-> coll (take 2 it), (validate (= 2 (count it))), (last it))
(defn xsecond ; #todo -> tests
"Returns the second value in a list or vector. Throws if (< len 2)."
[coll]
(when (or (nil? coll) (empty? coll))
(throw (ex-info "xsecond: invalid coll: " {:coll coll})))
(nth coll 1))
; #todo fix up for maps
(defn xthird ; #todo -> tests
"Returns the third value in a list or vector. Throws if (< len 3)."
[coll ]
(when (or (nil? coll) (empty? coll)) (throw (ex-info "xthird: invalid coll: " {:coll coll})))
(nth coll 2))
; #todo fix up for maps
(defn xfourth ; #todo -> tests
"Returns the fourth value in a list or vector. Throws if (< len 4)."
[coll]
(when (or (nil? coll) (empty? coll)) (throw (ex-info "xfourth: invalid coll: " {:coll coll})))
(nth coll 3))
; #todo fix up for maps
(s/defn xlast :- s/Any ; #todo -> tests
"Returns the last value in a list or vector. Throws if empty."
[coll :- [s/Any]]
(when (or (nil? coll) (empty? coll)) (throw (ex-info "xlast: invalid coll: " {:coll coll})))
(clojure.core/last coll))
; #todo fix up for maps
(s/defn xbutlast :- s/Any ; #todo -> tests
"Returns a vector of all but the last value in a list or vector. Throws if empty."
[coll :- [s/Any]]
(when (or (nil? coll) (empty? coll)) (throw (ex-info "xbutlast: invalid coll: " {:coll coll})))
(vec (clojure.core/butlast coll)))
; #todo fix up for maps
(defn xrest ; #todo -> tests
"Returns the last value in a list or vector. Throws if empty."
[coll]
(when (or (nil? coll) (empty? coll)) (throw (ex-info "xrest: invalid coll: " {:coll coll})))
(clojure.core/rest coll))
(defn xreverse ; #todo -> tests & doc
"Returns a vector containing a sequence in reversed order. Throws if nil."
[coll]
(when (nil? coll) (throw (ex-info "xreverse: invalid coll: " {:coll coll})))
(vec (clojure.core/reverse coll)))
(s/defn xvec :- [s/Any]
"Converts a collection into a vector. Throws if given nil."
[coll :- [s/Any]]
(when (nil? coll) (throw (ex-info "xvec: invalid coll: " {:coll coll})))
(clojure.core/vec coll))
(s/defn ->list :- [s/Any]
"Coerce any sequential argument into a List."
[arg :- [s/Any]]
(apply list arg))
(defmacro forv ; #todo rename for-vec ???
"Like clojure.core/for but returns results in a vector.
Wraps the loop body in a `do` as with `doseq`. Not lazy."
[& forms]
(let [bindings-vec (xfirst forms)
body-forms (xrest forms)]
`(vec (for ~bindings-vec
(do ~@body-forms)))))
(defmacro for-list ; #todo test
"Like clojure.core/for but returns results in an eager list.
Wraps the loop body in a `do` as with `doseq`. Not lazy."
[& forms]
(let [bindings-vec (xfirst forms)
body-forms (xrest forms)]
`(->list (for ~bindings-vec
(do ~@body-forms)))))
(defmacro map-list ; #todo test
"Like clojure.core/map but returns results in an eager list. Not lazy."
[& forms]
`(->list (map ~@forms)))
(defn ^:no-doc for-indexed-impl
[forms]
(let
[bindings-vec (xfirst forms)
body-forms (xrest forms)
>> (when-not (= 2 (count bindings-vec))
(throw (ex-info "for-indexed: binding form must be len=2 " (vals->map bindings-vec))))
bndg-dest (xfirst bindings-vec)
bndg-src (xsecond bindings-vec)]
`(vec
(for [~bndg-dest (indexed ~bndg-src)]
(do ~@body-forms)))))
(defmacro for-indexed
"Like clojure.core/map-indexed, converts each element x in a sequence into a Pair [i x],
where `i` is the zero-based index number. Supports only a single sequence in the binding form.
Wraps all forms with an implicit `(do ...)` as with clojure.core/doseq. Use `tupelo.core/indexed`
for more complicated looping constructs. Usage:
(for-indexed [[i x] vals]
(println (format \"i=%d x=%s\" i x))
{:i i :x x} )
is equivalent to:
(vec
(for [[i x] (indexed vals)]
(do
(println (format \"i=%d x=%s\" i x))
{:i i :x x} ))) "
[& forms]
(for-indexed-impl forms))
; #todo: make (map-ctx {:trunc false :eager true} <fn> <coll1> <coll2> ...) <- default ctx
; #todo: mapz, forz, filterz, ...?
(defn keep-if
"Returns a vector of items in coll for which (pred item) is true (alias for clojure.core/filter)"
[pred coll]
(cond
(sequential? coll) (vec (clojure.core/filter pred coll))
(map? coll) (reduce-kv (fn [cum-map k v]
(if (pred k v)
(assoc cum-map k v)
cum-map))
{}
coll)
(set? coll) (reduce (fn [cum-set elem]
(if (pred elem)
(conj cum-set elem)
cum-set))
#{}
(seq coll))
:else (throw (ex-info "keep-if: coll must be sequential, map, or set." {:coll coll}))))
(defn drop-if
"Returns a vector of items in coll for which (pred item) is false (alias for clojure.core/remove)"
[pred coll]
(keep-if (complement pred) coll))
(s/defn append :- tsk/List
"Given a sequential object (vector or list), add one or more elements to the end."
[listy :- tsk/List
& elems :- [s/Any] ]
(when-not (sequential? listy)
(throw (ex-info "append: Sequential collection required, found=" {:listy listy})))
(when (empty? elems)
(throw (ex-info "Nothing to append! elems=" {:elems elems})))
(vec (concat listy elems)))
(s/defn prepend :- tsk/List
"Given a sequential object (vector or list), add one or more elements to the beginning"
[& args]
(let [elems (butlast args)
listy (xlast args)]
(when-not (sequential? listy)
(throw (ex-info "prepend: Sequential collection required, found=" {:listy listy})))
(when (empty? elems)
(throw (ex-info "Nothing to prepend! elems=" {:elems elems})))
(vec (concat elems listy))))
;-----------------------------------------------------------------------------
; spy stuff
; #todo defn-spy saves fn name to locals for spy printout
; #todo spyxl adds file/line to spy printout
; (def ^:dynamic *spy-enabled* false)
(def ^:dynamic *spy-enabled* true) ; #TODO fix before commit!!!
(def ^:dynamic *spy-enabled-map* {})
(defmacro with-spy-enabled ; #todo README & test
[tag ; :- s/Keyword #todo schema for macros?
& forms ]
`(binding [*spy-enabled-map* (assoc *spy-enabled-map* ~tag true)]
~@forms))
(defmacro check-spy-enabled ; #todo README & test
[tag ; :- s/Keyword #todo schema for macros?
& forms]
`(binding [*spy-enabled* (get *spy-enabled-map* ~tag false)]
~@forms))
(def ^:no-doc spy-indent-level (atom 0))
(defn ^:no-doc spy-indent-spaces []
(str/join (repeat (* 2 @spy-indent-level) \space)))
(defn ^:no-doc spy-indent-inc
"Increase the spy indent level by one."
[]
(swap! spy-indent-level inc))
(defn ^:no-doc spy-indent-dec
"Decrease the spy indent level by one."
[]
(swap! spy-indent-level dec))
(defn spy-indent-reset
"Reset the spy indent level to zero."
[]
(reset! spy-indent-level 0))
;-----------------------------------------------------------------------------
(defn spy2-impl ; 2-arg arity requires user-supplied keyword
[arg1 arg2]
(let [[tag value] (cond
(keyword? arg1) [arg1 arg2]
(keyword? arg2) [arg2 arg1]
:else (throw (ex-info "spy: either first or 2nd arg must be a keyword tag \n args:"
{:arg1 arg1
:arg2 arg2})))]
(when *spy-enabled*
(println (str (spy-indent-spaces) tag " => " (pr-str value))))
value))
(defmacro spy
"A form of (println ...) to ease debugging display of either intermediate values in threading
forms or function return values. There are three variants. Usage:
(spy :msg <msg-string>)
This variant is intended for use in either thread-first (->) or thread-last (->>)
forms. The keyword :msg is used to identify the message string and works equally
well for both the -> and ->> operators. Spy prints both <msg-string> and the
threading value to stdout, then returns the value for further propogation in the
threading form. For example, both of the following:
(-> 2
(+ 3)
(spy :msg \"sum\" )
(* 4))
(->> 2
(+ 3)
(spy :msg \"sum\" )
(* 4))
will print 'sum => 5' to stdout.
(spy <msg-string> <value>)
This variant is intended for simpler use cases such as function return values.
Function return value expressions often invoke other functions and cannot be
easily displayed since (println ...) swallows the return value and returns nil
itself. Spy will output both <msg-string> and the value, then return the value
for use by further processing. For example, the following:
(println (* 2
(spy \"sum\" (+ 3 4))))
will print:
sum => 7
14