Skip to content

Commit 04e984f

Browse files
author
Athan Clark
committed
redesign, with generic instances
1 parent 6587b09 commit 04e984f

File tree

4 files changed

+206
-32
lines changed

4 files changed

+206
-32
lines changed

‎bower.json

+2-1
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,8 @@
1414
"dependencies": {
1515
"purescript-prelude": "^4.1.0",
1616
"purescript-unsafe-coerce": "^4.0.0",
17-
"purescript-typelevel": "^4.0.0"
17+
"purescript-typelevel": "^4.0.0",
18+
"purescript-generics-rep": "^6.1.0"
1819
},
1920
"devDependencies": {
2021
"purescript-psci-support": "^4.0.0"

‎src/Data/Tuple/Native.js

-4
Original file line numberDiff line numberDiff line change
@@ -6,10 +6,6 @@ exports.prjImpl = function projImpl1 (n) {
66
};
77
};
88

9-
exports.showTupleN = function showTupleN (t) {
10-
return JSON.stringify(t);
11-
};
12-
139
exports.t2 = function t21 (a) {
1410
return function t22 (b) {
1511
return [a,b];

‎src/Data/Tuple/Native.purs

+199-23
Original file line numberDiff line numberDiff line change
@@ -8,53 +8,50 @@ module Data.Tuple.Native
88
, class TupleSize, class ShowNat
99
) where
1010

11-
import Prelude (class Show)
12-
import Data.Typelevel.Num (D0, D1, D2, D3, D4, D5, D6, D7, D8, D9, class Lt, class Nat, toInt)
13-
import Type.Row (class RowToList, Cons, Nil, kind RowList)
11+
import Prelude (($))
12+
import Data.Typelevel.Num
13+
( D0, D1, D2, D3, D4, D5, D6, D7, D8, D9, class Lt, class Nat, toInt
14+
, d0, d1, d2, d3, d4, d5, d6, d7, d8)
15+
import Data.Generic.Rep (class Generic, Constructor (..), Argument (..), Product (..))
16+
import Type.Row (Cons, Nil, kind RowList, class ListToRow)
1417
import Prim.Row (class Cons)
1518

1619

1720
foreign import prjImpl :: forall t a. Int -> TupleN t -> a
1821

1922
-- | Project a value of index `n` from a `TupleN`, using `Data.TypeLevel.Num.Reps.dN` as Nat values.
20-
prj :: forall t t' t_ n n' a size
21-
. RowToList t t_
22-
=> TupleSize size t_
23+
prj :: forall t t' t'' n n' a size
24+
. TupleSize size t
2325
=> Lt n size
2426
=> ShowNat n n'
25-
=> Cons n' a t' t
27+
=> ListToRow t t'
28+
=> Cons n' a t'' t'
2629
=> Nat n
2730
=> n -> TupleN t -> a
2831
prj n t = prjImpl (toInt n) t
2932

3033

3134

3235
-- | Represented as a heterogeneous array under the hood
33-
foreign import data TupleN :: # Type -> Type
34-
35-
foreign import showTupleN :: forall t. TupleN t -> String
36-
37-
-- | Unsafe show instance - expects all entries to have a show instance
38-
instance showTupleNInst :: Show (TupleN t) where
39-
show = showTupleN
36+
foreign import data TupleN :: RowList -> Type
4037

4138

4239
type T2 a b =
43-
TupleN ("0" :: a, "1" :: b)
40+
TupleN (Cons "0" a (Cons "1" b Nil))
4441
type T3 a b c =
45-
TupleN ("0" :: a, "1" :: b, "2" :: c)
42+
TupleN (Cons "0" a (Cons "1" b (Cons "2" c Nil)))
4643
type T4 a b c d =
47-
TupleN ("0" :: a, "1" :: b, "2" :: c, "3" :: d)
44+
TupleN (Cons "0" a (Cons "1" b (Cons "2" c (Cons "3" d Nil))))
4845
type T5 a b c d e =
49-
TupleN ("0" :: a, "1" :: b, "2" :: c, "3" :: d, "4" :: e)
46+
TupleN (Cons "0" a (Cons "1" b (Cons "2" c (Cons "3" d (Cons "4" e Nil)))))
5047
type T6 a b c d e f =
51-
TupleN ("0" :: a, "1" :: b, "2" :: c, "3" :: d, "4" :: e, "5" :: f)
48+
TupleN (Cons "0" a (Cons "1" b (Cons "2" c (Cons "3" d (Cons "4" e (Cons "5" f Nil))))))
5249
type T7 a b c d e f g =
53-
TupleN ("0" :: a, "1" :: b, "2" :: c, "3" :: d, "4" :: e, "5" :: f, "6" :: g)
50+
TupleN (Cons "0" a (Cons "1" b (Cons "2" c (Cons "3" d (Cons "4" e (Cons "5" f (Cons "6" g Nil)))))))
5451
type T8 a b c d e f g h =
55-
TupleN ("0" :: a, "1" :: b, "2" :: c, "3" :: d, "4" :: e, "5" :: f, "6" :: g, "7" :: h)
52+
TupleN (Cons "0" a (Cons "1" b (Cons "2" c (Cons "3" d (Cons "4" e (Cons "5" f (Cons "6" g (Cons "7" h Nil))))))))
5653
type T9 a b c d e f g h i =
57-
TupleN ("0" :: a, "1" :: b, "2" :: c, "3" :: d, "4" :: e, "5" :: f, "6" :: g, "7" :: h, "8" :: i)
54+
TupleN (Cons "0" a (Cons "1" b (Cons "2" c (Cons "3" d (Cons "4" e (Cons "5" f (Cons "6" g (Cons "7" h (Cons "8" i Nil)))))))))
5855

5956
foreign import t2 :: forall a b . a -> b -> T2 a b
6057
foreign import t3 :: forall a b c . a -> b -> c -> T3 a b c
@@ -77,6 +74,186 @@ instance tupleSizeT8 :: TupleSize D8 (Cons "0" a (Cons "1" b (Cons "2" c (Cons "
7774
instance tupleSizeT9 :: TupleSize D9 (Cons "0" a (Cons "1" b (Cons "2" c (Cons "3" d (Cons "4" e (Cons "5" f (Cons "6" g (Cons "7" h (Cons "8" i Nil)))))))))
7875

7976

77+
instance genericTuple2 :: Generic
78+
(TupleN (Cons "0" a (Cons "1" b Nil)))
79+
(Constructor "t2" (Product (Argument a) (Argument b))) where
80+
to (Constructor (Product (Argument a) (Argument b))) = t2 a b
81+
from xs = Constructor (Product (Argument (prj d0 xs)) (Argument (prj d1 xs)))
82+
83+
instance genericTuple3 :: Generic
84+
(TupleN (Cons "0" a (Cons "1" b (Cons "2" c Nil))))
85+
(Constructor "t3" (Product (Argument a) (Product (Argument b) (Argument c)))) where
86+
to (Constructor (Product (Argument a) (Product (Argument b) (Argument c)))) = t3 a b c
87+
from xs = Constructor $ Product (Argument (prj d0 xs)) $ Product (Argument (prj d1 xs)) (Argument (prj d2 xs))
88+
89+
instance genericTuple4 :: Generic
90+
(TupleN (Cons "0" a
91+
(Cons "1" b
92+
(Cons "2" c
93+
(Cons "3" d Nil)))))
94+
(Constructor "t4" (Product (Argument a)
95+
(Product (Argument b)
96+
(Product (Argument c)
97+
(Argument d))))) where
98+
to (Constructor (Product (Argument a)
99+
(Product (Argument b)
100+
(Product (Argument c)
101+
(Argument d))))) = t4 a b c d
102+
from xs = Constructor $ Product (Argument (prj d0 xs))
103+
$ Product (Argument (prj d1 xs))
104+
$ Product (Argument (prj d2 xs))
105+
(Argument (prj d3 xs))
106+
107+
instance genericTuple5 :: Generic
108+
(TupleN (Cons "0" a
109+
(Cons "1" b
110+
(Cons "2" c
111+
(Cons "3" d
112+
(Cons "4" e Nil))))))
113+
(Constructor "t5" (Product (Argument a)
114+
(Product (Argument b)
115+
(Product (Argument c)
116+
(Product (Argument d)
117+
(Argument e)))))) where
118+
to (Constructor (Product (Argument a)
119+
(Product (Argument b)
120+
(Product (Argument c)
121+
(Product (Argument d)
122+
(Argument e)))))) = t5 a b c d e
123+
from xs = Constructor $ Product (Argument (prj d0 xs))
124+
$ Product (Argument (prj d1 xs))
125+
$ Product (Argument (prj d2 xs))
126+
$ Product (Argument (prj d3 xs))
127+
(Argument (prj d4 xs))
128+
129+
instance genericTuple6 :: Generic
130+
(TupleN (Cons "0" a
131+
(Cons "1" b
132+
(Cons "2" c
133+
(Cons "3" d
134+
(Cons "4" e
135+
(Cons "5" f Nil)))))))
136+
(Constructor "t6" (Product (Argument a)
137+
(Product (Argument b)
138+
(Product (Argument c)
139+
(Product (Argument d)
140+
(Product (Argument e)
141+
(Argument f))))))) where
142+
to (Constructor (Product (Argument a)
143+
(Product (Argument b)
144+
(Product (Argument c)
145+
(Product (Argument d)
146+
(Product (Argument e)
147+
(Argument f))))))) = t6 a b c d e f
148+
from xs = Constructor $ Product (Argument (prj d0 xs))
149+
$ Product (Argument (prj d1 xs))
150+
$ Product (Argument (prj d2 xs))
151+
$ Product (Argument (prj d3 xs))
152+
$ Product (Argument (prj d4 xs))
153+
(Argument (prj d5 xs))
154+
155+
instance genericTuple7 :: Generic
156+
(TupleN (Cons "0" a
157+
(Cons "1" b
158+
(Cons "2" c
159+
(Cons "3" d
160+
(Cons "4" e
161+
(Cons "5" f
162+
(Cons "6" g Nil))))))))
163+
(Constructor "t7" (Product (Argument a)
164+
(Product (Argument b)
165+
(Product (Argument c)
166+
(Product (Argument d)
167+
(Product (Argument e)
168+
(Product (Argument f)
169+
(Argument g)))))))) where
170+
to (Constructor (Product (Argument a)
171+
(Product (Argument b)
172+
(Product (Argument c)
173+
(Product (Argument d)
174+
(Product (Argument e)
175+
(Product (Argument f)
176+
(Argument g)))))))) = t7 a b c d e f g
177+
from xs = Constructor $ Product (Argument (prj d0 xs))
178+
$ Product (Argument (prj d1 xs))
179+
$ Product (Argument (prj d2 xs))
180+
$ Product (Argument (prj d3 xs))
181+
$ Product (Argument (prj d4 xs))
182+
$ Product (Argument (prj d5 xs))
183+
(Argument (prj d6 xs))
184+
185+
instance genericTuple8 :: Generic
186+
(TupleN (Cons "0" a
187+
(Cons "1" b
188+
(Cons "2" c
189+
(Cons "3" d
190+
(Cons "4" e
191+
(Cons "5" f
192+
(Cons "6" g
193+
(Cons "7" h Nil)))))))))
194+
(Constructor "t8" (Product (Argument a)
195+
(Product (Argument b)
196+
(Product (Argument c)
197+
(Product (Argument d)
198+
(Product (Argument e)
199+
(Product (Argument f)
200+
(Product (Argument g)
201+
(Argument h))))))))) where
202+
to (Constructor (Product (Argument a)
203+
(Product (Argument b)
204+
(Product (Argument c)
205+
(Product (Argument d)
206+
(Product (Argument e)
207+
(Product (Argument f)
208+
(Product (Argument g)
209+
(Argument h))))))))) = t8 a b c d e f g h
210+
from xs = Constructor $ Product (Argument (prj d0 xs))
211+
$ Product (Argument (prj d1 xs))
212+
$ Product (Argument (prj d2 xs))
213+
$ Product (Argument (prj d3 xs))
214+
$ Product (Argument (prj d4 xs))
215+
$ Product (Argument (prj d5 xs))
216+
$ Product (Argument (prj d6 xs))
217+
(Argument (prj d7 xs))
218+
219+
instance genericTuple9 :: Generic
220+
(TupleN (Cons "0" a
221+
(Cons "1" b
222+
(Cons "2" c
223+
(Cons "3" d
224+
(Cons "4" e
225+
(Cons "5" f
226+
(Cons "6" g
227+
(Cons "7" h
228+
(Cons "8" i Nil))))))))))
229+
(Constructor "t9" (Product (Argument a)
230+
(Product (Argument b)
231+
(Product (Argument c)
232+
(Product (Argument d)
233+
(Product (Argument e)
234+
(Product (Argument f)
235+
(Product (Argument g)
236+
(Product (Argument h)
237+
(Argument i)))))))))) where
238+
to (Constructor (Product (Argument a)
239+
(Product (Argument b)
240+
(Product (Argument c)
241+
(Product (Argument d)
242+
(Product (Argument e)
243+
(Product (Argument f)
244+
(Product (Argument g)
245+
(Product (Argument h)
246+
(Argument i)))))))))) = t9 a b c d e f g h i
247+
from xs = Constructor $ Product (Argument (prj d0 xs))
248+
$ Product (Argument (prj d1 xs))
249+
$ Product (Argument (prj d2 xs))
250+
$ Product (Argument (prj d3 xs))
251+
$ Product (Argument (prj d4 xs))
252+
$ Product (Argument (prj d5 xs))
253+
$ Product (Argument (prj d6 xs))
254+
$ Product (Argument (prj d7 xs))
255+
(Argument (prj d8 xs))
256+
80257

81258
class ShowNat n (s :: Symbol) | n -> s, s -> n
82259

@@ -89,4 +266,3 @@ instance showNatD5 :: ShowNat D5 "5"
89266
instance showNatD6 :: ShowNat D6 "6"
90267
instance showNatD7 :: ShowNat D7 "7"
91268
instance showNatD8 :: ShowNat D8 "8"
92-
instance showNatD9 :: ShowNat D9 "9"

‎test/Main.purs

+5-4
Original file line numberDiff line numberDiff line change
@@ -4,12 +4,13 @@ import Data.Tuple.Native
44
import Data.Typelevel.Num
55

66
import Prelude
7-
import Control.Monad.Eff (Eff)
8-
import Control.Monad.Eff.Console (CONSOLE, logShow)
7+
import Effect (Effect)
8+
import Effect.Console (logShow)
99

10-
main :: forall e. Eff (console :: CONSOLE | e) Unit
10+
main :: Effect Unit
1111
main = do
12-
let x = t3 1 2 3
12+
let x :: T3 Int Int Int
13+
x = t3 1 2 3
1314

1415
logShow $ prj d0 x
1516
logShow $ prj d1 x

0 commit comments

Comments
 (0)