@@ -14,8 +14,12 @@
1414module Data.Generics.Internal.HList
1515 ( HList (..)
1616
17+ , head'
18+ , tail'
19+
1720 , append
1821 , (++)
22+
1923 , Splittable (..)
2024
2125 , ListTuple (..)
@@ -32,13 +36,22 @@ data HList (xs :: [Type]) where
3236
3337infixr 5 :>
3438
39+type family ((as :: [k]) ++ (bs :: [k])) :: [k] where
40+ '[] ++ bs = bs
41+ (a ': as) ++ bs = a ': as ++ bs
42+
3543append :: HList as -> HList bs -> HList (as ++ bs)
3644append Nil ys = ys
3745append (x :> xs) ys = x :> append xs ys
3846
39−type family ((as :: [k]) ++ (bs :: [k])) :: [k] where
40− '[] ++ bs = bs
41− (a ': as) ++ bs = a ': as ++ bs
47+head' :: HList (a ': as) -> a
48+head' (x :> _) = x
49+
50+tail' :: HList (a ': as) -> HList as
51+tail' (_ :> xs) = xs
52+
53+--------------------------------------------------------------------------------
54+-- * Split HList
4255
4356class Splittable (as :: [Type]) (bs :: [Type]) (cs :: [Type]) | as bs -> cs, as cs -> bs where
4457 split :: HList cs -> (HList as, HList bs)
@@ -47,7 +60,12 @@ instance Splittable '[] bs bs where
4760 split bs = (Nil, bs)
4861
4962instance Splittable as bs cs => Splittable (a ': as) bs (a ': cs) where
50− split (a :> as) = let (as', bs) = split as in (a :> as', bs)
63+ split (a :> as)
64+ = (a :> as', bs)
65+ where (as', bs) = split as
66+
67+--------------------------------------------------------------------------------
68+-- * Convert tuples to/from HLists
5169
5270class ListTuple (tuple :: Type) (as :: [Type]) | as -> tuple where
5371 tupleToList :: tuple -> HList as
@@ -58,37 +76,72 @@ instance ListTuple () '[] where
5876 listToTuple _ = ()
5977
6078instance ListTuple a '[a] where
61− tupleToList a = a :> Nil
62− listToTuple (a :> Nil) = a
79+ tupleToList a
80+ = a :> Nil
81+ listToTuple (a :> Nil)
82+ = a
6383
6484instance ListTuple (a, b) '[a, b] where
65− tupleToList (a, b) = a :> b :> Nil
66− listToTuple (a :> b :> Nil) = (a, b)
85+ tupleToList (a, b)
86+ = a :> b :> Nil
87+ listToTuple (a :> b :> Nil)
88+ = (a, b)
6789
6890instance ListTuple (a, b, c) '[a, b, c] where
69− tupleToList (a, b, c) = a :> b :> c :> Nil
70− listToTuple (a :> b :> c :> Nil) = (a, b, c)
91+ tupleToList (a, b, c)
92+ = a :> b :> c :> Nil
93+ listToTuple (a :> b :> c :> Nil)
94+ = (a, b, c)
7195
7296instance ListTuple (a, b, c, d) '[a, b, c, d] where
73− tupleToList (a, b, c, d) = a :> b :> c :> d:> Nil
74− listToTuple (a :> b :> c :> d :> Nil) = (a, b, c, d)
97+ tupleToList (a, b, c, d)
98+ = a :> b :> c :> d:> Nil
99+ listToTuple (a :> b :> c :> d :> Nil)
100+ = (a, b, c, d)
75101
76102instance 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
78− listToTuple (a :> b :> c :> d :> e :> Nil) = (a, b, c, d, e)
103+ tupleToList (a, b, c, d, e)
104+ = a :> b :> c :> d:> e :> Nil
105+ listToTuple (a :> b :> c :> d :> e :> Nil)
106+ = (a, b, c, d, e)
79107
80108instance 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
82− listToTuple (a :> b :> c :> d :> e :> f :> Nil) = (a, b, c, d, e, f)
109+ tupleToList (a, b, c, d, e, f)
110+ = a :> b :> c :> d:> e :> f :> Nil
111+ listToTuple (a :> b :> c :> d :> e :> f :> Nil)
112+ = (a, b, c, d, e, f)
83113
84114instance 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
86− listToTuple (a :> b :> c :> d :> e :> f :> g :> Nil) = (a, b, c, d, e, f, g)
115+ tupleToList (a, b, c, d, e, f, g)
116+ = a :> b :> c :> d:> e :> f :> g :> Nil
117+ listToTuple (a :> b :> c :> d :> e :> f :> g :> Nil)
118+ = (a, b, c, d, e, f, g)
87119
88120instance 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
90− listToTuple (a :> b :> c :> d :> e :> f :> g :> h :> Nil) = (a, b, c, d, e, f, g, h)
91−
121+ tupleToList (a, b, c, d, e, f, g, h)
122+ = a :> b :> c :> d:> e :> f :> g :> h :> Nil
123+ listToTuple (a :> b :> c :> d :> e :> f :> g :> h :> Nil)
124+ = (a, b, c, d, e, f, g, h)
125+
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)
131+
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)
137+
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)
143+
144+--------------------------------------------------------------------------------
92145class GCollectible (f :: Type -> Type) (as :: [Type]) | f -> as where
93146 gtoCollection :: f x -> HList as
94147 gfromCollection :: HList as -> f x
@@ -100,25 +153,21 @@ instance
100153 , Splittable as bs cs
101154 ) => GCollectible (l :*: r) cs where
102155
103− gtoCollection (l :*: r) = gtoCollection l `append` gtoCollection r
104− gfromCollection cs = let (as, bs) = split @as @bs cs in gfromCollection as :*: gfromCollection bs
156+ gtoCollection (l :*: r)
157+ = gtoCollection l `append` gtoCollection r
158+
159+ gfromCollection cs
160+ = gfromCollection as :*: gfromCollection bs
161+ where (as, bs) = split cs
105162
106163instance GCollectible (K1 R a) '[a] where
107− gtoCollection (K1 x) = x :> Nil
108− gfromCollection (x :> Nil) = K1 x
164+ gtoCollection = (:> Nil) . unK1
165+ gfromCollection = K1 . head'
109166
110167instance GCollectible U1 '[] where
111168 gtoCollection U1 = Nil
112169 gfromCollection Nil = U1
113170
114−instance GCollectible f as => GCollectible (M1 S meta f) as where
115− gtoCollection (M1 x) = gtoCollection x
116− gfromCollection xs = M1 (gfromCollection xs)
117−
118−instance GCollectible f as => GCollectible (M1 D meta f) as where
119− gtoCollection (M1 x) = gtoCollection x
120− gfromCollection xs = M1 (gfromCollection xs)
121−
122−instance GCollectible f as => GCollectible (M1 C meta f) as where
123− gtoCollection (M1 x) = gtoCollection x
124− gfromCollection xs = M1 (gfromCollection xs)
171+instance GCollectible f as => GCollectible (M1 m meta f) as where
172+ gtoCollection = gtoCollection . unM1
173+ gfromCollection = M1 . gfromCollection