[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, revert-408-bugfix_394: Add lifted instances for Data.IntMap (59dbb62)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:46:44 UTC 2017


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

On branches: cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/59dbb629498fce1f2a079636a341a3613ffe87f0

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

commit 59dbb629498fce1f2a079636a341a3613ffe87f0
Author: Oleg Grenrus <oleg.grenrus at iki.fi>
Date:   Wed Dec 14 22:44:59 2016 -0500

    Add lifted instances for Data.IntMap
    
    Add `Eq1`, `Ord1`, `Show1`, and `Read1` instances for
    `Data.IntMap`. The `Eq1` instance was written by
    David Feuer; the rest were written by Oleg Grenrus.


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

59dbb629498fce1f2a079636a341a3613ffe87f0
 Data/IntMap/Internal.hs | 35 +++++++++++++++++++++++++++++++++++
 1 file changed, 35 insertions(+)

diff --git a/Data/IntMap/Internal.hs b/Data/IntMap/Internal.hs
index e909338..bca468f 100644
--- a/Data/IntMap/Internal.hs
+++ b/Data/IntMap/Internal.hs
@@ -280,6 +280,7 @@ import Data.Word (Word)
 #endif
 #if MIN_VERSION_base(4,9,0)
 import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
+import Data.Functor.Classes
 #endif
 
 import Control.DeepSeq (NFData(rnf))
@@ -2964,6 +2965,16 @@ nequal (Tip kx x) (Tip ky y)
 nequal Nil Nil = False
 nequal _   _   = True
 
+#if MIN_VERSION_base(4,9,0)
+instance Eq1 IntMap where
+  liftEq eq (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
+    = (m1 == m2) && (p1 == p2) && (liftEq eq l1 l2) && (liftEq eq r1 r2)
+  liftEq eq (Tip kx x) (Tip ky y)
+    = (kx == ky) && (eq x y)
+  liftEq _eq Nil Nil = True
+  liftEq _eq _   _   = False
+#endif
+
 {--------------------------------------------------------------------
   Ord
 --------------------------------------------------------------------}
@@ -2971,6 +2982,12 @@ nequal _   _   = True
 instance Ord a => Ord (IntMap a) where
     compare m1 m2 = compare (toList m1) (toList m2)
 
+#if MIN_VERSION_base(4,9,0)
+instance Ord1 IntMap where
+  liftCompare cmp m n =
+    liftCompare (liftCompare cmp) (toList m) (toList n)
+#endif
+
 {--------------------------------------------------------------------
   Functor
 --------------------------------------------------------------------}
@@ -2992,6 +3009,15 @@ instance Show a => Show (IntMap a) where
   showsPrec d m   = showParen (d > 10) $
     showString "fromList " . shows (toList m)
 
+#if MIN_VERSION_base(4,9,0)
+instance Show1 IntMap where
+    liftShowsPrec sp sl d m =
+        showsUnaryWith (liftShowsPrec sp' sl') "fromList" d (toList m)
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
+#endif
+
 {--------------------------------------------------------------------
   Read
 --------------------------------------------------------------------}
@@ -3010,6 +3036,15 @@ instance (Read e) => Read (IntMap e) where
     return (fromList xs,t)
 #endif
 
+#if MIN_VERSION_base(4,9,0)
+instance Read1 IntMap where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
+#endif
+
 {--------------------------------------------------------------------
   Typeable
 --------------------------------------------------------------------}



More information about the ghc-commits mailing list