non-empty 0.3.1 → 0.3.2

raw patch · 5 files changed

+238/−13 lines, 5 filesdep +non-emptydep ~QuickCheckdep ~basedep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: non-empty

Dependency ranges changed: QuickCheck, base, containers, utility-ht

API changes (from Hackage documentation)

Files

• non-empty.cabal +18/−3
• src/Data/NonEmpty/Map.hs +68/−10
• src/Data/NonEmpty/Set.hs +9/−0
• test/Main.hs +18/−0
• test/Test/Map.hs +125/−0

@@ -1,5 +1,5 @@ Name:             non-empty-Version:          0.3.1+Version:          0.3.2 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -62,11 +62,11 @@     Requires multi-parameter type classes with functional dependencies.  Tested-With:      GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.1-Cabal-Version:    >=1.6+Cabal-Version:    >=1.8 Build-Type:       Simple  Source-Repository this-  Tag:         0.3.1+  Tag:         0.3.2   Type:        darcs   Location:    http://hub.darcs.net/thielema/non-empty/ @@ -99,3 +99,18 @@     Data.NonEmpty.Foldable     Data.NonEmptyPrivate     Data.NonEmptyTest+++Test-Suite non-empty-test+  Type:             exitcode-stdio-1.0+  Main-Is:          Main.hs+  GHC-Options:      -Wall+  Hs-source-dirs:   test+  Build-Depends:+    non-empty,+    containers,+    utility-ht,+    QuickCheck,+    base+  Other-Modules:+    Test.Map

@@ -1,6 +1,7 @@ module Data.NonEmpty.Map (    T,    insert,+   insertWith,    singleton,    member,    size,@@ -8,15 +9,21 @@    keys,    keysSet,    lookup,+   delete,    minViewWithKey,    maxViewWithKey,    fromList,+   fromListWith,+   fromAscList,    toAscList,    fetch,    flatten,    union,    unionLeft,    unionRight,+   unionWith,+   unionLeftWith,+   unionRightWith,    map,    mapWithKey,    ) where@@ -71,15 +78,32 @@   insert :: Ord k => k -> a -> Map k a -> T k a-insert = curry $ insertGen fst+insert = curry $ insertGen Map.insert fst -insertGen :: Ord k => (((k,a),(k,a)) -> (k,a)) -> (k,a) -> Map k a -> T k a-insertGen select y xt =+insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> T k a+insertWith f = curry $ insertGen (Map.insertWith f) (applyFst f)++applyFst :: (a -> a -> a) -> ((k,a), (k,a)) -> (k,a)+applyFst f ((k,a0),(_,a1)) = (k, f a0 a1)++insertRight :: Ord k => (k,a) -> Map k a -> T k a+insertRight = insertGen (Map.insertWith $ flip const) snd++insertRightWith :: Ord k => (a -> a -> a) -> (k,a) -> Map k a -> T k a+insertRightWith f =+   insertGen (Map.insertWith $ flip f) $ \((_,a0),(k,a1)) -> (k, f a1 a0)++insertGen ::+   Ord k =>+   (k -> a -> Map k a -> Map k a) ->+   (((k,a),(k,a)) -> (k,a)) ->+   (k,a) -> Map k a -> T k a+insertGen ins select y xt =    uncurry Cons $    fromMaybe (y, xt) $ do       (x,xs) <- Map.minViewWithKey xt       case comparing fst y x of-         GT -> return (x, uncurry Map.insert y xs)+         GT -> return (x, uncurry ins y xs)          EQ -> return (select (y,x), xs)          LT -> mzero @@ -109,6 +133,10 @@      then Just $ snd x      else Map.lookup y xs +delete :: (Ord k) => k -> T k a -> Map k a+delete y (Cons x xs) =+   if y == fst x then xs else uncurry Map.insert x $ Map.delete y xs+ minViewWithKey :: T k a -> ((k,a), Map k a) minViewWithKey (Cons x xs) = (x,xs) @@ -120,8 +148,15 @@       Just (y,ys) -> (y, uncurry Map.insert x ys)  fromList :: (Ord k) => NonEmpty.T [] (k,a) -> T k a-fromList (NonEmpty.Cons x xs) = uncurry insert x $ Map.fromList xs+fromList (NonEmpty.Cons x xs) = insertRight x $ Map.fromList xs +fromListWith :: (Ord k) => (a -> a -> a) -> NonEmpty.T [] (k,a) -> T k a+fromListWith f (NonEmpty.Cons x xs) =+   insertRightWith f x $ Map.fromListWith f xs++fromAscList :: (Ord k) => NonEmpty.T [] (k,a) -> T k a+fromAscList (NonEmpty.Cons x xs) = Cons x $ Map.fromAscList xs+ toAscList :: T k a -> NonEmpty.T [] (k,a) toAscList (Cons x xs) = NonEmpty.cons x $ Map.toAscList xs @@ -131,23 +166,46 @@ flatten :: (Ord k) => T k a -> Map k a flatten (Cons x xs) = uncurry Map.insert x xs ++{-+Could be implemented in terms of unionRight+but that would require inspection of the plain Map using Map.minViewWithKey.+-} union :: (Ord k) => T k a -> T k a -> T k a union (Cons x xs) (Cons y ys) =    uncurry Cons $    case Map.union xs ys of       zs ->          case comparing fst x y of-            LT -> (x, Map.union zs $ uncurry Map.singleton y)+            LT -> (x, uncurry (Map.insertWith (flip const)) y zs)             GT -> (y, uncurry Map.insert x zs)             EQ -> (x, zs)  unionLeft :: (Ord k) => Map k a -> T k a -> T k a-unionLeft xs (Cons y ys) =-   insertGen snd y $ Map.union xs ys+unionLeft xs (Cons y ys) = insertRight y $ Map.union xs ys  unionRight :: (Ord k) => T k a -> Map k a -> T k a-unionRight (Cons x xs) ys =-   insertGen fst x $ Map.union xs ys+unionRight (Cons x xs) ys = uncurry insert x $ Map.union xs ys+++unionWith :: (Ord k) => (a -> a -> a) -> T k a -> T k a -> T k a+unionWith f (Cons x xs) (Cons y ys) =+   uncurry Cons $+   case Map.unionWith f xs ys of+      zs ->+         case comparing fst x y of+            LT -> (x, uncurry (Map.insertWith (flip f)) y zs)+            GT -> (y, uncurry (Map.insertWith f) x zs)+            EQ -> (applyFst f (x,y), zs)++unionLeftWith :: (Ord k) => (a -> a -> a) -> Map k a -> T k a -> T k a+unionLeftWith f xs (Cons y ys) =+   insertRightWith f y $ Map.unionWith f xs ys++unionRightWith :: (Ord k) => (a -> a -> a) -> T k a -> Map k a -> T k a+unionRightWith f (Cons x xs) ys =+   uncurry (insertWith f) x $ Map.unionWith f xs ys+  map :: (Ord k) => (a -> b) -> T k a -> T k b map f (Cons x xs) = Cons (mapSnd f x) (Map.map f xs)

@@ -5,6 +5,7 @@    member,    size,    fromList,+   fromAscList,    toAscList,    fetch,    flatten,@@ -14,6 +15,7 @@     findMin,    findMax,+   delete,    deleteMin,    deleteMax,    deleteFindMin,@@ -106,6 +108,10 @@    if Set.null xs then x else Set.findMax xs  +delete :: (Ord k) => k -> T k -> Set k+delete y (Cons x xs) =+   if y == x then xs else Set.insert x $ Set.delete y xs+ deleteMin :: T a -> Set a deleteMin (Cons _ xs) = xs @@ -137,6 +143,9 @@  fromList :: (Ord a) => NonEmpty.T [] a -> T a fromList (NonEmpty.Cons x xs) = insert x $ Set.fromList xs++fromAscList :: (Ord a) => NonEmpty.T [] a -> T a+fromAscList (NonEmpty.Cons x xs) = Cons x $ Set.fromAscList xs  toAscList :: T a -> NonEmpty.T [] a toAscList (Cons x xs) = NonEmpty.Cons x $ Set.toAscList xs

@@ -0,0 +1,18 @@+module Main where++import qualified Test.Map as Map++import qualified Test.QuickCheck as QC++import Data.Tuple.HT (mapFst)+++prefix :: String -> [(String, test)] -> [(String, test)]+prefix msg = map (mapFst (\str -> msg ++ "." ++ str))++main :: IO ()+main =+   mapM_ (\(msg,prop) -> putStr (msg++": ") >> QC.quickCheck prop) $+   concat $+      prefix "Map" Map.tests :+      []

@@ -0,0 +1,125 @@+module Test.Map where++import qualified Data.NonEmpty.Map as NonEmptyMap+import qualified Data.NonEmpty as NonEmpty+import qualified Data.Map as Map++import qualified Test.QuickCheck as QC+++insert :: (Int,Char) -> [(Int,Char)] -> Bool+insert (k,a) xs =+   let m = Map.fromList xs+   in Map.insert k a m+      ==+      NonEmptyMap.flatten (NonEmptyMap.insert k a m)++insertWith :: (Int,String) -> [(Int,String)] -> Bool+insertWith (k,a) xs =+   let m = Map.fromList xs+   in Map.insertWith (++) k a m+      ==+      NonEmptyMap.flatten (NonEmptyMap.insertWith (++) k a m)++delete :: Int -> NonEmpty.T [] (Int,Char) -> Bool+delete k xs =+   let m = NonEmptyMap.fromList xs+   in Map.delete k (NonEmptyMap.flatten m)+      ==+      NonEmptyMap.delete k m+++fromList :: NonEmpty.T [] (Int,Char) -> Bool+fromList xs =+   Map.fromList (NonEmpty.flatten xs)+   ==+   NonEmptyMap.flatten (NonEmptyMap.fromList xs)++fromListWith :: NonEmpty.T [] (Int,String) -> Bool+fromListWith xs =+   Map.fromListWith (++) (NonEmpty.flatten xs)+   ==+   NonEmptyMap.flatten (NonEmptyMap.fromListWith (++) xs)++fromAscList :: NonEmpty.T [] (Int,Char) -> Bool+fromAscList xs =+   let m = NonEmptyMap.fromList xs+   in NonEmptyMap.fromAscList (NonEmptyMap.toAscList m) == m++toAscList :: NonEmpty.T [] (Int,Char) -> Bool+toAscList xs =+   let m = NonEmptyMap.fromList xs+   in NonEmpty.flatten (NonEmptyMap.toAscList m)+      ==+      Map.toAscList (NonEmptyMap.flatten m)+++union :: NonEmpty.T [] (Int,Char) -> NonEmpty.T [] (Int,Char) -> Bool+union xs ys =+   Map.union+      (Map.fromList (NonEmpty.flatten xs))+      (Map.fromList (NonEmpty.flatten ys))+   ==+   NonEmptyMap.flatten+      (NonEmptyMap.union+         (NonEmptyMap.fromList xs)+         (NonEmptyMap.fromList ys))++unionWith :: NonEmpty.T [] (Int,String) -> NonEmpty.T [] (Int,String) -> Bool+unionWith xs ys =+   Map.unionWith (++)+      (Map.fromList (NonEmpty.flatten xs))+      (Map.fromList (NonEmpty.flatten ys))+   ==+   NonEmptyMap.flatten+      (NonEmptyMap.unionWith (++)+         (NonEmptyMap.fromList xs)+         (NonEmptyMap.fromList ys))++unionLeft :: [] (Int,Char) -> NonEmpty.T [] (Int,Char) -> Bool+unionLeft xs ys =+   let xm = Map.fromList xs+   in Map.union xm (Map.fromList (NonEmpty.flatten ys))+      ==+      NonEmptyMap.flatten (NonEmptyMap.unionLeft xm (NonEmptyMap.fromList ys))++unionLeftWith :: [] (Int,String) -> NonEmpty.T [] (Int,String) -> Bool+unionLeftWith xs ys =+   let xm = Map.fromList xs+   in Map.unionWith (++) xm (Map.fromList (NonEmpty.flatten ys))+      ==+      NonEmptyMap.flatten+         (NonEmptyMap.unionLeftWith (++) xm (NonEmptyMap.fromList ys))++unionRight :: NonEmpty.T [] (Int,Char) -> [] (Int,Char) -> Bool+unionRight xs ys =+   let ym = Map.fromList ys+   in Map.union (Map.fromList (NonEmpty.flatten xs)) ym+      ==+      NonEmptyMap.flatten (NonEmptyMap.unionRight (NonEmptyMap.fromList xs) ym)++unionRightWith :: NonEmpty.T [] (Int,String) -> [] (Int,String) -> Bool+unionRightWith xs ys =+   let ym = Map.fromList ys+   in Map.unionWith (++) (Map.fromList (NonEmpty.flatten xs)) ym+      ==+      NonEmptyMap.flatten+         (NonEmptyMap.unionRightWith (++) (NonEmptyMap.fromList xs) ym)+++tests :: [(String, QC.Property)]+tests =+   ("insert", QC.property insert) :+   ("insertWith", QC.property insertWith) :+   ("delete", QC.property delete) :+   ("fromList", QC.property fromList) :+   ("fromListWith", QC.property fromListWith) :+   ("fromAscList", QC.property fromAscList) :+   ("toAscList", QC.property toAscList) :+   ("union", QC.property union) :+   ("unionWith", QC.property unionWith) :+   ("unionLeft", QC.property unionLeft) :+   ("unionLeftWith", QC.property unionLeftWith) :+   ("unionRight", QC.property unionRight) :+   ("unionRightWith", QC.property unionRightWith) :+   []