@@ -1,256 +0,0 @@
1−module Record.Extra where
2−
3−import Prelude
4−import Data.Array (fromFoldable)
5−import Data.Function.Uncurried (Fn2, runFn2)
6−import Data.List (List, (:))
7−import Data.Tuple (Tuple(..))
8−import Prim.Row as Row
9−import Prim.RowList as RL
10−import Record (get) as R
11−import Record.Builder (Builder)
12−import Record.Builder as Builder
13−import Type.Prelude (class IsSymbol, RProxy(RProxy), RLProxy(RLProxy), SProxy(SProxy), reflectSymbol)
14−
15−mapRecord ∷
16− ∀ row xs a b row'.
17− RL.RowToList row xs =>
18− MapRecord xs row a b () row' =>
19− (a -> b) ->
20− Record row ->
21− Record row'
22−mapRecord f r = Builder.build builder {}
23− where
24− builder = mapRecordBuilder (RLProxy ∷ RLProxy xs) f r
25−
26−class MapRecord (xs ∷ RL.RowList Type) (row ∷ #Type) a b (from ∷ #Type) (to ∷ #Type) | xs -> row a b from to where
27− mapRecordBuilder ∷ RLProxy xs -> (a -> b) -> Record row -> Builder { | from } { | to }
28−
29−instance mapRecordCons ∷
30− ( IsSymbol name
31− , Row.Cons name a trash row
32− , MapRecord tail row a b from from'
33− , Row.Lacks name from'
34− , Row.Cons name b from' to
35− ) =>
36− MapRecord (RL.Cons name a tail) row a b from to where
37− mapRecordBuilder _ f r = first <<< rest
38− where
39− nameP = SProxy ∷ SProxy name
40−
41− val = f $ R.get nameP r
42−
43− rest = mapRecordBuilder (RLProxy ∷ RLProxy tail) f r
44−
45− first = Builder.insert nameP val
46−
47−instance mapRecordNil ∷ MapRecord RL.Nil row a b () () where
48− mapRecordBuilder _ _ _ = identity
49−
50−class ZipRecord (rla ∷ RL.RowList Type) (ra ∷ #Type) (rlb ∷ RL.RowList Type) (rb ∷ #Type) (from ∷ #Type) (to ∷ #Type) | rla -> ra from to
51− , rlb -> rb from to where
52− zipRecordImpl ∷
53− RLProxy rla ->
54− Record ra ->
55− RLProxy rlb ->
56− Record rb ->
57− Builder { | from } { | to }
58−
59−instance zipRecordNil ∷ ZipRecord RL.Nil trashA RL.Nil trashB () () where
60− zipRecordImpl _ _ _ _ = identity
61−
62−instance zipRecordCons ∷
63− ( IsSymbol k
64− , Row.Cons k a trashA ra
65− , Row.Cons k b trashB rb
66− , Row.Cons k (Tuple a b) from' to
67− , Row.Lacks k from'
68− , ZipRecord ta ra tb rb from from'
69− ) =>
70− ZipRecord
71− (RL.Cons k a ta)
72− ra
73− (RL.Cons k b tb)
74− rb
75− from
76− to where
77− zipRecordImpl _ ra _ rb = first <<< tail
78− where
79− name = SProxy ∷ SProxy k
80−
81− head = Tuple (R.get name ra) (R.get name rb)
82−
83− ta = RLProxy ∷ RLProxy ta
84−
85− tb = RLProxy ∷ RLProxy tb
86−
87− tail = zipRecordImpl ta ra tb rb
88−
89− first = Builder.insert name head
90−
91−zipRecord ∷
92− ∀ ta ra tb rb rc.
93− RL.RowToList ra ta =>
94− RL.RowToList rb tb =>
95− ZipRecord ta ra tb rb () rc =>
96− Record ra ->
97− Record rb ->
98− Record rc
99−zipRecord ra rb = Builder.build builder {}
100− where
101− ta = RLProxy ∷ RLProxy ta
102−
103− tb = RLProxy ∷ RLProxy tb
104−
105− builder = zipRecordImpl ta ra tb rb
106−
107−class Keys (xs ∷ RL.RowList Type) where
108− keysImpl ∷ RLProxy xs -> List String
109−
110−instance nilKeys ∷ Keys RL.Nil where
111− keysImpl _ = mempty
112−
113−instance consKeys ∷
114− ( IsSymbol name
115− , Keys tail
116− ) =>
117− Keys (RL.Cons name ty tail) where
118− keysImpl _ = first : rest
119− where
120− first = reflectSymbol (SProxy ∷ SProxy name)
121−
122− rest = keysImpl (RLProxy ∷ RLProxy tail)
123−
124−keys ∷
125− ∀ g row rl.
126− RL.RowToList row rl =>
127− Keys rl =>
128− g row
129− -> List String
130−keys _ = keysImpl (RLProxy ∷ RLProxy rl)
131−
132−foreign import pickFn ∷ ∀ r1 r2. Fn2 (Array String) (Record r1) (Record r2)
133−
134−pick ∷
135− ∀ a r b l.
136− Row.Union b r a =>
137− RL.RowToList b l =>
138− Keys l =>
139− Record a ->
140− Record b
141−pick = runFn2 pickFn ks
142− where
143− ks = fromFoldable $ keys (RProxy ∷ RProxy b)
144−
145−slistKeys ∷
146− ∀ g tuples rl.
147− SListToRowList tuples rl =>
148− Keys rl =>
149− g tuples ->
150− List String
151−slistKeys _ = keysImpl (RLProxy ∷ RLProxy rl)
152−
153−foreign import kind SList
154−
155−foreign import data SCons ∷ Symbol -> SList -> SList
156−
157−foreign import data SNil ∷ SList
158−
159−data SLProxy (xs ∷ SList)
160− = SLProxy
161−
162−infixr 6 type SCons as :::
163−
164−class SListToRowList (xs ∷ SList) (rl ∷ RL.RowList Type) | xs -> rl, rl -> xs
165−
166−instance slToRlSNil ∷ SListToRowList SNil RL.Nil
167−
168−instance slToRlSCons ∷
169− ( SListToRowList sTail tail
170− ) =>
171− SListToRowList (SCons name sTail) (RL.Cons name trash tail)
172−
173−class OrdRecord rl row | rl -> row where
174− compareRecordImpl ∷ RLProxy rl -> Record row -> Record row -> Ordering
175−
176−instance ordRecordCons ∷
177− ( IsSymbol name
178− , Ord ty
179− , Row.Cons name ty trash row
180− , OrdRecord tail row
181− ) =>
182− OrdRecord (RL.Cons name ty tail) row where
183− compareRecordImpl _ a b = case compare valA valB of
184− EQ -> compareRecordImpl tailp a b
185− ordering -> ordering
186− where
187− namep = SProxy ∷ SProxy name
188−
189− valA = R.get namep a
190−
191− valB = R.get namep b
192−
193− tailp = RLProxy ∷ RLProxy tail
194−
195−instance ordRecordNil ∷ OrdRecord RL.Nil row where
196− compareRecordImpl _ _ _ = EQ
197−
198−compareRecord ∷
199− ∀ row rl.
200− RL.RowToList row rl =>
201− OrdRecord rl row =>
202− Record row ->
203− Record row ->
204− Ordering
205−compareRecord a b = compareRecordImpl (RLProxy ∷ RLProxy rl) a b
206−
207−class
208− Functor m <= SequenceRecord rl row from to m | rl -> row from to m where
209− sequenceRecordImpl ∷ RLProxy rl -> Record row -> m (Builder { | from } { | to })
210−
211−instance sequenceRecordSingle ∷
212− ( IsSymbol name
213− , Row.Cons name (m ty) trash row
214− , Functor m
215− , Row.Lacks name ()
216− , Row.Cons name ty () to
217− ) =>
218− SequenceRecord (RL.Cons name (m ty) RL.Nil) row () to m where
219− sequenceRecordImpl _ a = Builder.insert namep <$> valA
220− where
221− namep = SProxy ∷ SProxy name
222−
223− valA = R.get namep a
224−else instance sequenceRecordCons ∷
225− ( IsSymbol name
226− , Row.Cons name (m ty) trash row
227− , Apply m
228− , SequenceRecord tail row from from' m
229− , Row.Lacks name from'
230− , Row.Cons name ty from' to
231− ) =>
232− SequenceRecord (RL.Cons name (m ty) tail) row from to m where
233− sequenceRecordImpl _ a = fn <$> valA <*> rest
234− where
235− namep = SProxy ∷ SProxy name
236−
237− valA = R.get namep a
238−
239− tailp = RLProxy ∷ RLProxy tail
240−
241− rest = sequenceRecordImpl tailp a
242−
243− fn valA' rest' = Builder.insert namep valA' <<< rest'
244−
245−instance sequenceRecordNil ∷ Applicative m => SequenceRecord RL.Nil row () () m where
246− sequenceRecordImpl _ _ = pure identity
247−
248−sequenceRecord ∷
249− ∀ row row' rl m.
250− RL.RowToList row rl =>
251− SequenceRecord rl row () row' m =>
252− Record row ->
253− m (Record row')
254−sequenceRecord a = Builder.build <@> {} <$> builder
255− where
256− builder = sequenceRecordImpl (RLProxy ∷ RLProxy rl) a