Skip to content

Commit 729cb1a

Browse files
author
Kubo Kovac
committed
add Generics instance for Map, Set, IntMap, and IntSet
we want Generics for everything (otherwise we can't derive Generics for any data types which contain these without creating orphan instances)
1 parent 8a62517 commit 729cb1a

File tree

4 files changed

+128
-1
lines changed

4 files changed

+128
-1
lines changed

‎Data/IntMap/Base.hs

Lines changed: 39 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@
88
{-# LANGUAGE ScopedTypeVariables #-}
99
#if __GLASGOW_HASKELL__ >= 708
1010
{-# LANGUAGE TypeFamilies #-}
11+
{-# LANGUAGE TypeOperators #-}
12+
{-# LANGUAGE EmptyDataDecls #-}
1113
#endif
1214

1315
#include "containers.h"
@@ -246,6 +248,9 @@ import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix),
246248
import GHC.Exts (build)
247249
#if __GLASGOW_HASKELL__ >= 708
248250
import qualified GHC.Exts as GHCExts
251+
import GHC.Generics hiding (Prefix, prec, (:*:))
252+
import qualified GHC.Generics as Generics
253+
249254
#endif
250255
import Text.Read
251256
#endif
@@ -415,6 +420,39 @@ intMapDataType = mkDataType "Data.IntMap.Base.IntMap" [fromListConstr]
415420

416421
#endif
417422

423+
#if __GLASGOW_HASKELL__ >= 708
424+
425+
{--------------------------------------------------------------------
426+
A Generic instance
427+
--------------------------------------------------------------------}
428+
429+
-- list of pairs; LP k v ~ [(k, v)] so LP k ~ [(k, *)]
430+
type LP k = [] Generics.:.: Rec1 ((,) k)
431+
type Rep1IntMap = D1 D1IntMap (C1 C1IntMap (S1 NoSelector (LP Key)))
432+
433+
instance Generic1 IntMap where
434+
type Rep1 IntMap = Rep1IntMap
435+
from1 m = M1 (M1 (M1 (Comp1 (Rec1 <$> toList m))))
436+
to1 (M1 (M1 (M1 l))) = fromList (unRec1 <$> unComp1 l)
437+
438+
data D1IntMap
439+
data C1IntMap
440+
441+
instance Datatype D1IntMap where
442+
datatypeName _ = "IntMap"
443+
moduleName _ = "Data.IntMap.Base"
444+
445+
instance Constructor C1IntMap where
446+
conName _ = "IntMap.fromList"
447+
448+
type Rep0IntMap a = D1 D1IntMap (C1 C1IntMap (S1 NoSelector (Rec0 [(Key, a)])))
449+
450+
instance Generic (IntMap a) where
451+
type Rep (IntMap a) = Rep0IntMap a
452+
from m = M1 (M1 (M1 (K1 $ toList m)))
453+
to (M1 (M1 (M1 (K1 l)))) = fromList l
454+
#endif
455+
418456
{--------------------------------------------------------------------
419457
Query
420458
--------------------------------------------------------------------}
@@ -1579,7 +1617,7 @@ split k t =
15791617
case t of
15801618
Bin _ m l r
15811619
| m < 0 -> if k >= 0 -- handle negative numbers.
1582-
then case go k l of (lt :*: gt) -> let lt' = union r lt
1620+
then case go k l of (lt :*: gt) -> let lt' = union r lt
15831621
in lt' `seq` (lt', gt)
15841622
else case go k r of (lt :*: gt) -> let gt' = union gt l
15851623
in gt' `seq` (lt, gt')

‎Data/IntSet/Base.hs

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77
#endif
88
#if __GLASGOW_HASKELL__ >= 708
99
{-# LANGUAGE TypeFamilies #-}
10+
{-# LANGUAGE EmptyDataDecls #-}
1011
#endif
1112

1213
#include "containers.h"
@@ -192,6 +193,7 @@ import Text.Read
192193
import GHC.Exts (Int(..), build)
193194
#if __GLASGOW_HASKELL__ >= 708
194195
import qualified GHC.Exts as GHCExts
196+
import GHC.Generics hiding (Prefix, prec, (:*:))
195197
#endif
196198
import GHC.Prim (indexInt8OffAddr#)
197199
#endif
@@ -286,6 +288,31 @@ intSetDataType = mkDataType "Data.IntSet.Base.IntSet" [fromListConstr]
286288

287289
#endif
288290

291+
#if __GLASGOW_HASKELL__ >= 708
292+
293+
{--------------------------------------------------------------------
294+
A Generic instance
295+
--------------------------------------------------------------------}
296+
297+
type Rep0IntSet = D1 D1IntSet (C1 C1IntSet (S1 NoSelector (Rec0 [Key])))
298+
299+
instance Generic IntSet where
300+
type Rep IntSet = Rep0IntSet
301+
from s = M1 (M1 (M1 (K1 $ toList s)))
302+
to (M1 (M1 (M1 (K1 t)))) = fromList t
303+
304+
data D1IntSet
305+
data C1IntSet
306+
307+
instance Datatype D1IntSet where
308+
datatypeName _ = "IntSet"
309+
moduleName _ = "Data.IntSet.Base"
310+
311+
instance Constructor C1IntSet where
312+
conName _ = "IntSet"
313+
conIsRecord _ = False
314+
#endif
315+
289316
{--------------------------------------------------------------------
290317
Query
291318
--------------------------------------------------------------------}

‎Data/Map/Base.hs

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@
88
#if __GLASGOW_HASKELL__ >= 708
99
{-# LANGUAGE RoleAnnotations #-}
1010
{-# LANGUAGE TypeFamilies #-}
11+
{-# LANGUAGE TypeOperators #-}
12+
{-# LANGUAGE EmptyDataDecls #-}
1113
#endif
1214

1315
#include "containers.h"
@@ -293,6 +295,8 @@ import Data.Utils.StrictPair
293295
import GHC.Exts ( build )
294296
#if __GLASGOW_HASKELL__ >= 708
295297
import qualified GHC.Exts as GHCExts
298+
import GHC.Generics hiding (Prefix, prec, (:*:))
299+
import qualified GHC.Generics as Generics
296300
#endif
297301
import Text.Read
298302
import Data.Data
@@ -377,7 +381,39 @@ fromListConstr = mkConstr mapDataType "fromList" [] Prefix
377381

378382
mapDataType :: DataType
379383
mapDataType = mkDataType "Data.Map.Base.Map" [fromListConstr]
384+
#endif
385+
386+
#if __GLASGOW_HASKELL__ >= 708
387+
388+
{--------------------------------------------------------------------
389+
A Generic instance
390+
--------------------------------------------------------------------}
391+
392+
-- list of pairs; LP k v ~ [(k, v)] so LP k ~ [(k, *)]
393+
type LP k = [] Generics.:.: Rec1 ((,) k)
394+
type Rep1Map k = D1 D1Map (C1 C1Map (S1 NoSelector (LP k)))
395+
396+
instance (Eq k, Ord k) => Generic1 (Map k) where
397+
type Rep1 (Map k) = Rep1Map k
398+
from1 m = M1 (M1 (M1 (Comp1 (Rec1 <$> toList m))))
399+
to1 (M1 (M1 (M1 l))) = fromList (unRec1 <$> unComp1 l)
400+
401+
data D1Map
402+
data C1Map
403+
404+
instance Datatype D1Map where
405+
datatypeName _ = "Map"
406+
moduleName _ = "Data.Map.Base"
407+
408+
instance Constructor C1Map where
409+
conName _ = "Map.fromList"
410+
411+
type Rep0Map k v = D1 D1Map (C1 C1Map (S1 NoSelector (Rec0 [(k, v)])))
380412

413+
instance (Eq k, Ord k) => Generic (Map k v) where
414+
type Rep (Map k v) = Rep0Map k v
415+
from m = M1 (M1 (M1 (K1 $ toList m)))
416+
to (M1 (M1 (M1 (K1 l)))) = fromList l
381417
#endif
382418

383419
{--------------------------------------------------------------------

‎Data/Set/Base.hs

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@
88
#if __GLASGOW_HASKELL__ >= 708
99
{-# LANGUAGE RoleAnnotations #-}
1010
{-# LANGUAGE TypeFamilies #-}
11+
{-# LANGUAGE TypeOperators #-}
12+
{-# LANGUAGE EmptyDataDecls #-}
1113
#endif
1214

1315
#include "containers.h"
@@ -213,6 +215,7 @@ import Data.Utils.StrictPair
213215
import GHC.Exts ( build )
214216
#if __GLASGOW_HASKELL__ >= 708
215217
import qualified GHC.Exts as GHCExts
218+
import GHC.Generics hiding (Prefix, prec, (:*:))
216219
#endif
217220
import Text.Read
218221
import Data.Data
@@ -331,6 +334,29 @@ setDataType = mkDataType "Data.Set.Base.Set" [fromListConstr]
331334

332335
#endif
333336

337+
#if __GLASGOW_HASKELL__ >= 708
338+
339+
{--------------------------------------------------------------------
340+
A Generic instance
341+
--------------------------------------------------------------------}
342+
data D1Set
343+
data C1Set
344+
345+
instance Datatype D1Set where
346+
datatypeName _ = "Set"
347+
moduleName _ = "Data.Set.Base"
348+
349+
instance Constructor C1Set where
350+
conName _ = "Set.fromList"
351+
352+
type Rep0Set a = D1 D1Set (C1 C1Set (S1 NoSelector (Rec0 [a])))
353+
354+
instance (Eq a, Ord a) => Generic (Set a) where
355+
type Rep (Set a) = Rep0Set a
356+
from s = M1 (M1 (M1 (K1 $ toList s)))
357+
to (M1 (M1 (M1 (K1 l)))) = fromList l
358+
#endif
359+
334360
{--------------------------------------------------------------------
335361
Query
336362
--------------------------------------------------------------------}

0 commit comments

Comments
 (0)