-
Notifications
You must be signed in to change notification settings - Fork 13
/
splat_1.clj
125 lines (110 loc) · 4.78 KB
/
splat_1.clj
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
; Copyright (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.x.splat-1
(:use tupelo.core)
(:require
[schema.core :as s]
[tupelo.core :as t]
[tupelo.schema :as tsk]
))
;---------------------------------------------------------------------------------------------------
(declare splatter)
(s/defn ^:no-doc splat-map :- tsk/KeyMap
[the-map :- tsk/Map]
{:type :map
:entries (set ; must be a set so can unit test w/o regard to order
(forv [me the-map]
{:type :map-entry
:key (splatter (key me))
:val (splatter (val me))}))})
(s/defn ^:no-doc splat-list :- tsk/KeyMap
[the-list :- tsk/List]
{:type :list
:entries (set ; must be a set so can unit test w/o regard to order
(forv [[idx item] (indexed the-list)]
{:type :list-entry
:idx idx
:val (splatter item)}))})
(s/defn ^:no-doc splat-set :- tsk/KeyMap
[the-set :- tsk/Set]
{:type :set
:entries (set ; must be a set so can unit test w/o regard to order
(forv [item the-set]
{:type :set-entry
:val (splatter item)}))})
(s/defn ^:no-doc splat-prim :- tsk/KeyMap
[item :- s/Any]
{:type :prim :data item})
; #todo add :depth to each map
(s/defn splatter
[arg]
(cond
(xmap? arg) (splat-map arg)
(xsequential? arg) (splat-list arg)
(set? arg) (splat-set arg)
:else (splat-prim arg)))
;---------------------------------------------------------------------------------------------------
; #todo add :depth to each map
(s/defn unsplatter :- s/Any
[splat :- tsk/KeyMap]
(let [splat-type (grab :type splat)
non-nil-entries-fn (fn [coll]
(drop-if nil?
(grab :entries coll)))]
(cond
(= :map splat-type) (apply glue
(forv [me-splat (non-nil-entries-fn splat)]
{(unsplatter (grab :key me-splat)) (unsplatter (grab :val me-splat))}))
(= :list splat-type) (let [list-vals-sorted-map (into (sorted-map)
(apply glue
(forv [le-splat (non-nil-entries-fn splat)]
{(grab :idx le-splat)
(grab :val le-splat)})))
list-vals (mapv unsplatter
(vals list-vals-sorted-map))]
list-vals)
(= :set splat-type) (into #{}
(forv [se-splat (non-nil-entries-fn splat)]
(unsplatter (grab :val se-splat))))
(= :prim splat-type) (grab :data splat)
:else (throw (ex-info "invalid splat found" (vals->map splat))))))
;-----------------------------------------------------------------------------
(s/defn ^:no-doc walk-splatter-dispatch ; dispatch fn
[ctx-in :- tsk/KeyMap
interceptor :- tsk/KeyMap]
(t/with-spy-indent
(nl) (spyq :dispatch-enter---------------------------------)
(let [enter-fn (or (:enter interceptor) identity)
leave-fn (or (:leave interceptor) identity)
]
(spyx-pretty ctx-in)
(let-spy-pretty
[ctx-post-enter (enter-fn ctx-in)
splat-pre-recurse (grab :splat ctx-post-enter)
]
(let [ctx-post-leave (leave-fn ctx-post-enter)]
(spyq :other-leave---------------------------------)
(nl)
ctx-post-leave)))))
;-----------------------------------------------------------------------------
(s/defn walk-splatter :- s/Any
[data :- s/Any
interceptor :- tsk/KeyMap]
(spyq :walk-enter---------------------------------)
(let [enter-fn (:enter interceptor) ; may be nil
leave-fn (:leave interceptor)] ; may be nil
(when (and (nil? enter-fn) (nil? leave-fn))
(throw (ex-info "Invalid interceptor. :enter and :leave functions cannot both be nil." (vals->map interceptor))))
(let-spy-pretty
[splat-in (splatter data)
ctx-out (walk-splatter-dispatch {:parents [] :splat splat-in} interceptor)
splat-out (grab :splat ctx-out)
data-out (unsplatter splat-out)
]
(spyq :walk-leave---------------------------------)
data-out
)))