[commit: packages/containers] changelog-foldtree, cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394: add Generics instance for Map, Set, IntMap, and IntSet (729cb1a)

Mon Apr 17 21:39:24 UTC 2017

Repository : ssh://git@git.haskell.org/containers

On branches: changelog-foldtree,cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-184-generic,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/729cb1ac4e28cb665c7613e3a791cce9bcfcaa23

>---------------------------------------------------------------

commit 729cb1ac4e28cb665c7613e3a791cce9bcfcaa23
Author: Kubo Kovac <kuko at fb.com>
Date:   Thu Feb 18 17:21:57 2016 +0000

    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)


>---------------------------------------------------------------

729cb1ac4e28cb665c7613e3a791cce9bcfcaa23
 Data/IntMap/Base.hs | 38 ++++++++++++++++++++++++++++++++++++++
 Data/IntSet/Base.hs | 27 +++++++++++++++++++++++++++
 Data/Map/Base.hs    | 36 ++++++++++++++++++++++++++++++++++++
 Data/Set/Base.hs    | 26 ++++++++++++++++++++++++++
 4 files changed, 127 insertions(+)

diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index e22c46b..f83cb14 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -8,6 +8,8 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE EmptyDataDecls #-}
 #endif
 
 #include "containers.h"
@@ -246,6 +248,9 @@ import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix),
 import GHC.Exts (build)
 #if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as GHCExts
+import GHC.Generics hiding (Prefix, prec, (:*:))
+import qualified GHC.Generics as Generics
+
 #endif
 import Text.Read
 #endif
@@ -415,6 +420,39 @@ intMapDataType = mkDataType "Data.IntMap.Base.IntMap" [fromListConstr]
 
 #endif
 
+#if __GLASGOW_HASKELL__ >= 708
+
+{--------------------------------------------------------------------
+  A Generic instance
+--------------------------------------------------------------------}
+
+-- list of pairs; LP k v ~ [(k, v)] so LP k ~ [(k, *)]
+type LP k = [] Generics.:.: Rec1 ((,) k)
+type Rep1IntMap = D1 D1IntMap (C1 C1IntMap (S1 NoSelector (LP Key)))
+
+instance Generic1 IntMap where
+  type Rep1 IntMap = Rep1IntMap
+  from1 m = M1 (M1 (M1 (Comp1 (Rec1 <$> toList m))))
+  to1 (M1 (M1 (M1 l))) = fromList (unRec1 <$> unComp1 l)
+
+data D1IntMap
+data C1IntMap
+
+instance Datatype D1IntMap where
+  datatypeName _ = "IntMap"
+  moduleName   _ = "Data.IntMap.Base"
+
+instance Constructor C1IntMap  where
+  conName _ = "IntMap.fromList"
+
+type Rep0IntMap a = D1 D1IntMap (C1 C1IntMap (S1 NoSelector (Rec0 [(Key, a)])))
+
+instance Generic (IntMap a) where
+  type Rep (IntMap a) = Rep0IntMap a
+  from m = M1 (M1 (M1 (K1 $ toList m)))
+  to (M1 (M1 (M1 (K1 l)))) = fromList l
+#endif
+
 {--------------------------------------------------------------------
   Query
 --------------------------------------------------------------------}
diff --git a/Data/IntSet/Base.hs b/Data/IntSet/Base.hs
index 3df44cb..1efed08 100644
--- a/Data/IntSet/Base.hs
+++ b/Data/IntSet/Base.hs
@@ -7,6 +7,7 @@
 #endif
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE EmptyDataDecls #-}
 #endif
 
 #include "containers.h"
@@ -192,6 +193,7 @@ import Text.Read
 import GHC.Exts (Int(..), build)
 #if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as GHCExts
+import GHC.Generics hiding (Prefix, prec, (:*:))
 #endif
 import GHC.Prim (indexInt8OffAddr#)
 #endif
@@ -286,6 +288,31 @@ intSetDataType = mkDataType "Data.IntSet.Base.IntSet" [fromListConstr]
 
 #endif
 
+#if __GLASGOW_HASKELL__ >= 708
+
+{--------------------------------------------------------------------
+  A Generic instance
+--------------------------------------------------------------------}
+
+type Rep0IntSet = D1 D1IntSet (C1 C1IntSet (S1 NoSelector (Rec0 [Key])))
+
+instance Generic IntSet where
+    type Rep IntSet = Rep0IntSet
+    from s = M1 (M1 (M1 (K1 $ toList s)))
+    to (M1 (M1 (M1 (K1 t)))) = fromList t
+
+data D1IntSet
+data C1IntSet
+
+instance Datatype D1IntSet where
+    datatypeName _ = "IntSet"
+    moduleName   _ = "Data.IntSet.Base"
+
+instance Constructor C1IntSet where
+    conName     _ = "IntSet"
+    conIsRecord _ = False
+#endif
+
 {--------------------------------------------------------------------
   Query
 --------------------------------------------------------------------}
diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
index 5d80efe..10d952f 100644
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -8,6 +8,8 @@
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE EmptyDataDecls #-}
 #endif
 
 #include "containers.h"
@@ -293,6 +295,8 @@ import Data.Utils.StrictPair
 import GHC.Exts ( build )
 #if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as GHCExts
+import GHC.Generics hiding (Prefix, prec, (:*:))
+import qualified GHC.Generics as Generics
 #endif
 import Text.Read
 import Data.Data
@@ -377,7 +381,39 @@ fromListConstr = mkConstr mapDataType "fromList" [] Prefix
 
 mapDataType :: DataType
 mapDataType = mkDataType "Data.Map.Base.Map" [fromListConstr]
+#endif
+
+#if __GLASGOW_HASKELL__ >= 708
+
+{--------------------------------------------------------------------
+  A Generic instance
+--------------------------------------------------------------------}
+
+-- list of pairs; LP k v ~ [(k, v)] so LP k ~ [(k, *)]
+type LP k = [] Generics.:.: Rec1 ((,) k)
+type Rep1Map k = D1 D1Map (C1 C1Map (S1 NoSelector (LP k)))
+
+instance (Eq k, Ord k) => Generic1 (Map k) where
+  type Rep1 (Map k) = Rep1Map k
+  from1 m = M1 (M1 (M1 (Comp1 (Rec1 <$> toList m))))
+  to1 (M1 (M1 (M1 l))) = fromList (unRec1 <$> unComp1 l)
+
+data D1Map
+data C1Map
+
+instance Datatype D1Map where
+  datatypeName _ = "Map"
+  moduleName   _ = "Data.Map.Base"
+
+instance Constructor C1Map  where
+  conName _ = "Map.fromList"
+
+type Rep0Map k v = D1 D1Map (C1 C1Map (S1 NoSelector (Rec0 [(k, v)])))
 
+instance (Eq k, Ord k) => Generic (Map k v) where
+  type Rep (Map k v) = Rep0Map k v
+  from m = M1 (M1 (M1 (K1 $ toList m)))
+  to (M1 (M1 (M1 (K1 l)))) = fromList l
 #endif
 
 {--------------------------------------------------------------------
diff --git a/Data/Set/Base.hs b/Data/Set/Base.hs
index 01c343a..bf38e01 100644
--- a/Data/Set/Base.hs
+++ b/Data/Set/Base.hs
@@ -8,6 +8,8 @@
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE EmptyDataDecls #-}
 #endif
 
 #include "containers.h"
@@ -213,6 +215,7 @@ import Data.Utils.StrictPair
 import GHC.Exts ( build )
 #if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as GHCExts
+import GHC.Generics hiding (Prefix, prec, (:*:))
 #endif
 import Text.Read
 import Data.Data
@@ -331,6 +334,29 @@ setDataType = mkDataType "Data.Set.Base.Set" [fromListConstr]
 
 #endif
 
+#if __GLASGOW_HASKELL__ >= 708
+
+{--------------------------------------------------------------------
+  A Generic instance
+--------------------------------------------------------------------}
+data D1Set
+data C1Set
+
+instance Datatype D1Set where
+  datatypeName _ = "Set"
+  moduleName   _ = "Data.Set.Base"
+
+instance Constructor C1Set  where
+  conName _ = "Set.fromList"
+
+type Rep0Set a = D1 D1Set (C1 C1Set (S1 NoSelector (Rec0 [a])))
+
+instance (Eq a, Ord a) => Generic (Set a) where
+  type Rep (Set a) = Rep0Set a
+  from s = M1 (M1 (M1 (K1 $ toList s)))
+  to (M1 (M1 (M1 (K1 l)))) = fromList l
+#endif
+
 {--------------------------------------------------------------------
   Query
 --------------------------------------------------------------------}

