From b86c7842e1899298a160157b0a021a6df64a890a Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Tue, 12 Aug 2014 18:14:44 -0400
Subject: more IntMap wrapping

---
 IntMapClass.hs | 122 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 120 insertions(+), 2 deletions(-)

(limited to 'IntMapClass.hs')

diff --git a/IntMapClass.hs b/IntMapClass.hs
index 28ae5ba..7c18de8 100644
--- a/IntMapClass.hs
+++ b/IntMapClass.hs
@@ -14,6 +14,7 @@ import Data.Foldable ( Foldable )
 import Data.Traversable ( Traversable )
 import Data.Monoid   ( Monoid )
 import Control.DeepSeq ( NFData )
+import Control.Applicative ( Applicative )
 #if MIN_VERSION_base(4,7,0)
 import Data.Coerce
 #else
@@ -35,6 +36,9 @@ newtype IMap k a = IMap { intmap :: IntMap a }
     , NFData
     )
 
+adaptm_k_a_m f k a m = IMap $ adapt_k_a_m f k a m
+adapt_k_a_m f k a m = adapt_m (adapt_k f k a) m
+
 adapt_m_k :: Coercible k Int => (IntMap a -> Int -> x) -> IMap k a -> k -> x
 adapt_m_k f (IMap m) k = f m (coerce k)
 
@@ -42,16 +46,26 @@ adapt_k_m :: Coercible k Int => (Int -> IntMap a -> x) -> k -> IMap k a -> x
 adapt_k_m f k (IMap m) = f (coerce k) m
 -- adapt_k_m2 :: Coercible k Int => (Int -> IntMap a -> x) -> k -> IMap k a -> x
 -- adapt_k_m2 f k m = (adapt_k f) k (intmap m)
--- adapt_k :: Coercible k Int => (Int -> x) -> k -> x
--- adapt_k f k = f (coerce k)
+
+adaptm_k_m
+  :: Coercible k Int =>
+     (Int -> IntMap a -> IntMap a) -> k -> IMap k a -> IMap k a
+adaptm_k_m f k m = IMap $ adapt_k_m f k m
+
+adapt_k :: Coercible k Int => (Int -> x) -> k -> x
+adapt_k f k = f (coerce k)
 
 adapt_m_m :: (IntMap a -> IntMap a -> x) -> IMap k a -> IMap k a -> x
 adapt_m_m f m = adapt_m (adapt_m f m)
 
+adaptm_m_m :: (IntMap a -> IntMap a -> IntMap a) -> IMap k a -> IMap k a -> IMap k a
+adaptm_m_m f a b = IMap $ adapt_m_m f a b
+
 adapt_m :: (IntMap a -> x) -> IMap k a -> x
 adapt_m f (IMap m) = f m
 
 first f (x,y) = (f x,y)
+second f (x,y) = (x,f y)
 
 
 (!) :: Coercible k Int => IMap k a -> k -> a
@@ -83,3 +97,107 @@ lookupLE :: ( Coercible Int k, Coercible k Int ) => k -> IMap k a -> Maybe (k, a
 lookupLE k m = fmap (first coerce) $ adapt_k_m (IntMap.lookupLE) k m
 lookupGE :: ( Coercible Int k, Coercible k Int ) => k -> IMap k a -> Maybe (k, a)
 lookupGE k m = fmap (first coerce) $ adapt_k_m (IntMap.lookupGE) k m
+
+empty = IMap IntMap.empty
+
+singleton :: Coercible k Int => k -> a -> IMap k a
+singleton = (IMap .) . adapt_k IntMap.singleton
+
+insert :: Coercible k Int => k -> a -> IMap k a -> IMap k a
+insert = adaptm_k_a_m IntMap.insert
+
+insertWith :: Coercible k Int => (a -> a -> a) -> k -> a -> IMap k a -> IMap k a
+insertWith f = adaptm_k_a_m (IntMap.insertWith f)
+
+insertWithKey :: (Coercible Int k, Coercible k Int) => (k -> a -> a -> a) -> k -> a -> IMap k a -> IMap k a
+insertWithKey f = adaptm_k_a_m (IntMap.insertWithKey $ f . coerce)
+
+insertLookupWithKey :: (Coercible Int k, Coercible k Int) =>
+    (k -> a -> a -> a) -> k -> a -> IMap k a -> (Maybe a, IMap k a)
+insertLookupWithKey f k a m = second IMap $ adapt_k_a_m (IntMap.insertLookupWithKey $ f . coerce) k a m
+
+delete :: Coercible k Int => k -> IMap k a -> IMap k a
+delete = adaptm_k_m IntMap.delete
+
+adjust :: Coercible k Int => (a -> a) -> k -> IMap k a -> IMap k a
+adjust f = adaptm_k_m (IntMap.adjust f)
+
+adjustWithKey :: ( Coercible Int k, Coercible k Int ) =>
+     (k -> a -> a) -> k -> IMap k a -> IMap k a
+adjustWithKey f = adaptm_k_m (IntMap.adjustWithKey $ f . coerce)
+
+update
+  :: Coercible k Int => (a -> Maybe a) -> k -> IMap k a -> IMap k a
+update f = adaptm_k_m (IntMap.update f)
+
+
+updateWithKey
+  :: (Coercible k Int, Coercible Int k) =>
+     (k -> a -> Maybe a) -> k -> IMap k a -> IMap k a
+updateWithKey f = adaptm_k_m (IntMap.updateWithKey $ f . coerce)
+
+updateLookupWithKey ::
+  (Coercible k Int, Coercible Int k) =>
+  (k -> a -> Maybe a) -> k -> IMap k a -> (Maybe a, IMap k a)
+updateLookupWithKey f k m =
+    second IMap $ adapt_k_m (IntMap.updateLookupWithKey $ f . coerce) k m
+
+alter :: Coercible k Int => (Maybe a -> Maybe a) -> k -> IMap k a -> IMap k a
+alter f = adaptm_k_m (IntMap.alter f)
+
+union :: IMap k a -> IMap k a -> IMap k a
+union = adaptm_m_m IntMap.union
+
+unionWith :: (a -> a -> a) -> IMap k a -> IMap k a -> IMap k a
+unionWith f = adaptm_m_m (IntMap.unionWith f)
+
+
+unionWithKey :: Coercible Int k => (k -> a -> a -> a) -> IMap k a -> IMap k a -> IMap k a
+unionWithKey f = adaptm_m_m (IntMap.unionWithKey $ f . coerce)
+
+unions :: Coercible [IMap k a] [IntMap a] => [IMap k a] -> IMap k a
+unions ms = IMap $ IntMap.unions (coerce ms)
+
+unionsWith :: Coercible [IMap k a] [IntMap a] => (a->a->a) -> [IMap k a] -> IMap k a
+unionsWith f ms = IMap $ IntMap.unionsWith f (coerce ms)
+
+difference = adaptm_m_m IntMap.difference
+
+differenceWith f = adaptm_m_m (IntMap.differenceWith f)
+
+differenceWithKey ::
+  Coercible Int k =>
+  (k -> a -> a -> Maybe a) -> IMap k a -> IMap k a -> IMap k a
+differenceWithKey f = adaptm_m_m (IntMap.differenceWithKey $ f . coerce)
+
+intersection = adaptm_m_m IntMap.intersection
+intersectionWith f = adaptm_m_m (IntMap.intersectionWith f)
+
+mergeWithKey ::
+  Coercible Int k =>
+  (k -> a -> b -> Maybe c)
+  -> (IMap k a -> IMap k c)
+  -> (IMap k b -> IMap k c)
+  -> IMap k a
+  -> IMap k b
+  -> IMap k c
+mergeWithKey f g1 g2 = adaptm_m_m (IntMap.mergeWithKey f' g1' g2')
+ where f'  = f . coerce
+       g1' = intmap . g1 . IMap
+       g2' = intmap . g2 . IMap
+       adapt_m_m f m = adapt_m (adapt_m f m)
+       adaptm_m_m f a b = IMap $ adapt_m_m f a b
+
+map :: (a -> b) -> IMap k a -> IMap k b
+map f = IMap . adapt_m (IntMap.map f)
+
+mapWithKey :: Coercible Int k => (k -> a -> b) -> IMap k a -> IMap k b
+mapWithKey f = IMap . adapt_m (IntMap.mapWithKey $ f . coerce)
+
+traverseWithKey ::
+  (Applicative f, Coercible Int k) =>
+  (k -> a -> f b) -> IMap k a -> f (IMap k b)
+traverseWithKey f = fmap IMap . adapt_m (IntMap.traverseWithKey $ f . coerce)
+
+mapAccum :: (t -> b -> (t, a)) -> t -> IMap k b -> (t, IMap k a)
+mapAccum f a m = second IMap $ IntMap.mapAccum f a (intmap m)
-- 
cgit v1.2.3