@@ -14,8 +14,12 @@
14module Data.Generics.Internal.HList
14module Data.Generics.Internal.HList
15 ( HList (..)
15 ( HList (..)
19 , Splittable (..)
23 , Splittable (..)
21 , ListTuple (..)
25 , ListTuple (..)
@@ -32,13 +36,22 @@ data HList (xs :: [Type]) where
33infixr 5 :>
37infixr 5 :>
39+type family ((as :: [k]) ++ (bs :: [k])) :: [k] where
41+ (a ': as) ++ bs = a ': as ++ bs
35append :: HList as -> HList bs -> HList (as ++ bs)
43append :: HList as -> HList bs -> HList (as ++ bs)
36append Nil ys = ys
44append Nil ys = ys
37append (x :> xs) ys = x :> append xs ys
45append (x :> xs) ys = x :> append xs ys
39−type family ((as :: [k]) ++ (bs :: [k])) :: [k] where
47+head' :: HList (a ': as) -> a
40− '[] ++ bs = bs
48+head' (x :> _) = x
41− (a ': as) ++ bs = a ': as ++ bs
49+
50+tail' :: HList (a ': as) -> HList as
53+--------------------------------------------------------------------------------
43class Splittable (as :: [Type]) (bs :: [Type]) (cs :: [Type]) | as bs -> cs, as cs -> bs where
56class Splittable (as :: [Type]) (bs :: [Type]) (cs :: [Type]) | as bs -> cs, as cs -> bs where
44 split :: HList cs -> (HList as, HList bs)
57 split :: HList cs -> (HList as, HList bs)
@@ -47,7 +60,12 @@ instance Splittable '[] bs bs where
47 split bs = (Nil, bs)
60 split bs = (Nil, bs)
49instance Splittable as bs cs => Splittable (a ': as) bs (a ': cs) where
62instance Splittable as bs cs => Splittable (a ': as) bs (a ': cs) where
50− split (a :> as) = let (as', bs) = split as in (a :> as', bs)
65+ where (as', bs) = split as
67+--------------------------------------------------------------------------------
68+-- * Convert tuples to/from HLists
52class ListTuple (tuple :: Type) (as :: [Type]) | as -> tuple where
70class ListTuple (tuple :: Type) (as :: [Type]) | as -> tuple where
53 tupleToList :: tuple -> HList as
71 tupleToList :: tuple -> HList as
@@ -58,37 +76,72 @@ instance ListTuple () '[] where
58 listToTuple _ = ()
76 listToTuple _ = ()
60instance ListTuple a '[a] where
78instance ListTuple a '[a] where
61− tupleToList a = a :> Nil
79+ tupleToList a
62− listToTuple (a :> Nil) = a
81+ listToTuple (a :> Nil)
64instance ListTuple (a, b) '[a, b] where
84instance ListTuple (a, b) '[a, b] where
65− tupleToList (a, b) = a :> b :> Nil
85+ tupleToList (a, b)
66− listToTuple (a :> b :> Nil) = (a, b)
87+ listToTuple (a :> b :> Nil)
68instance ListTuple (a, b, c) '[a, b, c] where
90instance ListTuple (a, b, c) '[a, b, c] where
69− tupleToList (a, b, c) = a :> b :> c :> Nil
91+ tupleToList (a, b, c)
70− listToTuple (a :> b :> c :> Nil) = (a, b, c)
93+ listToTuple (a :> b :> c :> Nil)
72instance ListTuple (a, b, c, d) '[a, b, c, d] where
96instance ListTuple (a, b, c, d) '[a, b, c, d] where
73− tupleToList (a, b, c, d) = a :> b :> c :> d:> Nil
97+ tupleToList (a, b, c, d)
98+ = a :> b :> c :> d:> Nil
74− listToTuple (a :> b :> c :> d :> Nil) = (a, b, c, d)
99+ listToTuple (a :> b :> c :> d :> Nil)
76instance ListTuple (a, b, c, d, e) '[a, b, c, d, e] where
102instance ListTuple (a, b, c, d, e) '[a, b, c, d, e] where
77− tupleToList (a, b, c, d, e) = a :> b :> c :> d:> e :> Nil
103+ tupleToList (a, b, c, d, e)
104+ = a :> b :> c :> d:> e :> Nil
78− listToTuple (a :> b :> c :> d :> e :> Nil) = (a, b, c, d, e)
105+ listToTuple (a :> b :> c :> d :> e :> Nil)
80instance ListTuple (a, b, c, d, e, f) '[a, b, c, d, e, f] where
108instance ListTuple (a, b, c, d, e, f) '[a, b, c, d, e, f] where
81− tupleToList (a, b, c, d, e, f) = a :> b :> c :> d:> e :> f :> Nil
109+ tupleToList (a, b, c, d, e, f)
110+ = a :> b :> c :> d:> e :> f :> Nil
82− listToTuple (a :> b :> c :> d :> e :> f :> Nil) = (a, b, c, d, e, f)
111+ listToTuple (a :> b :> c :> d :> e :> f :> Nil)
112+ = (a, b, c, d, e, f)
84instance ListTuple (a, b, c, d, e, f, g) '[a, b, c, d, e, f, g] where
114instance ListTuple (a, b, c, d, e, f, g) '[a, b, c, d, e, f, g] where
85− tupleToList (a, b, c, d, e, f, g) = a :> b :> c :> d:> e :> f :> g :> Nil
115+ tupleToList (a, b, c, d, e, f, g)
116+ = a :> b :> c :> d:> e :> f :> g :> Nil
86− listToTuple (a :> b :> c :> d :> e :> f :> g :> Nil) = (a, b, c, d, e, f, g)
117+ listToTuple (a :> b :> c :> d :> e :> f :> g :> Nil)
118+ = (a, b, c, d, e, f, g)
88instance ListTuple (a, b, c, d, e, f, g, h) '[a, b, c, d, e, f, g, h] where
120instance ListTuple (a, b, c, d, e, f, g, h) '[a, b, c, d, e, f, g, h] where
89− tupleToList (a, b, c, d, e, f, g, h) = a :> b :> c :> d:> e :> f :> g :> h :> Nil
121+ tupleToList (a, b, c, d, e, f, g, h)
122+ = a :> b :> c :> d:> e :> f :> g :> h :> Nil
90− listToTuple (a :> b :> c :> d :> e :> f :> g :> h :> Nil) = (a, b, c, d, e, f, g, h)
123+ listToTuple (a :> b :> c :> d :> e :> f :> g :> h :> Nil)
91−
124+ = (a, b, c, d, e, f, g, h)
126+instance ListTuple (a, b, c, d, e, f, g, h, j) '[a, b, c, d, e, f, g, h, j] where
127+ tupleToList (a, b, c, d, e, f, g, h, j)
128+ = a :> b :> c :> d:> e :> f :> g :> h :> j :> Nil
129+ listToTuple (a :> b :> c :> d :> e :> f :> g :> h :> j :> Nil)
130+ = (a, b, c, d, e, f, g, h, j)
132+instance ListTuple (a, b, c, d, e, f, g, h, j, k) '[a, b, c, d, e, f, g, h, j, k] where
133+ tupleToList (a, b, c, d, e, f, g, h, j, k)
134+ = a :> b :> c :> d:> e :> f :> g :> h :> j :> k :> Nil
135+ listToTuple (a :> b :> c :> d :> e :> f :> g :> h :> j :> k :> Nil)
136+ = (a, b, c, d, e, f, g, h, j, k)
138+instance ListTuple (a, b, c, d, e, f, g, h, j, k, l) '[a, b, c, d, e, f, g, h, j, k, l] where
139+ tupleToList (a, b, c, d, e, f, g, h, j, k, l)
140+ = a :> b :> c :> d:> e :> f :> g :> h :> j :> k :> l :> Nil
141+ listToTuple (a :> b :> c :> d :> e :> f :> g :> h :> j :> k :> l :> Nil)
142+ = (a, b, c, d, e, f, g, h, j, k, l)
144+--------------------------------------------------------------------------------
92class GCollectible (f :: Type -> Type) (as :: [Type]) | f -> as where
145class GCollectible (f :: Type -> Type) (as :: [Type]) | f -> as where
93 gtoCollection :: f x -> HList as
146 gtoCollection :: f x -> HList as
94 gfromCollection :: HList as -> f x
147 gfromCollection :: HList as -> f x
@@ -100,25 +153,21 @@ instance
100 , Splittable as bs cs
153 , Splittable as bs cs
101 ) => GCollectible (l :*: r) cs where
154 ) => GCollectible (l :*: r) cs where
156+ gtoCollection (l :*: r)
103− gtoCollection (l :*: r) = gtoCollection l `append` gtoCollection r
157+ = gtoCollection l `append` gtoCollection r
104− gfromCollection cs = let (as, bs) = split @as @bs cs in gfromCollection as :*: gfromCollection bs
158+
160+ = gfromCollection as :*: gfromCollection bs
161+ where (as, bs) = split cs
106instance GCollectible (K1 R a) '[a] where
163instance GCollectible (K1 R a) '[a] where
107− gtoCollection (K1 x) = x :> Nil
164+ gtoCollection = (:> Nil) . unK1
108− gfromCollection (x :> Nil) = K1 x
165+ gfromCollection = K1 . head'
110instance GCollectible U1 '[] where
167instance GCollectible U1 '[] where
111 gtoCollection U1 = Nil
168 gtoCollection U1 = Nil
112 gfromCollection Nil = U1
169 gfromCollection Nil = U1
114−instance GCollectible f as => GCollectible (M1 S meta f) as where
171+instance GCollectible f as => GCollectible (M1 m meta f) as where
115− gtoCollection (M1 x) = gtoCollection x
172+ gtoCollection = gtoCollection . unM1
116− gfromCollection xs = M1 (gfromCollection xs)
118−instance GCollectible f as => GCollectible (M1 D meta f) as where
119− gtoCollection (M1 x) = gtoCollection x
120− gfromCollection xs = M1 (gfromCollection xs)
173+ gfromCollection = M1 . gfromCollection
122−instance GCollectible f as => GCollectible (M1 C meta f) as where
123− gtoCollection (M1 x) = gtoCollection x
124− gfromCollection xs = M1 (gfromCollection xs)