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

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:46:37 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/fa1d67005d7011d8daf70047896cf5c34a7ebf42

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

commit fa1d67005d7011d8daf70047896cf5c34a7ebf42
Author: Oleg Grenrus <oleg.grenrus at iki.fi>
Date:   Wed Dec 14 21:51:28 2016 -0500

    Add lifted instances for Data.Map


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

fa1d67005d7011d8daf70047896cf5c34a7ebf42
 Data/Map/Internal.hs | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/Data/Map/Internal.hs b/Data/Map/Internal.hs
index 3433444..1a1f231 100644
--- a/Data/Map/Internal.hs
+++ b/Data/Map/Internal.hs
@@ -366,6 +366,7 @@ import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
 #endif
 #if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes
 import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
 #endif
 import Control.Applicative (Const (..))
@@ -3944,6 +3945,43 @@ instance (Eq k,Eq a) => Eq (Map k a) where
 instance (Ord k, Ord v) => Ord (Map k v) where
     compare m1 m2 = compare (toAscList m1) (toAscList m2)
 
+#if MIN_VERSION_base(4,9,0)
+{--------------------------------------------------------------------
+  Lifted instances
+--------------------------------------------------------------------}
+
+instance Eq2 Map where
+    liftEq2 eqk eqv m n =
+        size m == size n && liftEq (liftEq2 eqk eqv) (toList m) (toList n)
+
+instance Eq k => Eq1 (Map k) where
+    liftEq = liftEq2 (==)
+
+instance Ord2 Map where
+    liftCompare2 cmpk cmpv m n =
+        liftCompare (liftCompare2 cmpk cmpv) (toList m) (toList n)
+
+instance Ord k => Ord1 (Map k) where
+    liftCompare = liftCompare2 compare
+
+instance Show2 Map where
+    liftShowsPrec2 spk slk spv slv d m =
+        showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m)
+      where
+        sp = liftShowsPrec2 spk slk spv slv
+        sl = liftShowList2 spk slk spv slv
+
+instance Show k => Show1 (Map k) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+instance (Ord k, Read k) => Read1 (Map k) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
+#endif
+
 {--------------------------------------------------------------------
   Functor
 --------------------------------------------------------------------}



More information about the ghc-commits mailing list