-
Notifications
You must be signed in to change notification settings - Fork 0
/
compact.cirru
1192 lines (1191 loc) · 52.5 KB
/
compact.cirru
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
{} (:package |lilac)
:configs $ {} (:init-fn |lilac.main/main!) (:reload-fn |lilac.main/reload!) (:version |0.5.0-a1)
:modules $ [] |calcit-test/compact.cirru
:entries $ {}
:test $ {} (:init-fn |lilac.test/main!) (:reload-fn |lilac.test/reload!)
:modules $ [] |calcit-test/compact.cirru
:files $ {}
|lilac.core $ %{} :FileEntry
:defs $ {}
|*custom-methods $ %{} :CodeEntry (:doc |)
:code $ quote
defatom *custom-methods $ {}
|and+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn and+ (items ? arg)
let
options $ either arg ({})
assert "\"expects items of and+ in vector" $ list? items
{} (:lilac-type :and) (:items items) (:options options)
|any+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn any+ (? arg)
let
options $ either arg ({})
check-keys "\"checking any+" options $ [] :some?
{} (:lilac-type :any) (:options options)
:some? $ :some? options
|bool+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn bool+ (? arg)
{} $ :lilac-type :bool
|core-methods $ %{} :CodeEntry (:doc |)
:code $ quote
def core-methods $ {} (:bool validate-bool) (:string validate-string) (:nil validate-nil) (:fn validate-fn) (:tag validate-tag) (:symbol validate-symbol) (:number validate-number) (:record validate-record) (:dict validate-dict) (:list validate-list) (:set validate-set) (:not validate-not) (:or validate-or) (:and validate-and) (:custom validate-custom) (:component validate-component) (:is validate-is) (:optional validate-optional) (:tuple validate-tuple) (:any validate-any) (:enum validate-enum) (:pick-type validate-pick-type)
|custom+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn custom+ (f ? arg)
let
options $ either arg ({})
{} (:lilac-type :custom) (:fn f) (:options options)
|deflilac $ %{} :CodeEntry (:doc |)
:code $ quote
defmacro deflilac (comp-name args & body)
quasiquote $ defn (~ comp-name) (~ args)
{} (:lilac-type :component)
:name $ quote
~ $ turn-tag comp-name
:args $ [] (~@ args)
:fn $ fn (~ args) (~@ body)
|dev-check $ %{} :CodeEntry (:doc |)
:code $ quote
defmacro dev-check (data rule)
let
result-v $ gensym "\"result"
quasiquote $ when dev?
&let
~ result-v
validate-lilac (~ data) (~ rule)
when
not $ :ok? (~ result-v)
println
:formatted-message $ ~ result-v
, &newline $ str "\"(dev-check "
quote $ ~ data
, "\" "
quote $ ~ rule
, "\"), where props is: " (~ data)
|dev? $ %{} :CodeEntry (:doc |)
:code $ quote
def dev? $ = "\"dev" (get-env "\"mode" "\"release")
|dict+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn dict+ (key-shape item ? arg)
let
options $ either arg ({})
{} (:lilac-type :dict) (:key-shape key-shape) (:item item) (:options options)
|enum+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn enum+ (items ? arg)
{} (:lilac-type :enum)
:items $ cond
set? items
, items
(list? items) (#{} & items)
true $ do (echo "\"Lilac warning: unknown items" items) items
|fn+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn fn+ (? arg)
let
options $ either arg ({})
{} (:lilac-type :fn) (:options options)
|format-message $ %{} :CodeEntry (:doc |)
:code $ quote
defn format-message (acc result)
if (nil? result) acc $ let
message $ str (:message result) "\" at "
filter-not (:coord result) symbol?
recur
str acc
if (some? acc) &newline "\""
, message
:next result
|is+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn is+ (x ? arg)
let
options $ either arg ({})
{} (:lilac-type :is) (:item x)
|list+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn list+ (item ? arg)
let
options $ either arg ({})
check-keys "\"checking list+" options $ [] :allow-seq?
{} (:lilac-type :list) (:item item) (:options options)
:allow-seq? $ :allow-seq? options
|nil+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn nil+ () $ {} (:lilac-type :nil)
|not+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn not+ (item ? arg)
{} (:lilac-type :not) (:item item)
:options $ {}
|number+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn number+ (? arg)
let
options $ either arg ({})
check-keys "\"checking number+" options $ [] :max :min
{} (:lilac-type :number)
:max $ :max options
:min $ :min options
:options options
|ok-result $ %{} :CodeEntry (:doc |)
:code $ quote
def ok-result $ {} (:ok? true)
|optional+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn optional+ (item ? arg)
let
options $ either arg ({})
{} (:lilac-type :optional) (:item item) (:options options)
|or+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn or+ (items ? arg)
let
options $ either arg ({})
assert "\"expects items of or+ in vector" $ list? items
{} (:lilac-type :or) (:items items) (:options options)
|pick-type+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn pick-type+ (dict ? arg)
let
options $ either arg ({})
check-keys "\"checking pick-type+" options $ [] :type-field
{} (:lilac-type :pick-type) (:dict dict) (:options options)
:type-field $ either (:type-field options) :type
|re+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn re+ (re ? arg)
let
options $ either arg ({})
{} (:lilac-type :re) (:re re) (:options options)
|record+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn record+ (pairs ? arg)
let
options $ either arg ({})
check-keys "\"checking record+" options $ [] :exact-keys? :check-keys? :all-optional? :proto
{} (:lilac-type :record) (:pairs pairs) (:options options)
:exact-keys? $ either (:exact-keys? options) false
:check-keys? $ either (:check-keys? options) false
:all-optional? $ either (:all-optional? options) false
:proto $ :proto options
|register-custom-rule! $ %{} :CodeEntry (:doc |)
:code $ quote
defn register-custom-rule! (type-name f)
assert "\"expects type name in tag" $ tag? type-name
assert "\"expects validation method in function" $ fn? f
println "\"registering validation rule" type-name
swap! *custom-methods assoc type-name f
|set+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn set+ (item ? arg)
let
options $ either arg ({})
{} (:lilac-type :set) (:item item) (:options options)
|string+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn string+ (? arg)
let
options $ either arg ({})
check-keys "\"checking string+" options $ [] :nonblank? :re
{} (:lilac-type :string)
:re $ :re options
:nonblank? $ :nonblank? options
:options options
|symbol+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn symbol+ (? arg)
{} $ :lilac-type :symbol
|tag+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn tag+ (? arg)
let
options $ either arg ({})
{} (:lilac-type :tag) (:options options)
|tuple+ $ %{} :CodeEntry (:doc |)
:code $ quote
defn tuple+ (items ? arg)
let
options $ either arg ({})
assert "\"expects items of tuple+ in vector" $ tuple? items
check-keys "\"checking tuple+" options $ [] :in-list? :check-size?
{} (:lilac-type :tuple) (:items items) (:options options)
:check-size? $ :check-size? options
|validate-and $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-and (data rule base-coord)
let
items $ &map:get rule :items
next-coord $ append base-coord 'and
apply-args (items)
fn (xs)
list-match xs
() ok-result
(r0 rs)
let
result $ validate-lilac data r0 next-coord
if (&map:get result :ok?) (recur rs)
{} (:ok? false) (:coord next-coord) (:rule rule) (:data data)
:message $ either
get-in rule $ [] :options :message
, "\"failed validating in \"and\""
:next result
|validate-any $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-any (data rule base-coord)
let
coord $ append base-coord 'number
something? $ either (:some? rule) false
if something?
if (some? data) ok-result $ {} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects something, got " $ preview-data data
, ok-result
|validate-bool $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-bool (data rule coord)
if (bool? data) ok-result $ {} (:ok? false) (:data data) (:rule rule)
:coord $ append coord 'bool
:message $ either
get-in rule $ [] :options :message
str "\"expects a bool, got " $ preview-data data
|validate-component $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-component (data rule coord)
let
lazy-fn $ &map:get rule :fn
next-coord $ append coord
turn-symbol $ :name rule
next-rule $ lazy-fn & (&map:get rule :args)
validate-lilac data next-rule next-coord
|validate-custom $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-custom (data rule coord)
let
method $ :fn rule
next-coord $ append coord 'custom
result $ method data rule coord
if (:ok? result) result $ {} (:ok? false) (:data data) (:rule rule) (:coord next-coord)
:message $ -> (:message result)
either $ get-in rule ([] :options :message)
either "\"failed to validate with custom method"
|validate-dict $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-dict (data rule base-coord)
let
key-rule $ &map:get rule :key-shape
item-rule $ &map:get rule :item
coord $ append base-coord 'dict
if (map? data)
apply-args
to-pairs data
fn (xs)
tag-match (destruct-set xs)
:none
, ok-result
(:some x0 ys)
let
k $ first x0
v $ last x0
child-coord $ append coord k
k-result $ validate-lilac k key-rule child-coord
result $ validate-lilac v item-rule child-coord
if (&map:get k-result :ok?)
if (&map:get result :ok?) (recur ys) result
, k-result
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects a dict, got " $ preview-data data
|validate-enum $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-enum (data rule base-coord)
let
coord $ append base-coord 'enum
items $ &map:get rule :items
if (includes? items data) ok-result $ {} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects value of " (to-lispy-string items) "\", got " $ preview-data data
|validate-fn $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-fn (data rule coord)
let
next-coord $ append coord 'fn
if (fn? data) ok-result $ {} (:ok? false) (:data data) (:rule rule) (:coord next-coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects a function, got " $ preview-data data
|validate-is $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-is (data rule base-coord)
let
coord $ append base-coord 'is
if
= data $ :item rule
, ok-result $ {} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects just "
preview-data $ :item rule
, "\", got " $ preview-data data
|validate-lilac $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-lilac (data rule ? arg) (; println "\"got rule:" rule)
let
coord $ either arg ([])
kind $ &map:get rule :lilac-type
result $ if-let
method $ &map:get core-methods kind
do (; println "\"calling method for" kind method) (method data rule coord)
if-let
user-method $ &map:get (deref *custom-methods) kind
do (; println "\"calling method for" kind method) (user-method data rule coord)
do (println "\"Unknown method:" kind "\"of" rule) (quit! 1)
if (&map:get result :ok?) result $ assoc result :formatted-message (format-message | result)
|validate-list $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-list (data rule base-coord)
let
item-rule $ &map:get rule :item
coord $ append base-coord 'list
if (list? data)
apply-args (data 0)
fn (xs idx)
list-match xs
() ok-result
(x0 xss)
let
child-coord $ append coord idx
result $ validate-lilac x0 item-rule child-coord
if (&map:get result :ok?)
recur xss $ inc idx
, result
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects a list, got " $ preview-data data
|validate-nil $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-nil (data rule coord)
let
next-coord $ append coord 'nil
if (nil? data) ok-result $ {} (:ok? false) (:data data) (:rule rule) (:coord next-coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects a nil, got " $ preview-data data
|validate-not $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-not (data rule base-coord)
let
coord $ append base-coord 'not
item $ &map:get rule :item
result $ validate-lilac data item coord
if (&map:get result :ok?)
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
, "\"expects a inverted value in \"not\""
:next result
, ok-result
|validate-number $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-number (data rule base-coord)
let
coord $ append base-coord 'number
min-v $ &map:get rule :min
max-v $ &map:get rule :max
if (number? data)
if
and
if (some? min-v) (>= data min-v) true
if (some? max-v) (<= data max-v) true
, ok-result $ {} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects number not in the range, got " $ preview-data data
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects a number, got " $ preview-data data
|validate-optional $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-optional (data rule base-coord)
let
item $ &map:get rule :item
coord $ append base-coord 'optional
if (nil? data) ok-result $ validate-lilac data item coord
|validate-or $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-or (data rule coord)
let
items $ &map:get rule :items
next-coord $ append coord 'or
apply-args
items $ []
fn (xs branches)
list-match xs
() $ {} (:ok? false) (:coord next-coord) (:rule rule) (:data data)
:message $ either
get-in rule $ [] :options :message
, "\"found no matched case in \"or\""
:branches branches
:next $ last branches
(r0 rs)
let
result $ validate-lilac data r0 next-coord
if (&map:get result :ok?) result $ recur rs (append branches result)
|validate-pick-type $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-pick-type (data rule coord)
let
dict $ :dict rule
next-coord $ append coord 'pick-type
type-field $ :type-field rule
data-type $ get data type-field
if
nil? $ get dict data-type
{} (:ok? false) (:coord next-coord) (:rule rule) (:data data)
:message $ either
get-in rule $ [] :options :message
str "\"found no matched type in pick-type: " data-type
let
next-rule $ get dict data-type
result $ validate-lilac data next-rule next-coord
if (:ok? result) result $ {} (:ok? false) (:coord next-coord) (:rule rule) (:data data)
:message $ either
get-in rule $ [] :options :message
str "\"failed to match in pick-type"
:next result
|validate-record $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-record (data rule base-coord)
let
coord $ append base-coord 'record
pairs $ &map:get rule :pairs
exact-keys? $ either (&map:get rule :exact-keys?) false
check-keys? $ either (&map:get rule :check-keys?) false
all-optional? $ either (&map:get rule :all-optional?) false
default-message $ -> rule (&map:get :options) (&map:get :message)
wanted-keys $ keys pairs
existed-keys $ if
or (map? data) (record? data)
keys data
check-values $ fn ()
loop
xs $ to-pairs pairs
tag-match (destruct-set xs)
:none
, ok-result
(:some x0 ys)
let
k0 $ first x0
r0 $ last x0
child-coord $ append coord k0
v $ get data k0
if
and all-optional? $ nil? v
recur ys
let
result $ validate-lilac v r0 child-coord
if (:ok? result) (recur ys) result
if
not $ or (map? data)
and (record? data)
if
some? $ :proto rule
&record:matches? (:proto rule) data
, true
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects a record, got " $ preview-data data
cond
exact-keys? $ if (seq-equal existed-keys wanted-keys) (check-values)
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either default-message
let
extra-keys $ seq-difference existed-keys wanted-keys
missing-keys $ seq-difference wanted-keys existed-keys
if
not $ empty? extra-keys
str "\"unexpected record keys " extra-keys "\" for " wanted-keys
str "\"missing record keys " missing-keys "\" of " wanted-keys
check-keys? $ let
extra-keys $ seq-difference existed-keys wanted-keys
if (empty? extra-keys) (check-values)
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either default-message (str "\"unexpected record keys " extra-keys "\" for " wanted-keys)
true $ check-values
|validate-set $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-set (data rule base-coord)
let
item-rule $ :item rule
coord $ append base-coord 'set
if (set? data)
loop
xs data
idx 0
list-match xs
() ok-result
(x0 xss)
let
child-coord $ append coord idx
result $ validate-lilac x0 item-rule child-coord
if (:ok? result)
recur xss $ inc idx
, result
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects a set, got " $ preview-data data
|validate-string $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-string (data rule base-coord)
let
coord $ append base-coord 'string
re $ &map:get rule :re
nonblank? $ either (:nonblank? rule) false
if (string? data)
cond
some? re
do
; if (re-matches data re) ok-result $ {} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects a string in " re "\", got " $ preview-data data
eprintln "\"re-matches is not supported"
(some? nonblank?)
if
and nonblank? $ = | (trim data)
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects nonblank string , got " $ preview-data data
, ok-result
true ok-result
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expected a string, but got " $ preview-data data
|validate-symbol $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-symbol (data rule base-coord)
let
coord $ append base-coord 'symbol
if (symbol? data) ok-result $ {} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects a symbol, got " $ preview-data data
|validate-tag $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-tag (data rule coord)
let
next-coord $ append coord 'tag
if (tag? data) ok-result $ {} (:ok? false) (:data data) (:rule rule) (:coord next-coord)
:message $ either
get-in rule $ [] :options :message
str "\"expects a tag, got " $ preview-data data
|validate-tuple $ %{} :CodeEntry (:doc |)
:code $ quote
defn validate-tuple (data rule coord)
let
items $ &map:get rule :items
next-coord $ append coord 'tuple
if (tuple? data)
if
= (count data) (count items)
let
size $ count data
loop
idx 0
if (< idx size)
let
r0 $ &tuple:nth items idx
y0 $ &tuple:nth data idx
child-coord $ append next-coord idx
result $ validate-lilac y0 r0 child-coord
if (:ok? result)
recur $ inc idx
{} (:ok? false) (:coord next-coord) (:rule rule) (:data y0)
:message $ either
get-in rule $ [] :options :message
, "\"failed validating in \"tuple\""
:next result
{} $ :ok? true
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ str "\"expects rules in for tuple, got " (preview-data data)
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ str "\"expects a vector for tuple, got " (preview-data data)
:ns $ %{} :CodeEntry (:doc |)
:code $ quote
ns lilac.core $ :require
lilac.util :refer $ preview-data check-keys seq-equal seq-difference
|lilac.main $ %{} :FileEntry
:defs $ {}
|main! $ %{} :CodeEntry (:doc |)
:code $ quote
defn main! () (println "\"Started.") (run-demo!)
|reload! $ %{} :CodeEntry (:doc |)
:code $ quote
defn reload! () (println "\"Reloaded.") (run-demo!)
|run-demo! $ %{} :CodeEntry (:doc |)
:code $ quote
defn run-demo! () $ let
result $ validate-lilac router-data (lilac-router+)
if (:ok? result) (println "\"Passed validation!")
println $ :formatted-message result
dev-check "\"1" $ number+
{} $ :x 1
; run-tests
:ns $ %{} :CodeEntry (:doc |)
:code $ quote
ns lilac.main $ :require
lilac.core :refer $ number+ or+ deflilac validate-lilac string+ record+ nil+ dev-check *in-dev?
lilac.router :refer $ router-data lilac-router+
lilac.test :refer $ run-tests
|lilac.router $ %{} :FileEntry
:defs $ {}
|lilac-method+ $ %{} :CodeEntry (:doc |)
:code $ quote
deflilac lilac-method+ () $ optional+
record+
{}
:code $ optional+ (number+)
:type $ is+ :file
:file $ string+
{} $ :check-keys? true
|lilac-router+ $ %{} :CodeEntry (:doc |)
:code $ quote
deflilac lilac-router+ () $ record+
{}
:port $ number+
:routes $ list+ (lilac-router-path+)
{} $ :exact-keys? true
|lilac-router-path+ $ %{} :CodeEntry (:doc |)
:code $ quote
deflilac lilac-router-path+ () $ record+
{}
:path $ string+
:get $ lilac-method+
:post $ lilac-method+
:put $ lilac-method+
:delete $ lilac-method+
:next $ optional+
list+ $ lilac-router-path+
{} $ :check-keys? true
|router-data $ %{} :CodeEntry (:doc |)
:code $ quote
def router-data $ {} (:port 7800)
:routes $ []
{} (:path |home)
:get $ {} (:type :file) (:file |home.json)
{} (:path |plants/:plant-id)
:get $ {} (:type :file) (:file |plant-default.json)
:post $ {} (:type :file) (:file |ok.json)
:next $ []
{} (:path "\"overview")
:get $ {} (:type :file) (:file |overview.json)
{} (:path "\"materials/:material-id")
:get $ {} (:type :file) (:file "\"materials.json")
:next $ []
{} (:path |events)
:get $ {} (:type :file) (:file |events.json)
:delete $ {} (:code 202) (:type :file) (:file "\"ok.json")
:ns $ %{} :CodeEntry (:doc |)
:code $ quote
ns lilac.router $ :require
[] lilac.core :refer $ [] validate-lilac deflilac optional+ tag+ boolean+ number+ string+ custom+ list+ record+ and+ nil+ or+ is+
|lilac.test $ %{} :FileEntry
:defs $ {}
|=ok $ %{} :CodeEntry (:doc |)
:code $ quote
defn =ok (x obj)
= x $ :ok? obj
|lilac-good-number+ $ %{} :CodeEntry (:doc |)
:code $ quote
deflilac lilac-good-number+ (n)
number+ $ {} (:min n)
|main! $ %{} :CodeEntry (:doc |)
:code $ quote
defn main! () (reset! *quit-on-failure? true) (run-tests)
|reload! $ %{} :CodeEntry (:doc |)
:code $ quote
defn reload! () $ run-tests
|run-tests $ %{} :CodeEntry (:doc |)
:code $ quote
defn run-tests () (test-or) (test-and) (test-nil) (test-any) (test-dict) (test-enum) (test-list) (test-tuple) (test-record) (test-custom) (test-number) (test-string) (test-boolean) (test-optional) (test-pick-type) (test-router-config) (test-component-args) (test-optional-record)
|test-and $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-and
testing "\"and number" $ is
=ok true $ validate-lilac 10
and+ $ [] (number+)
number+ $ {} (:min 0)
testing "\"string not number" $ is
=ok false $ validate-lilac 10
and+ $ [] (number+) (string+)
|test-any $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-any
testing "\"a nil" $ is
=ok true $ validate-lilac nil (any+)
testing "\"any in string" $ is
=ok true $ validate-lilac "\"x" (any+)
testing "\"something" $ is
=ok true $ validate-lilac "\"x"
any+ $ {} (:some? true)
testing "\"need something" $ is
=ok false $ validate-lilac nil
any+ $ {} (:some? true)
|test-boolean $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-bool
testing "\"true is bool" $ is
=ok true $ validate-lilac true (bool+)
testing "\"false is bool" $ is
=ok true $ validate-lilac false (bool+)
testing "\"nil is no a bool" $ is
=ok false $ validate-lilac nil (bool+)
testing "\"string is no a bool" $ is
=ok false $ validate-lilac "\"x" (bool+)
|test-component-args $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-component-args
testing "\"number 10 > 8" $ is
=ok true $ validate-lilac 10 (lilac-good-number+ 8)
testing "\"number 10 not > 18" $ is
=ok false $ validate-lilac 10 (lilac-good-number+ 18)
|test-custom $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-custom
let
method-1 $ fn (x rule coord)
if
and (> x 10) (< x 20)
{} $ :ok? true
{} (:ok? false)
:message $ str "\"expects number between 10 amd 20, got " x
testing "\"validating number with custom function" $ is
=ok true $ validate-lilac 11 (custom+ method-1)
testing "\"validating number with custom function" $ is
=ok false $ validate-lilac 21 (custom+ method-1)
let
validate-method-2 $ fn (data rule coord)
if
and (> data 10) (< data 20)
{} $ :ok? true
{} (:ok? false) (:data data) (:rule rule) (:coord coord)
:message $ str "\"expects number between 10 amd 20, got " data
method-2+ $ fn ()
{} $ :lilac-type :method-2
register-custom-rule! :method-2 validate-method-2
testing "\"validating number with custom function" $ is
=ok true $ validate-lilac 11 (method-2+)
testing "\"validating number with custom function" $ is
=ok false $ validate-lilac 21 (method-2+)
|test-dict $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-dict
testing "\"a dict of strings" $ is
=ok true $ validate-lilac
{} ("\"a" "\"a") ("\"b" "\"b")
dict+ (string+) (string+)
testing "\"a dict of strings has no tag" $ is
=ok false $ validate-lilac
{} (:a "\"a") ("\"b" "\"b")
dict+ (string+) (string+)
testing "\"a dict of tag/number" $ is
=ok true $ validate-lilac
{} (:a 1) (:b 2)
dict+ (tag+) (number+)
testing "\"a dict of tag/number not number/tag" $ is
=ok false $ validate-lilac
{} (:a 1) (2 :b)
dict+ (tag+) (number+)
testing "\"a dict of tag/number or tag/string" $ is
=ok true $ validate-lilac
{} (:a 1) (:b "\"two")
dict+ (tag+)
or+ $ [] (number+) (string+)
|test-enum $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-enum
testing "\"1 in enum" $ is
=ok true $ validate-lilac 1
enum+ $ #{} 1 2 3 "\"4"
testing "\"string 4 in enum" $ is
=ok true $ validate-lilac "\"4"
enum+ $ #{} 1 2 3 "\"4"
testing "\"4 not in enum" $ is
=ok false $ validate-lilac 4
enum+ $ #{} 1 2 3 "\"4"
testing "\"100 not in enum with vector" $ is
=ok false $ validate-lilac 100
enum+ $ [] 1 2 3
|test-list $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-list
testing "\"a list of bool" $ is
=ok true $ validate-lilac ([] true true false)
list+ $ bool+
testing "\"a empty list" $ is
=ok true $ validate-lilac ([])
list+ $ bool+
testing "\"nil is not a list" $ is
=ok false $ validate-lilac nil
list+ $ bool+
testing "\"a list of string is not list of boolean" $ is
=ok false $ validate-lilac ([] "\"true" "\"false")
list+ $ bool+
testing "\"vector is not a empty vector" $ is
=ok true $ validate-lilac ([])
list+ $ bool+
testing "\"bool is not a empty vector" $ is
=ok false $ validate-lilac false
list+ $ bool+
testing "\"allow seq for list" $ is
=ok true $ validate-lilac
concat ([] 1) ([] 2)
list+ (number+)
{} $ :allow-seq? true
|test-nil $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-nil
testing "\"a nil" $ is
=ok true $ validate-lilac nil (nil+)
testing "\"string not nil" $ is
=ok false $ validate-lilac "\"x" (nil+)
|test-number $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-number
testing "\"a number" $ is
=ok true $ validate-lilac 1 (number+)
testing "\"tag not a number" $ is
=ok false $ validate-lilac :k (number+)
testing "\"nil not a number" $ is
=ok false $ validate-lilac nil (number+)
testing "\"number larger than 100" $ is
=ok true $ validate-lilac 101
number+ $ {} (:min 100)
testing "\"99 is not larger than 100" $ is
=ok false $ validate-lilac 99
number+ $ {} (:min 100)
|test-optional $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-optional
testing "\"optional value" $ is
=ok true $ validate-lilac nil
optional+ $ number+
testing "\"optional value a number" $ is
=ok true $ validate-lilac 1
optional+ $ number+
testing "\"not not fit optional number" $ is
=ok false $ validate-lilac "\"1"
optional+ $ number+
|test-optional-record $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-optional-record
testing "\"record with optional" $ is
=ok false $ validate-lilac
{} $ 1 100
record+
{}
1 $ number+
2 $ number+
{} (:all-optional? false) (:check-keys? true)
testing "\"record not with optional" $ is
=ok true $ validate-lilac
{} $ 1 100
record+
{}
1 $ number+
2 $ number+
{} (:all-optional? true) (:check-keys? true)
|test-or $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-or
testing "\"number or string" $ is
=ok true $ validate-lilac 10
or+ $ [] (number+) (string+)
testing "\"number or string" $ is
=ok true $ validate-lilac "\"10"
or+ $ [] (number+) (string+)
testing "\"tag is not number or string" $ is
=ok false $ validate-lilac :x
or+ $ [] (number+) (string+)
|test-pick-type $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-pick-type
let
a-or-b $ pick-type+
{}
:a $ record+
{}
:type $ is+ :a
:name $ string+
:b $ record+
{}
:type $ is+ :b
:size $ number+
testing "\"pick-type of a" $ is
=ok true $ validate-lilac
{} (:type :a) (:name "\"a")
, a-or-b
testing "\"pick-type of b" $ is
=ok true $ validate-lilac
{} (:type :b) (:size 1)
, a-or-b
testing "\"pick-type of unknown c" $ is
=ok false $ validate-lilac
{} $ :type :c
, a-or-b
testing "\"pick-type fail b" $ is
=ok false $ validate-lilac
{} (:type :b) (:name "\"a")
, a-or-b
testing "\"pick-type fail a" $ is
=ok false $ validate-lilac
{} (:type :a) (:name 1)
, a-or-b
testing "\"pick-type with custom field" $ is
=ok true $ validate-lilac
{} (:branch :a) (:name "\"a")
pick-type+
{}
:a $ record+
{}
:branch $ is+ :a
:name $ string+
:b $ record+
{}
:branch $ is+ :b
:size $ number+
{} $ :type-field :branch
|test-record $ %{} :CodeEntry (:doc |)
:code $ quote
deftest test-record
testing "\"an empty record" $ is
=ok true $ validate-lilac ({})
record+ $ {}
testing "\"a record of numbers" $ is
=ok true $ validate-lilac
{} (1 100) (2 200)
record+
{}
1 $ number+
2 $ number+
, nil
testing "\"a record of numbers of not tag/number" $ is
=ok false $ validate-lilac
{} (:a 100) (:b 200)
record+
{}
1 $ number+
2 $ number+
, nil
testing "\"n record of number and vector/string" $ is
=ok true $ validate-lilac
{} (:a 100)
:b $ [] "\"red" "\"blue"
record+
{}
:a $ number+