packages feed

IntervalMap 0.5.3.1 → 0.6.0.0

raw patch · 13 files changed

+130/−75 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Data.IntervalSet: instance (Data.IntervalMap.Generic.Interval.Interval i k, GHC.Classes.Ord i) => Data.Semigroup.Semigroup (Data.IntervalSet.IntervalSet i)
- Data.IntervalMap.Generic.Interval: class Ord e => Interval i e | i -> e where leftClosed _ = True rightClosed _ = True a `before` b = upperBound a < lowerBound b || (upperBound a == lowerBound b && not (rightClosed a && leftClosed b)) a `after` b = b `before` a a `subsumes` b = (lowerBound a < lowerBound b || (lowerBound a == lowerBound b && (leftClosed a || not (leftClosed b)))) && (upperBound a > upperBound b || (upperBound a == upperBound b && (rightClosed a || not (rightClosed b)))) a `overlaps` b = (lowerBound a < upperBound b || (lowerBound a == upperBound b && leftClosed a && rightClosed b)) && (upperBound a > lowerBound b || (upperBound a == lowerBound b && rightClosed a && leftClosed b)) p `below` i = case compare p (lowerBound i) of { LT -> True EQ -> not (leftClosed i) GT -> False } p `above` i = case compare p (upperBound i) of { LT -> False EQ -> not (rightClosed i) GT -> True } p `inside` i = not ((p `above` i) || (p `below` i)) isEmpty i | leftClosed i && rightClosed i = lowerBound i > upperBound i | otherwise = lowerBound i >= upperBound i compareUpperBounds a b = case compare (upperBound a) (upperBound b) of { LT -> LT GT -> GT EQ -> case (rightClosed a, rightClosed b) of { (False, True) -> LT (True, False) -> GT _ -> EQ } }
+ Data.IntervalMap.Generic.Interval: class Ord e => Interval i e | i -> e
- Data.IntervalMap.Generic.Lazy: class Ord e => Interval i e | i -> e where leftClosed _ = True rightClosed _ = True a `before` b = upperBound a < lowerBound b || (upperBound a == lowerBound b && not (rightClosed a && leftClosed b)) a `after` b = b `before` a a `subsumes` b = (lowerBound a < lowerBound b || (lowerBound a == lowerBound b && (leftClosed a || not (leftClosed b)))) && (upperBound a > upperBound b || (upperBound a == upperBound b && (rightClosed a || not (rightClosed b)))) a `overlaps` b = (lowerBound a < upperBound b || (lowerBound a == upperBound b && leftClosed a && rightClosed b)) && (upperBound a > lowerBound b || (upperBound a == lowerBound b && rightClosed a && leftClosed b)) p `below` i = case compare p (lowerBound i) of { LT -> True EQ -> not (leftClosed i) GT -> False } p `above` i = case compare p (upperBound i) of { LT -> False EQ -> not (rightClosed i) GT -> True } p `inside` i = not ((p `above` i) || (p `below` i)) isEmpty i | leftClosed i && rightClosed i = lowerBound i > upperBound i | otherwise = lowerBound i >= upperBound i compareUpperBounds a b = case compare (upperBound a) (upperBound b) of { LT -> LT GT -> GT EQ -> case (rightClosed a, rightClosed b) of { (False, True) -> LT (True, False) -> GT _ -> EQ } }
+ Data.IntervalMap.Generic.Lazy: class Ord e => Interval i e | i -> e
- Data.IntervalMap.Generic.Strict: class Ord e => Interval i e | i -> e where leftClosed _ = True rightClosed _ = True a `before` b = upperBound a < lowerBound b || (upperBound a == lowerBound b && not (rightClosed a && leftClosed b)) a `after` b = b `before` a a `subsumes` b = (lowerBound a < lowerBound b || (lowerBound a == lowerBound b && (leftClosed a || not (leftClosed b)))) && (upperBound a > upperBound b || (upperBound a == upperBound b && (rightClosed a || not (rightClosed b)))) a `overlaps` b = (lowerBound a < upperBound b || (lowerBound a == upperBound b && leftClosed a && rightClosed b)) && (upperBound a > lowerBound b || (upperBound a == lowerBound b && rightClosed a && leftClosed b)) p `below` i = case compare p (lowerBound i) of { LT -> True EQ -> not (leftClosed i) GT -> False } p `above` i = case compare p (upperBound i) of { LT -> False EQ -> not (rightClosed i) GT -> True } p `inside` i = not ((p `above` i) || (p `below` i)) isEmpty i | leftClosed i && rightClosed i = lowerBound i > upperBound i | otherwise = lowerBound i >= upperBound i compareUpperBounds a b = case compare (upperBound a) (upperBound b) of { LT -> LT GT -> GT EQ -> case (rightClosed a, rightClosed b) of { (False, True) -> LT (True, False) -> GT _ -> EQ } }
+ Data.IntervalMap.Generic.Strict: class Ord e => Interval i e | i -> e
- Data.IntervalSet: class Ord e => Interval i e | i -> e where leftClosed _ = True rightClosed _ = True a `before` b = upperBound a < lowerBound b || (upperBound a == lowerBound b && not (rightClosed a && leftClosed b)) a `after` b = b `before` a a `subsumes` b = (lowerBound a < lowerBound b || (lowerBound a == lowerBound b && (leftClosed a || not (leftClosed b)))) && (upperBound a > upperBound b || (upperBound a == upperBound b && (rightClosed a || not (rightClosed b)))) a `overlaps` b = (lowerBound a < upperBound b || (lowerBound a == upperBound b && leftClosed a && rightClosed b)) && (upperBound a > lowerBound b || (upperBound a == lowerBound b && rightClosed a && leftClosed b)) p `below` i = case compare p (lowerBound i) of { LT -> True EQ -> not (leftClosed i) GT -> False } p `above` i = case compare p (upperBound i) of { LT -> False EQ -> not (rightClosed i) GT -> True } p `inside` i = not ((p `above` i) || (p `below` i)) isEmpty i | leftClosed i && rightClosed i = lowerBound i > upperBound i | otherwise = lowerBound i >= upperBound i compareUpperBounds a b = case compare (upperBound a) (upperBound b) of { LT -> LT GT -> GT EQ -> case (rightClosed a, rightClosed b) of { (False, True) -> LT (True, False) -> GT _ -> EQ } }
+ Data.IntervalSet: class Ord e => Interval i e | i -> e

Files

Data/IntervalMap/Generic/Base.hs view
@@ -200,8 +200,9 @@             ) where  import Prelude hiding (null, lookup, map, filter, foldr, foldl, splitAt)-import Data.Maybe (fromJust)+import Data.Maybe (fromMaybe, fromJust) import Data.Bits (shiftR, (.&.))+import qualified Data.Semigroup as Sem import Data.Monoid (Monoid(..)) import Control.Applicative (Applicative(..), (<$>), (<|>)) import Data.Traversable (Traversable(traverse))@@ -222,9 +223,7 @@ -- Use 'lookup' or 'findWithDefault' instead of this function, unless you are absolutely -- sure that the key is present in the map. (!) :: (Interval k e, Ord k) => IntervalMap k v -> k -> v-tree ! key = case lookup key tree of-               Just v  -> v-               Nothing -> error "IntervalMap.!: key not found"+tree ! key = fromMaybe (error "IntervalMap.!: key not found") (lookup key tree)  -- | Same as 'difference'. (\\) :: (Interval k e, Ord k) => IntervalMap k a -> IntervalMap k b -> IntervalMap k a@@ -251,6 +250,9 @@ instance Functor (IntervalMap k) where   fmap f m  = map f m +instance (Interval i k, Ord i) => Sem.Semigroup (IntervalMap i v) where+  (<>) = union+ instance (Interval i k, Ord i) => Monoid (IntervalMap i v) where     mempty  = empty     mappend = union@@ -302,7 +304,7 @@ mNode c k v l r = Node c k (maxUpper k l r) v l r  maxUpper :: (Interval i k) => i -> IntervalMap i v -> IntervalMap i v -> i-maxUpper k Nil                Nil                = k `seq` k+maxUpper k Nil                Nil                = k maxUpper k Nil                (Node _ _ m _ _ _) = maxByUpper k m maxUpper k (Node _ _ m _ _ _) Nil                = maxByUpper k m maxUpper k (Node _ _ l _ _ _) (Node _ _ r _ _ _) = maxByUpper k (maxByUpper l r)@@ -382,9 +384,7 @@ -- the value at key @k@ or returns default value @def@ -- when the key is not in the map. findWithDefault :: Ord k => a -> k -> IntervalMap k a -> a-findWithDefault def k m = case lookup k m of-    Nothing -> def-    Just x  -> x+findWithDefault def k m = fromMaybe def (lookup k m)  -- | /O(log n)/. Find the largest key smaller than the given one -- and return it along with its value.@@ -1243,7 +1243,7 @@ splitLookup :: (Interval i k, Ord i) => i -> IntervalMap i a -> (IntervalMap i a, Maybe a, IntervalMap i a) splitLookup x m = case span (\(k,_) -> k < x) (toAscList m) of                     ([], [])                        -> (empty, Nothing, empty)-                    ([], ((k,v):_))     | k == x    -> (empty, Just v, deleteMin m)+                    ([], (k,v):_)       | k == x    -> (empty, Just v, deleteMin m)                                         | otherwise -> (empty, Nothing, m)                     (_, [])                         -> (m, Nothing, empty)                     (lt, ge@((k,v):gt)) | k == x    -> (fromDistinctAscList lt, Just v, fromDistinctAscList gt)@@ -1391,9 +1391,8 @@                                       ld -> if ld < 0 then ld                                             else                                               case blackDepth r of-                                                rd -> if rd < 0 then rd-                                                      else if rd /= ld then -1-                                                      else if c == R && (isRed l || isRed r) then -1-                                                      else if c == B then rd + 1-                                                      else rd+                                                rd | rd < 0    -> rd+                                                   | rd /= ld || (c == R && (isRed l || isRed r)) -> -1+                                                   | c == B    -> rd + 1+                                                   | otherwise -> rd 
Data/IntervalMap/Generic/Strict.hs view
@@ -196,6 +196,7 @@  import Prelude hiding (null, lookup, map, filter, foldr, foldl, splitAt) import qualified Data.List as L+import Data.Maybe (fromMaybe) import Data.IntervalMap.Generic.Base as M hiding (       singleton     , insert@@ -250,9 +251,7 @@ -- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x' -- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a' findWithDefault :: Ord k => a -> k -> IntervalMap k a -> a-findWithDefault def k m = def `seq` case M.lookup k m of-    Nothing -> def-    Just x  -> x+findWithDefault def k m = def `seq` fromMaybe def (M.lookup k m)  -- | /O(log n)/. Insert a new key/value pair. If the map already contains the key, its value is -- changed to the new value.
Data/IntervalSet.hs view
@@ -1,6 +1,6 @@ -- | -- Module      :  Data.IntervalSet--- Copyright   :  (c) Christoph Breitkopf 2015+-- Copyright   :  (c) Christoph Breitkopf 2015 - 2017 -- License     :  BSD-style -- Maintainer  :  chbreitkopf@gmail.com -- Stability   :  experimental@@ -133,14 +133,14 @@              ) where -import Prelude hiding (null, lookup, map, filter, foldr, foldl, splitAt)+import Prelude hiding (null, map, filter, foldr, foldl, splitAt) import Data.Bits (shiftR, (.&.))+import qualified Data.Semigroup as Sem import Data.Monoid (Monoid(..)) import qualified Data.Foldable as Foldable import qualified Data.List as L import Control.DeepSeq import Control.Applicative ((<|>))-import qualified Data.Foldable as Foldable  import Data.IntervalMap.Generic.Interval @@ -171,6 +171,9 @@ instance (Ord k) => Ord (IntervalSet k) where   compare a b = compare (toAscList a) (toAscList b) +instance (Interval i k, Ord i) => Sem.Semigroup (IntervalSet i) where+  (<>) = union+ instance (Interval i k, Ord i) => Monoid (IntervalSet i) where     mempty  = empty     mappend = union@@ -219,7 +222,7 @@ mNode c k l r = Node c k (maxUpper k l r) l r  maxUpper :: (Interval i k) => i -> IntervalSet i -> IntervalSet i -> i-maxUpper k Nil              Nil              = k `seq` k+maxUpper k Nil              Nil              = k maxUpper k Nil              (Node _ _ m _ _) = maxByUpper k m maxUpper k (Node _ _ m _ _) Nil              = maxByUpper k m maxUpper k (Node _ _ l _ _) (Node _ _ r _ _) = maxByUpper k (maxByUpper l r)@@ -642,10 +645,10 @@  -- | /O(n)/. The list of all values contained in the set, in ascending order. toAscList :: IntervalSet k -> [k]-toAscList m = foldr (\k r -> k : r) [] m+toAscList set = toAscList' set []  toAscList' :: IntervalSet k -> [k] -> [k]-toAscList' m xs = foldr (\k r -> k : r) xs m+toAscList' m xs = foldr (:) xs m   @@ -658,12 +661,12 @@  -- | /O(n)/. The list of all values in the set, in descending order. toDescList :: IntervalSet k -> [k]-toDescList m = foldl (\r k -> k : r) [] m+toDescList m = foldl (flip (:)) [] m  -- | /O(n log n)/. Build a set from a list of elements. See also 'fromAscList'. -- If the list contains duplicate values, the last value is retained. fromList :: (Interval k e, Ord k) => [k] -> IntervalSet k-fromList xs = L.foldl' (\m k -> insert k m) empty xs+fromList xs = L.foldl' (flip insert) empty xs  -- | /O(n)/. Build a set from an ascending list in linear time. -- /The precondition (input list is ascending) is not checked./@@ -772,7 +775,7 @@ splitMember :: (Interval i k, Ord i) => i -> IntervalSet i -> (IntervalSet i, Bool, IntervalSet i) splitMember x s = case span (< x) (toAscList s) of                     ([], [])                    -> (empty, False, empty)-                    ([], (y:_))     | y == x    -> (empty, True, deleteMin s)+                    ([], y:_)       | y == x    -> (empty, True, deleteMin s)                                     | otherwise -> (empty, False, s)                     (_, [])                     -> (s, False, empty)                     (lt, ge@(y:gt)) | y == x    -> (fromDistinctAscList lt, True, fromDistinctAscList gt)@@ -934,9 +937,8 @@                                       ld -> if ld < 0 then ld                                             else                                               case blackDepth r of-                                                rd -> if rd < 0 then rd-                                                      else if rd /= ld then -1-                                                      else if c == R && (isRed l || isRed r) then -1-                                                      else if c == B then rd + 1-                                                      else rd+                                                rd | rd < 0       -> rd+                                                   | rd /= ld || (c == R && (isRed l || isRed r)) -> -1+                                                   | c == B       -> rd + 1+                                                   | otherwise    -> rd 
IntervalMap.cabal view
@@ -1,5 +1,5 @@ Name:                IntervalMap-Version:             0.5.3.1+Version:             0.6.0.0 Stability:           experimental Synopsis:            Containers for intervals, with efficient search. Homepage:            http://www.chr-breitkopf.de/comp/IntervalMap@@ -8,11 +8,11 @@ Author:              Christoph Breitkopf Maintainer:          Christoph Breitkopf <chbreitkopf@gmail.com> bug-reports:         mailto:chbreitkopf@gmail.com-Copyright:           2011-2017 Christoph Breitkopf+Copyright:           2011-2018 Christoph Breitkopf Category:            Data Build-type:          Simple Cabal-version:       >= 1.8-Tested-With:         GHC ==7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.2, GHC ==8.0.1+Tested-With:         GHC ==8.0.2, GHC ==8.2.1, GHC ==8.4.1 Description:                      Ordered containers of intervals, with efficient search                      for all keys containing a point or overlapping an interval.@@ -34,9 +34,7 @@                        Data.IntervalSet   other-modules:       Data.IntervalMap.Generic.Base   Build-depends:       base >= 4 && < 5, containers, deepseq-  ghc-options: -Wall-  if impl(ghc >= 6.8)-    ghc-options: -fwarn-tabs+  ghc-options: -Wall -fwarn-tabs  Test-Suite TestInterval   type:               exitcode-stdio-1.0
README.md view
@@ -6,10 +6,37 @@  Home page and documentation: [http://www.chr-breitkopf.de/comp/IntervalMap/index.html](http://www.chr-breitkopf.de/comp/IntervalMap/index.html) -Install from hackage with cabal install.+## Getting started -To run the tests, extract the archive, and do+Enable necessary language extensions:+```haskell+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+```+In most cases, you should use the value-strict version:+```haskell+import qualified Data.IntervalMap.Generic.Strict as IM+```+Make tuples an instance of Interval:+```haskell+instance Ord e => IM.Interval (e,e) e where+    lowerBound (a,_) = a+    upperBound (_,b) = b+    rightClosed _ = False+```+By using `rightClosed _ = False` we have defined tuples to be half-open+intervals - they include the starting value, but not the end value. -    $ cabal configure --enable-tests-    $ cabal build-    $ cabal test+Let's create a map from `(Int,Int)` intervals to strings:+```haskell+type MyMap = IM.IntervalMap (Int,Int) String++sample :: MyMap+sample = IM.fromList [((1,6), "Foo"), ((2,4), "Bar"), ((4,7), "Baz")]+```+Lookup intervals containing a given point ("stabbing query"):+```+> IM.toAscList (sample `IM.containing` 3)+[((1,6),"Foo"),((2,4),"Bar")]+> IM.toAscList (sample `IM.containing` 4)+[((1,6),"Foo"),((4,7),"Baz")]+```
bench/BenchIntervalSet.hs view
@@ -22,7 +22,7 @@  forceRange :: Int -> Int -> Int -> Int forceRange lo hi n | n >= lo && n <= hi = n-                   | n < 0              = forceRange lo hi (0 - n)+                   | n < 0              = forceRange lo hi (negate n)                    | otherwise          = lo + (n `rem` (1 + hi - lo))  genRandomInts :: Int -> Int -> Int -> [Int]@@ -62,7 +62,7 @@ main =   do       let ivs  = genRandomIntervals cDATA_SIZE 50 cDATA_SIZE-      ivsP   <- ensure $ [IV lo hi | (lo,hi) <- ivs]+      ivsP   <- ensure [IV lo hi | (lo,hi) <- ivs]       oIvsP  <- ensure $ sort ivsP       let lookupKeys = ivsP       set <- ensure $ S.fromList ivsP
bench/WeighAllocs.hs view
@@ -4,7 +4,7 @@ import Weigh  import Control.DeepSeq-import Prelude hiding (lookup, max, foldr)+import Prelude hiding (max) import System.Random import Data.Foldable (foldr) @@ -23,7 +23,7 @@  forceRange :: Int -> Int -> Int -> Int forceRange lo hi n | n >= lo && n <= hi = n-                   | n < 0              = forceRange lo hi (0 - n)+                   | n < 0              = forceRange lo hi (negate n)                    | otherwise          = lo + (n `rem` (1 + hi - lo))  genRandomIntervals :: Int -> Int -> Int -> [(Int,Int)]@@ -54,12 +54,12 @@   do       let ivs  = genRandomIntervals cDATA_SIZE 50 cDATA_SIZE       let n = show cDATA_SIZE-      ivsP   <- ensure $ [IV lo hi | (lo,hi) <- ivs]+      ivsP   <- ensure [IV lo hi | (lo,hi) <- ivs]       cS     <- ensure $ C.fromList ivsP       sS     <- ensure $ S.fromList ivsP       oIvsP  <- ensure $ C.toAscList cS       let m = show (length oIvsP)-      kvs    <- ensure $ [(iv, lowerBound iv) | iv <- ivsP]+      kvs    <- ensure [(iv, lowerBound iv) | iv <- ivsP]       cMap   <- ensure $ M.fromList kvs       ivMap  <- ensure $ IVM.fromList kvs       oKvs   <- ensure $ M.toAscList cMap
changelog view
@@ -1,3 +1,5 @@+0.6.0.0  Support ghc 8.4, desupport ghc 7.x+ 0.5.3.1  Remove HPC flag. 0.5.3.0  Add lookupLT... functions. 
+ examples/GetttingStarted.lhs view
@@ -0,0 +1,30 @@+You need some language extensions to be able to+define Interval Instances:++> {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++In most cases, you should use the value-strict version:++> import qualified Data.IntervalMap.Generic.Strict as IM++Make tuples an instance of Interval:++> instance Ord e => IM.Interval (e,e) e where+>   lowerBound (a,_) = a+>   upperBound (_,b) = b+>   rightClosed _ = False++By using `rightClosed _ = False` we have defined tuples to be half-open+intervals - they include the starting value, but not the end value.++Now we can put them into a Map:++> type MyMap = IM.IntervalMap (Int,Int) String+>+> sample :: MyMap+> sample = IM.fromList [((1,6), "Foo"), ((2,4), "Bar"), ((4,7), "Baz")]++Lookup intervals containing a given point ("stabbing query"):++> main = print (IM.toAscList $ sample `IM.containing` 3)+
test/GenericIntervalTests.hs view
@@ -7,7 +7,6 @@  import Test.QuickCheck import Test.QuickCheck.Test (isSuccess)-import Control.Monad (liftM)  import Data.IntervalMap.Generic.Interval @@ -103,7 +102,7 @@  instance Arbitrary II where   arbitrary = do x <- arbitrary-		 liftM II (interval (abs x))+                 fmap II (interval (abs x))  interval x = do 	     y <- sized (\n -> choose (x, x + abs n))@@ -131,8 +130,8 @@  prop_compare1 (II i1) (II i2) =   case compare (lowerBound i1) (lowerBound i2) of-    LT -> compare i1 i2 == LT-    GT -> compare i1 i2 == GT+    LT -> i1 < i2+    GT -> i1 > i2     EQ -> True  prop_contains (II i) p =
test/IntervalMapTests.hs view
@@ -4,8 +4,9 @@  import Test.QuickCheck import Test.QuickCheck.Test (isSuccess)-import Data.List ((\\), sort, sortBy)-import Control.Monad (liftM, foldM)+import Data.List ((\\), sort, sortBy, minimumBy)+import Data.Maybe (isNothing)+import Control.Monad (foldM)  import Data.IntervalMap as M import Data.IntervalMap.Interval@@ -16,7 +17,7 @@  instance Arbitrary II where   arbitrary = do x <- arbitrary-                 liftM II (interval (abs x))+                 fmap II (interval (abs x))  interval :: Int -> Gen (Interval Int) interval x = do@@ -45,7 +46,7 @@   1 == M.height single46 &&   Just "single46" == M.lookup (ClosedInterval 4 6) single46 &&   "single46" == single46 M.! ClosedInterval 4 6 &&-  Nothing == M.lookup (OpenInterval 4 6) single46 &&+  isNothing (M.lookup (OpenInterval 4 6) single46) &&   single46 == single46 `containing` 5  @@ -64,7 +65,7 @@   "14" == bal3 M.! ClosedInterval 1 4 &&   "58" == bal3 M.! ClosedInterval 5 8 &&   "o58" == bal3' M.! OpenInterval 5 8 &&-  Nothing == M.lookup (OpenInterval 5 8) bal3 &&+  isNothing (M.lookup (OpenInterval 5 8) bal3) &&   Just "o58" == M.lookup (OpenInterval 5 8) bal3' &&   M.null (bal3 `containing` 0) &&   M.null (bal3 `containing` 9) &&@@ -91,11 +92,11 @@   prop_tests3 =-   68 == deep100L M.! (ClosedInterval 68 68) &&+   68 == deep100L M.! ClosedInterval 68 68 &&    [17] == Prelude.map snd (toAscList (deep100L `containing` 17)) &&    100 == M.size deep100L &&    (M.height deep100L <= 12) &&-   68 == deep100R M.! (ClosedInterval 68 68) &&+   68 == deep100R M.! ClosedInterval 68 68 &&    [17] == Prelude.map snd (toAscList (deep100R `containing` 17)) &&    100 == M.size deep100R &&    (M.height deep100R <= 12) &&@@ -276,20 +277,20 @@                                              sameElements (M.toList m Data.List.\\ [x]) (M.toList (M.deleteMax m))  prop_findLast (IMI m) = not (M.null m) ==>-                         M.findLast m == head (sortBy cmp (M.toList m))+                         M.findLast m == minimumBy cmp (M.toList m)                         where cmp (a,_) (b,_) = invert (compareByUpper a b)                               invert LT = GT                               invert GT = LT                               invert EQ = EQ  -prop_insertWith (IMI m) (II i) v = let m' = M.insertWith (\new old -> new + old) i v m in+prop_insertWith (IMI m) (II i) v = let m' = M.insertWith (+) i v m in                                    if M.member i m then                                       M.valid m' && m' M.! i == m M.! i + v && M.size m' == M.size m                                    else                                       M.valid m' && m' M.! i == v && M.size m' == M.size m + 1 -prop_insertWith' (IMI m) (II i) v = let m' = M.insertWith' (\new old -> new + old) i v m in+prop_insertWith' (IMI m) (II i) v = let m' = M.insertWith' (+) i v m in                                     if M.member i m then                                        M.valid m' && m' M.! i == m M.! i + v && M.size m' == M.size m                                     else@@ -318,14 +319,14 @@                                            Nothing -> False                                            Just v' -> v' == v * 13 -prop_update (II i) (IMI m) = let f n = if n `rem` 2 == 0 then Nothing else Just (13 * n)+prop_update (II i) (IMI m) = let f n = if even n then Nothing else Just (13 * n)                                  m' = M.update f i m                              in                                  M.valid m' &&                                  case M.lookup i m of                                    Nothing -> m == m'                                    Just v -> case M.lookup i m' of-                                               Nothing -> v `rem` 2 == 0+                                               Nothing -> even v                                                Just v' -> v' == 13 * v  prop_alter (IMI m) (II k) = delete && insert
test/IntervalSetTests.hs view
@@ -32,8 +32,7 @@  instance Arbitrary II where   arbitrary = do x <- arbitrary-                 iv <- interval (abs x)-                 return iv+                 interval (abs x)  interval :: Int -> Gen II interval x = do y <- sized (\n -> choose (x, x + abs n))@@ -207,10 +206,10 @@                                   valid s' &&                                   all (\e -> if iv `subsumes` e then e `member` s' else e `notMember` s') (toList s)                                   -prop_foldr  (IS s) iv =           Just (foldr  (\v r -> min v r) iv s) == findMin (insert iv s)-prop_foldr' (IS s) iv =           Just (foldr' (\v r -> min v r) iv s) == findMin (insert iv s)-prop_foldl  (IS s) iv =           Just (foldl  (\r v -> min v r) iv s) == findMin (insert iv s)-prop_foldl' (IS s) iv =           Just (foldl' (\r v -> min v r) iv s) == findMin (insert iv s)+prop_foldr  (IS s) iv =           Just (foldr  min iv s) == findMin (insert iv s)+prop_foldr' (IS s) iv =           Just (foldr' min iv s) == findMin (insert iv s)+prop_foldl  (IS s) iv =           Just (foldl  min iv s) == findMin (insert iv s)+prop_foldl' (IS s) iv =           Just (foldl' min iv s) == findMin (insert iv s)  prop_flattenWithMonotonic (IS s) = let s' = flattenWithMonotonic combine s in                                    valid s' &&
test/IntervalTests.hs view
@@ -4,7 +4,6 @@  import Test.QuickCheck import Test.QuickCheck.Test (isSuccess)-import Control.Monad (liftM) import Data.List (maximumBy) import Data.Maybe @@ -83,7 +82,7 @@  instance Arbitrary II where   arbitrary = do x <- arbitrary-                 liftM II (interval (abs x))+                 fmap II (interval (abs x))  interval x = do              y <- sized (\n -> choose (x, x + abs n))@@ -111,8 +110,8 @@  prop_compare1 (II i1) (II i2) =   case compare (lowerBound i1) (lowerBound i2) of-    LT -> compare i1 i2 == LT-    GT -> compare i1 i2 == GT+    LT -> i1 < i2+    GT -> i1 > i2     EQ -> True  prop_compare_openness_closedness_lower_bound (II i1) (II i2) =@@ -144,7 +143,7 @@   in maybeTest (i ==) (combine i i)  prop_combine_overlapping (II a) (II b) =-  (isJust (combine a b)) === (a `overlaps` b)+  isJust (combine a b) === (a `overlaps` b)  prop_combine_bounds (II a) (II b) =   case combine a b of