Add lifted instances for Data.Map
authorOleg Grenrus <oleg.grenrus@iki.fi>
Thu, 15 Dec 2016 02:51:28 +0000 (21:51 -0500)
committerDavid Feuer <David.Feuer@gmail.com>
Thu, 15 Dec 2016 02:51:28 +0000 (21:51 -0500)
Data/Map/Internal.hs

index 3433444..1a1f231 100644 (file)
@@ -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
 --------------------------------------------------------------------}