Skip to content

Commit 984c8b1

Browse files
foxikfoxik
committed
Merge pull request #184 from kuk0/generic
add Generics instance for Map, Set, IntMap, and IntSet
2 parents 8a62517 + 729cb1a commit 984c8b1

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)