data-interval 1.3.1 → 2.0.0

raw patch · 14 files changed

+445/−185 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +17/−0
• data-interval.cabal +6/−1
• src/Data/IntegerInterval.hs +28/−16
• src/Data/IntegerInterval/Internal.hs +36/−13
• src/Data/Interval.hs +69/−58
• src/Data/Interval/Internal.hs +96/−26
• src/Data/IntervalMap/Base.hs +43/−38
• src/Data/IntervalMap/Lazy.hs +0/−1
• src/Data/IntervalMap/Strict.hs +11/−10
• src/Data/IntervalSet.hs +18/−13
• test/TestIntegerInterval.hs +4/−1
• test/TestInterval.hs +5/−2
• test/TestIntervalMap.hs +109/−6
• test/TestIntervalSet.hs +3/−0

@@ -1,3 +1,20 @@+2.0.0+-----+* change internal representation of `Interval` and `IntegerInterval` to+  reduce memory footprint (#7, thanks Bodigrim)+* introduce `Boundary` type (#10, thanks Bodigrim)+* export `isSingleton` function for `Interval` and `IntegerInterval` (#13)+* add `Generic` instances for `Interval` and `IntegerInterval`+* remove deprecated `EndPoint` data type (#14, thanks Bodigrim)++1.3.1+-----+* support lattices-2.0 (Thanks to Bodigrim).+* move definitions of `Interval` and `IntegerInterval` data types into+  internal modules and abstract away representations from the rest of+  modules (Thanks to Bodigrim).++ 1.3.0 ----- * add `Data.IntervalSet`, `Data.IntervalMap.Lazy`, `Data.IntervalMap.Strict` modules

@@ -1,5 +1,5 @@ Name:		data-interval-Version:	1.3.1+Version:	2.0.0 License:	BSD3 License-File:	COPYING Author:		Masahiro Sakai (masahiro.sakai@gmail.com)@@ -48,6 +48,8 @@      ScopedTypeVariables      TypeFamilies      DeriveDataTypeable+     DeriveGeneric+     LambdaCase      MultiWayIf      Safe   Exposed-Modules:@@ -81,6 +83,9 @@      , tasty-th      , HUnit      , QuickCheck >=2.5 && <3+  if impl(ghc <8.0)+    Build-depends:+      semigroups   if impl(ghc <7.10)     Build-depends:       transformers >=0.2

@@ -25,6 +25,7 @@   -- * Interval type     IntegerInterval   , module Data.ExtendedReal+  , Boundary(..)    -- * Construction   , interval@@ -38,6 +39,7 @@    -- * Query   , null+  , isSingleton   , member   , notMember   , isSubsetOf@@ -85,6 +87,7 @@ import Data.Maybe import Prelude hiding (null) import Data.IntegerInterval.Internal+import Data.Interval (Boundary(..)) import qualified Data.Interval as Interval  infix 5 <..<=@@ -111,19 +114,19 @@  -- | 'lowerBound' of the interval and whether it is included in the interval. -- The result is convenient to use as an argument for 'interval'.-lowerBound' :: IntegerInterval -> (Extended Integer, Bool)+lowerBound' :: IntegerInterval -> (Extended Integer, Boundary) lowerBound' x =   case lowerBound x of-    lb@(Finite _) -> (lb, True)-    lb@_ -> (lb, False)+    lb@(Finite _) -> (lb, Closed)+    lb@_ -> (lb, Open)  -- | 'upperBound' of the interval and whether it is included in the interval. -- The result is convenient to use as an argument for 'interval'.-upperBound' :: IntegerInterval -> (Extended Integer, Bool)+upperBound' :: IntegerInterval -> (Extended Integer, Boundary) upperBound' x =   case upperBound x of-    ub@(Finite _) -> (ub, True)-    ub@_ -> (ub, False)+    ub@(Finite _) -> (ub, Closed)+    ub@_ -> (ub, Open)  #if MIN_VERSION_lattices(2,0,0) @@ -161,7 +164,7 @@   showsPrec _ x | null x = showString "empty"   showsPrec p x =     showParen (p > rangeOpPrec) $-      showsPrec (rangeOpPrec+1) (lowerBound x) . +      showsPrec (rangeOpPrec+1) (lowerBound x) .       showString " <=..<= " .       showsPrec (rangeOpPrec+1) (upperBound x) @@ -184,11 +187,11 @@  -- | smart constructor for 'IntegerInterval' interval-  :: (Extended Integer, Bool) -- ^ lower bound and whether it is included-  -> (Extended Integer, Bool) -- ^ upper bound and whether it is included+  :: (Extended Integer, Boundary) -- ^ lower bound and whether it is included+  -> (Extended Integer, Boundary) -- ^ upper bound and whether it is included   -> IntegerInterval interval (x1,in1) (x2,in2) =-  (if in1 then x1 else x1 + 1) <=..<= (if in2 then x2 else x2 - 1)+  (if in1 == Closed then x1 else x1 + 1) <=..<= (if in2 == Closed then x2 else x2 - 1)  -- | left-open right-closed interval (@l@,@u@] (<..<=)@@ -215,7 +218,7 @@ whole :: IntegerInterval whole = NegInf <=..<= PosInf --- | singleton set \[x,x\]+-- | singleton set [x,x] singleton :: Integer -> IntegerInterval singleton x = Finite x <=..<= Finite x @@ -248,6 +251,9 @@ null :: IntegerInterval -> Bool null x = upperBound x < lowerBound x +-- | Is the interval single point?+--+-- @since 2.0.0 isSingleton :: IntegerInterval -> Bool isSingleton x = lowerBound x == upperBound x @@ -292,7 +298,7 @@ -- -- * @'abs' y <= 'abs' y'@ ----- (see also 'approxRational' and 'Interval.simplestRationalWithin')+-- (see also 'Data.Ratio.approxRational' and 'Interval.simplestRationalWithin') simplestIntegerWithin :: IntegerInterval -> Maybe Integer simplestIntegerWithin i   | null i    = Nothing@@ -385,9 +391,9 @@     then f a b     else liftM (\(y,x) -> (x,y)) $ f b a   where-    f a b = do-      x <- pickup a-      y <- msum [pickup (b `intersection` c) | c <- [-inf <..< Finite x, Finite x <..< inf]]+    f i j = do+      x <- pickup i+      y <- msum [pickup (j `intersection` c) | c <- [-inf <..< Finite x, Finite x <..< inf]]       return (x,y)  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@?@@ -460,10 +466,16 @@  -- | Conversion from 'Interval.Interval' data type. fromInterval :: Interval.Interval Integer -> IntegerInterval-fromInterval i = (if in1 then x1 else x1 + 1) <=..<= (if in2 then x2 else x2 - 1)+fromInterval i = x1' <=..<= x2'   where     (x1,in1) = Interval.lowerBound' i     (x2,in2) = Interval.upperBound' i+    x1' = case in1 of+      Interval.Open   -> x1 + 1+      Interval.Closed -> x1+    x2' = case in2 of+      Interval.Open   -> x2 - 1+      Interval.Closed -> x2  -- | Given a 'Interval.Interval' @I@ over R, compute the smallest 'IntegerInterval' @J@ such that @I ⊆ J@. fromIntervalOver :: RealFrac r => Interval.Interval r -> IntegerInterval

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE CPP, DeriveDataTypeable #-}+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, LambdaCase #-} {-# LANGUAGE Safe #-} #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-}@@ -17,12 +17,19 @@ import Data.Data import Data.ExtendedReal import Data.Hashable+import GHC.Generics (Generic)  infix 5 <=..<=  -- | The intervals (/i.e./ connected and convex subsets) over integers (__Z__).-data IntegerInterval = Interval !(Extended Integer) !(Extended Integer)-  deriving (Eq, Typeable)+data IntegerInterval+  = Whole+  | Empty+  | Point !Integer+  | LessOrEqual !Integer+  | GreaterOrEqual !Integer+  | BothClosed !Integer !Integer+  deriving (Eq, Generic, Typeable)  -- | Lower endpoint (/i.e./ greatest lower bound)  of the interval. --@@ -32,7 +39,13 @@ -- -- * 'lowerBound' of an interval may or may not be a member of the interval. lowerBound :: IntegerInterval -> Extended Integer-lowerBound (Interval lb _) = lb+lowerBound = \case+  Whole            -> NegInf+  Empty            -> PosInf+  Point r          -> Finite r+  LessOrEqual _    -> NegInf+  GreaterOrEqual r -> Finite r+  BothClosed p _   -> Finite p  -- | Upper endpoint (/i.e./ least upper bound) of the interval. --@@ -42,7 +55,13 @@ -- -- * 'upperBound' of an interval is a member of the interval. upperBound :: IntegerInterval -> Extended Integer-upperBound (Interval _ ub) = ub+upperBound = \case+  Whole            -> PosInf+  Empty            -> NegInf+  Point r          -> Finite r+  LessOrEqual r    -> Finite r+  GreaterOrEqual _ -> PosInf+  BothClosed _ p   -> Finite p  -- This instance preserves data abstraction at the cost of inefficiency. -- We provide limited reflection services for the sake of data abstraction.@@ -61,11 +80,9 @@ intervalDataType :: DataType intervalDataType = mkDataType "Data.IntegerInterval.Internal.IntegerInterval" [intervalConstr] -instance NFData IntegerInterval where-  rnf (Interval lb ub) = rnf lb `seq` rnf ub+instance NFData IntegerInterval -instance Hashable IntegerInterval where-  hashWithSalt s (Interval lb ub) = s `hashWithSalt` lb `hashWithSalt` ub+instance Hashable IntegerInterval  -- | closed interval [@l@,@u@] (<=..<=)@@ -74,10 +91,16 @@   -> IntegerInterval (<=..<=) PosInf _ = empty (<=..<=) _ NegInf = empty-(<=..<=) lb ub-  | lb <= ub  = Interval lb ub-  | otherwise = empty+(<=..<=) NegInf PosInf = Whole+(<=..<=) NegInf (Finite ub) = LessOrEqual ub+(<=..<=) (Finite lb) PosInf = GreaterOrEqual lb+(<=..<=) (Finite lb) (Finite ub) =+  case compare lb ub of+    EQ -> Point lb+    LT -> BothClosed lb ub+    GT -> Empty+{-# INLINE (<=..<=) #-}  -- | empty (contradicting) interval empty :: IntegerInterval-empty = Interval PosInf NegInf+empty = Empty

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}-{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables #-} {-# LANGUAGE Safe #-} #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-}@@ -30,7 +30,7 @@   -- * Interval type     Interval   , module Data.ExtendedReal-  , EndPoint+  , Boundary(..)    -- * Construction   , interval@@ -44,6 +44,7 @@    -- * Query   , null+  , isSingleton   , member   , notMember   , isSubsetOf@@ -154,7 +155,10 @@     where       (lb, in1) = lowerBound' i       (ub, in2) = upperBound' i-      op = (if in1 then "<=" else "<") ++ ".." ++ (if in2 then "<=" else "<")+      op = sign in1 ++ ".." ++ sign in2+      sign = \case+        Open   -> "<"+        Closed -> "<="  instance (Ord r, Read r) => Read (Interval r) where   readsPrec p r =@@ -206,7 +210,7 @@   => Extended r -- ^ lower bound @l@   -> Extended r -- ^ upper bound @u@   -> Interval r-(<=..<=) lb ub = interval (lb, True) (ub, True)+(<=..<=) lb ub = interval (lb, Closed) (ub, Closed)  -- | left-open right-closed interval (@l@,@u@] (<..<=)@@ -214,7 +218,7 @@   => Extended r -- ^ lower bound @l@   -> Extended r -- ^ upper bound @u@   -> Interval r-(<..<=) lb ub = interval (lb, False) (ub, True)+(<..<=) lb ub = interval (lb, Open) (ub, Closed)  -- | left-closed right-open interval [@l@, @u@) (<=..<)@@ -222,7 +226,7 @@   => Extended r -- ^ lower bound @l@   -> Extended r -- ^ upper bound @u@   -> Interval r-(<=..<) lb ub = interval (lb, True) (ub, False)+(<=..<) lb ub = interval (lb, Closed) (ub, Open)  -- | open interval (@l@, @u@) (<..<)@@ -230,15 +234,15 @@   => Extended r -- ^ lower bound @l@   -> Extended r -- ^ upper bound @u@   -> Interval r-(<..<) lb ub = interval (lb, False) (ub, False)+(<..<) lb ub = interval (lb, Open) (ub, Open)  -- | whole real number line (-∞, ∞) whole :: Ord r => Interval r-whole = interval (NegInf, False) (PosInf, False)+whole = interval (NegInf, Open) (PosInf, Open) --- | singleton set \[x,x\]+-- | singleton set [x,x] singleton :: Ord r => r -> Interval r-singleton x = interval (Finite x, True) (Finite x, True)+singleton x = interval (Finite x, Closed) (Finite x, Closed)  -- | intersection of two intervals intersection :: forall r. Ord r => Interval r -> Interval r -> Interval r@@ -246,19 +250,19 @@   (maxLB (lowerBound' i1) (lowerBound' i2))   (minUB (upperBound' i1) (upperBound' i2))   where-    maxLB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)+    maxLB :: (Extended r, Boundary) -> (Extended r, Boundary) -> (Extended r, Boundary)     maxLB (x1,in1) (x2,in2) =       ( max x1 x2       , case x1 `compare` x2 of-          EQ -> in1 && in2+          EQ -> in1 `min` in2           LT -> in2           GT -> in1       )-    minUB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)+    minUB :: (Extended r, Boundary) -> (Extended r, Boundary) -> (Extended r, Boundary)     minUB (x1,in1) (x2,in2) =       ( min x1 x2       , case x1 `compare` x2 of-          EQ -> in1 && in2+          EQ -> in1 `min` in2           LT -> in1           GT -> in2       )@@ -278,19 +282,19 @@   (minLB (lowerBound' i1) (lowerBound' i2))   (maxUB (upperBound' i1) (upperBound' i2))   where-    maxUB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)+    maxUB :: (Extended r, Boundary) -> (Extended r, Boundary) -> (Extended r, Boundary)     maxUB (x1,in1) (x2,in2) =       ( max x1 x2       , case x1 `compare` x2 of-          EQ -> in1 || in2+          EQ -> in1 `max` in2           LT -> in2           GT -> in1       )-    minLB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)+    minLB :: (Extended r, Boundary) -> (Extended r, Boundary) -> (Extended r, Boundary)     minLB (x1,in1) (x2,in2) =       ( min x1 x2       , case x1 `compare` x2 of-          EQ -> in1 || in2+          EQ -> in1 `max` in2           LT -> in1           GT -> in2       )@@ -305,16 +309,19 @@ null :: Ord r => Interval r -> Bool null i =   case x1 `compare` x2 of-    EQ -> assert (in1 && in2) False+    EQ -> assert (in1 == Closed && in2 == Closed) False     LT -> False     GT -> True   where     (x1, in1) = lowerBound' i     (x2, in2) = upperBound' i +-- | Is the interval single point?+--+-- @since 2.0.0 isSingleton :: Ord r => Interval r -> Bool isSingleton i = case (lowerBound' i, upperBound' i) of-  ((Finite l, True), (Finite u, True)) -> l==u+  ((Finite l, Closed), (Finite u, Closed)) -> l==u   _ -> False  -- | Is the element in the interval?@@ -323,8 +330,12 @@   where     (x1, in1) = lowerBound' i     (x2, in2) = upperBound' i-    condLB = if in1 then x1 <= Finite x else x1 < Finite x-    condUB = if in2 then Finite x <= x2 else Finite x < x2+    condLB = case in1 of+      Open   -> x1 <  Finite x+      Closed -> x1 <= Finite x+    condUB = case in2 of+      Open   -> Finite x <  x2+      Closed -> Finite x <= x2  -- | Is the element not in the interval? notMember :: Ord r => r -> Interval r -> Bool@@ -339,12 +350,12 @@       case x1 `compare` x2 of         GT -> True         LT -> False-        EQ -> not in1 || in2 -- in1 => in2+        EQ -> in1 <= in2     testUB (x1,in1) (x2,in2) =       case x1 `compare` x2 of         LT -> True         GT -> False-        EQ -> not in1 || in2 -- in1 => in2+        EQ -> in1 <= in2  -- | Is this a proper subset? (/i.e./ a subset but not equal). isProperSubsetOf :: Ord r => Interval r -> Interval r -> Bool@@ -357,7 +368,7 @@ isConnected x y   | null x = True   | null y = True-  | otherwise = x ==? y || (lb1==ub2 && (lb1in || ub2in)) || (ub1==lb2 && (ub1in || lb2in))+  | otherwise = x ==? y || (lb1==ub2 && (lb1in == Closed || ub2in == Closed)) || (ub1==lb2 && (ub1in == Closed || lb2in == Closed))   where     (lb1,lb1in) = lowerBound' x     (lb2,lb2in) = lowerBound' y@@ -376,13 +387,17 @@ pickup :: (Real r, Fractional r) => Interval r -> Maybe r pickup i = case (lowerBound' i, upperBound' i) of   ((NegInf,_), (PosInf,_))             -> Just 0-  ((Finite x1, in1), (PosInf,_))       -> Just $ if in1 then x1 else x1+1-  ((NegInf,_), (Finite x2, in2))       -> Just $ if in2 then x2 else x2-1+  ((Finite x1, in1), (PosInf,_))       -> Just $ case in1 of+    Open   -> x1 + 1+    Closed -> x1+  ((NegInf,_), (Finite x2, in2))       -> Just $ case in2 of+    Open   -> x2 - 1+    Closed -> x2   ((Finite x1, in1), (Finite x2, in2)) ->     case x1 `compare` x2 of       GT -> Nothing       LT -> Just $ (x1+x2) / 2-      EQ -> if in1 && in2 then Just x1 else Nothing+      EQ -> if in1 == Closed && in2 == Closed then Just x1 else Nothing   _ -> Nothing  -- | 'simplestRationalWithin' returns the simplest rational number within the interval.@@ -403,12 +418,12 @@   | i <! 0    = Just $ - go (- i)   | otherwise = assert (0 `member` i) $ Just 0   where-    go i-      | fromInteger lb_floor       `member` i = fromInteger lb_floor-      | fromInteger (lb_floor + 1) `member` i = fromInteger (lb_floor + 1)-      | otherwise = fromInteger lb_floor + recip (go (recip (i - singleton (fromInteger lb_floor))))+    go j+      | fromInteger lb_floor       `member` j = fromInteger lb_floor+      | fromInteger (lb_floor + 1) `member` j = fromInteger (lb_floor + 1)+      | otherwise = fromInteger lb_floor + recip (go (recip (j - singleton (fromInteger lb_floor))))       where-        Finite lb = lowerBound i+        Finite lb = lowerBound j         lb_floor  = floor lb  -- | @mapMonotonic f i@ is the image of @i@ under @f@, where @f@ must be a strict monotone function.@@ -428,7 +443,7 @@       case ub_a of         NegInf   -> True -- a is empty, so it holds vacuously         PosInf   -> True -- b is empty, so it holds vacuously-        Finite _ -> not (in1 && in2)+        Finite _ -> in1 == Open || in2 == Open   where     (ub_a, in1) = upperBound' a     (lb_b, in2) = lowerBound' b@@ -491,7 +506,7 @@       case lb_a of         NegInf -> False -- b is empty         PosInf -> False -- a is empty-        Finite _ -> in1 && in2+        Finite _ -> in1 == Closed && in2 == Closed   where     (lb_a, in1) = lowerBound' a     (ub_b, in2) = upperBound' b@@ -541,9 +556,9 @@     then f a b     else liftM (\(y,x) -> (x,y)) $ f b a   where-    f a b = do-      x <- pickup a-      y <- msum [pickup (b `intersection` c) | c <- [-inf <..< Finite x, Finite x <..< inf]]+    f i j = do+      x <- pickup i+      y <- msum [pickup (j `intersection` c) | c <- [-inf <..< Finite x, Finite x <..< inf]]       return (x,y)  -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@?@@ -588,14 +603,14 @@     | null a || null b = empty     | otherwise = interval (f (lowerBound' a) (lowerBound' b)) (g (upperBound' a) (upperBound' b))     where-      f (Finite x1, in1) (Finite x2, in2) = (Finite (x1+x2), in1 && in2)-      f (NegInf,_) _ = (-inf, False)-      f _ (NegInf,_) = (-inf, False)+      f (Finite x1, in1) (Finite x2, in2) = (Finite (x1+x2), in1 `min` in2)+      f (NegInf,_) _ = (-inf, Open)+      f _ (NegInf,_) = (-inf, Open)       f _ _ = error "Interval.(+) should not happen" -      g (Finite x1, in1) (Finite x2, in2) = (Finite (x1+x2), in1 && in2)-      g (PosInf,_) _ = (inf, False)-      g _ (PosInf,_) = (inf, False)+      g (Finite x1, in1) (Finite x2, in2) = (Finite (x1+x2), in1 `min` in2)+      g (PosInf,_) _ = (inf, Open)+      g _ (PosInf,_) = (inf, Open)       g _ _ = error "Interval.(+) should not happen"    negate = scaleInterval (-1)@@ -635,15 +650,11 @@       lb3 = minimumBy cmpLB xs       xs = [recipLB (lowerBound' a), recipUB (upperBound' a)] -cmpUB, cmpLB :: Ord r => (Extended r, Bool) -> (Extended r, Bool) -> Ordering+cmpUB, cmpLB :: Ord r => (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering cmpUB (x1,in1) (x2,in2) = compare x1 x2 `mappend` compare in1 in2 cmpLB (x1,in1) (x2,in2) = compare x1 x2 `mappend` compare in2 in1 -{-# DEPRECATED EndPoint "EndPoint is deprecated. Please use Extended instead." #-}--- | Endpoints of intervals-type EndPoint r = Extended r--scaleInf' :: (Num r, Ord r) => r -> (Extended r, Bool) -> (Extended r, Bool)+scaleInf' :: (Num r, Ord r) => r -> (Extended r, Boundary) -> (Extended r, Boundary) scaleInf' a (x1, in1) = (scaleEndPoint a x1, in1)  scaleEndPoint :: (Num r, Ord r) => r -> Extended r -> Extended r@@ -661,15 +672,15 @@         Finite b -> Finite (a*b)         PosInf   -> NegInf -mulInf' :: (Num r, Ord r) => (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)-mulInf' (0, True) _ = (0, True)-mulInf' _ (0, True) = (0, True)-mulInf' (x1,in1) (x2,in2) = (x1*x2, in1 && in2)+mulInf' :: (Num r, Ord r) => (Extended r, Boundary) -> (Extended r, Boundary) -> (Extended r, Boundary)+mulInf' (0, Closed) _ = (0, Closed)+mulInf' _ (0, Closed) = (0, Closed)+mulInf' (x1,in1) (x2,in2) = (x1*x2, in1 `min` in2) -recipLB :: (Fractional r, Ord r) => (Extended r, Bool) -> (Extended r, Bool)-recipLB (0, _) = (PosInf, False)+recipLB :: (Fractional r, Ord r) => (Extended r, Boundary) -> (Extended r, Boundary)+recipLB (0, _) = (PosInf, Open) recipLB (x1, in1) = (recip x1, in1) -recipUB :: (Fractional r, Ord r) => (Extended r, Bool) -> (Extended r, Bool)-recipUB (0, _) = (NegInf, False)+recipUB :: (Fractional r, Ord r) => (Extended r, Boundary) -> (Extended r, Boundary)+recipUB (0, _) = (NegInf, Open) recipUB (x1, in1) = (recip x1, in1)

@@ -1,12 +1,13 @@ {-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE CPP, DeriveDataTypeable #-}+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, LambdaCase #-} {-# LANGUAGE Safe #-} #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-} #endif  module Data.Interval.Internal-  ( Interval+  ( Boundary(..)+  , Interval   , lowerBound'   , upperBound'   , interval@@ -17,17 +18,70 @@ import Data.Data import Data.ExtendedReal import Data.Hashable+import GHC.Generics (Generic) +-- | Boundary of an interval may be+-- open (excluding an endpoint) or closed (including an endpoint).+--+-- @since 2.0.0+data Boundary+  = Open+  | Closed+  deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data, Typeable)++instance NFData Boundary++instance Hashable Boundary+ -- | The intervals (/i.e./ connected and convex subsets) over real numbers __R__.-data Interval r = Interval-  { -- | 'lowerBound' of the interval and whether it is included in the interval.-    -- The result is convenient to use as an argument for 'interval'.-    lowerBound' :: !(Extended r, Bool)-  , -- | 'upperBound' of the interval and whether it is included in the interval.-    -- The result is convenient to use as an argument for 'interval'.-    upperBound' :: !(Extended r, Bool)-  } deriving (Eq, Typeable)+data Interval r+  = Whole+  | Empty+  | Point !r+  | LessThan !r+  | LessOrEqual !r+  | GreaterThan !r+  | GreaterOrEqual !r+  | BothClosed !r !r+  | LeftOpen !r !r+  | RightOpen !r !r+  | BothOpen !r !r+  deriving (Eq, Generic, Typeable) +-- | Lower endpoint (/i.e./ greatest lower bound) of the interval,+-- together with 'Boundary' information.+-- The result is convenient to use as an argument for 'interval'.+lowerBound' :: Interval r -> (Extended r, Boundary)+lowerBound' = \case+  Whole            -> (NegInf,   Open)+  Empty            -> (PosInf,   Open)+  Point r          -> (Finite r, Closed)+  LessThan{}       -> (NegInf,   Open)+  LessOrEqual{}    -> (NegInf,   Open)+  GreaterThan r    -> (Finite r, Open)+  GreaterOrEqual r -> (Finite r, Closed)+  BothClosed p _   -> (Finite p, Closed)+  LeftOpen p _     -> (Finite p, Open)+  RightOpen p _    -> (Finite p, Closed)+  BothOpen p _     -> (Finite p, Open)++-- | Upper endpoint (/i.e./ least upper bound) of the interval,+-- together with 'Boundary' information.+-- The result is convenient to use as an argument for 'interval'.+upperBound' :: Interval r -> (Extended r, Boundary)+upperBound' = \case+  Whole            -> (PosInf,   Open)+  Empty            -> (NegInf,   Open)+  Point r          -> (Finite r, Closed)+  LessThan r       -> (Finite r, Open)+  LessOrEqual r    -> (Finite r, Closed)+  GreaterThan{}    -> (PosInf,   Open)+  GreaterOrEqual{} -> (PosInf,   Open)+  BothClosed _ q   -> (Finite q, Closed)+  LeftOpen _ q     -> (Finite q, Closed)+  RightOpen _ q    -> (Finite q, Open)+  BothOpen _ q     -> (Finite q, Open)+ #if __GLASGOW_HASKELL__ >= 708 type role Interval nominal #endif@@ -47,28 +101,44 @@ intervalDataType :: DataType intervalDataType = mkDataType "Data.Interval.Internal.Interval" [intervalConstr] -instance NFData r => NFData (Interval r) where-  rnf (Interval lb ub) = rnf lb `seq` rnf ub+instance NFData r => NFData (Interval r) -instance Hashable r => Hashable (Interval r) where-  hashWithSalt s (Interval lb ub) = s `hashWithSalt` lb `hashWithSalt` ub+instance Hashable r => Hashable (Interval r)  -- | empty (contradicting) interval empty :: Ord r => Interval r-empty = Interval (PosInf, False) (NegInf, False)+empty = Empty  -- | smart constructor for 'Interval' interval   :: (Ord r)-  => (Extended r, Bool) -- ^ lower bound and whether it is included-  -> (Extended r, Bool) -- ^ upper bound and whether it is included+  => (Extended r, Boundary) -- ^ lower bound and whether it is included+  -> (Extended r, Boundary) -- ^ upper bound and whether it is included   -> Interval r-interval lb@(x1,in1) ub@(x2,in2) =-  case x1 `compare` x2 of-    GT -> empty --  empty interval-    LT -> Interval (normalize lb) (normalize ub)-    EQ -> if in1 && in2 && isFinite x1 then Interval lb ub else empty-  where-    normalize x@(Finite _, _) = x-    normalize (x, _) = (x, False)-+interval = \case+  (NegInf, _) -> \case+    (NegInf, _) -> Empty+    (Finite r, Open) -> LessThan r+    (Finite r, Closed) -> LessOrEqual r+    (PosInf, _) -> Whole+  (Finite p, Open) -> \case+    (NegInf, _) -> Empty+    (Finite q, Open)+      | p < q -> BothOpen p q+      | otherwise -> Empty+    (Finite q, Closed)+      | p < q -> LeftOpen p q+      | otherwise -> Empty+    (PosInf, _) -> GreaterThan p+  (Finite p, Closed) -> \case+    (NegInf, _) -> Empty+    (Finite q, Open)+      | p < q -> RightOpen p q+      | otherwise -> Empty+    (Finite q, Closed) -> case p `compare` q of+      LT -> BothClosed p q+      EQ -> Point p+      GT -> Empty+    (PosInf, _) -> GreaterOrEqual p+  (PosInf, _) -> const Empty+{-# INLINE interval #-}

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE CPP, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf, GeneralizedNewtypeDeriving #-} {-# LANGUAGE Trustworthy #-} #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-}@@ -22,7 +22,6 @@   -- * IntervalMap type     IntervalMap (..)   , module Data.ExtendedReal-  , EndPoint    -- * Operators   , (!)@@ -91,26 +90,27 @@   )   where -import Prelude hiding (null, lookup, map, filter, span)-import Control.Applicative hiding (empty)+import Prelude hiding (null, lookup, map, filter, span, and) import Control.DeepSeq-import Control.Monad import Data.Data-import Data.Foldable hiding (null, foldl', and, toList) import Data.ExtendedReal import Data.Hashable-import Data.List (foldl')+import Data.Foldable hiding (null, toList) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe-import Data.Monoid-import Data.Semigroup (Semigroup) import qualified Data.Semigroup as Semigroup-import Data.Traversable-import Data.Interval (Interval, EndPoint)+import Data.Interval (Interval) import qualified Data.Interval as Interval import Data.IntervalSet (IntervalSet) import qualified Data.IntervalSet as IntervalSet+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+import Data.Traversable (Traversable(..))+#endif+#if __GLASGOW_HASKELL__ < 804+import Data.Monoid (Monoid(..))+#endif #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as GHCExts #endif@@ -173,7 +173,7 @@   mappend = union   mconcat = unions -instance Ord k => Semigroup (IntervalMap k a) where+instance Ord k => Semigroup.Semigroup (IntervalMap k a) where   (<>)   = union #if !defined(VERSION_semigroups)   stimes = Semigroup.stimesIdempotentMonoid@@ -194,7 +194,7 @@  -- ------------------------------------------------------------------------ -newtype LB r = LB (Extended r, Bool)+newtype LB r = LB (Extended r, Interval.Boundary)   deriving (Eq, NFData, Typeable)  instance Ord r => Ord (LB r) where@@ -210,7 +210,7 @@ -- | Find the value at a key. Calls 'error' when the element can not be found. (!) :: Ord k => IntervalMap k a -> k -> a IntervalMap m ! k =-  case Map.lookupLE (LB (Finite k, True)) m of+  case Map.lookupLE (LB (Finite k, Interval.Closed)) m of     Just (_, (i, a)) | k `Interval.member` i -> a     _ -> error "IntervalMap.!: given key is not an element in the map" @@ -228,7 +228,7 @@ -- | Is the key a member of the map? See also 'notMember'. member :: Ord k => k -> IntervalMap k a -> Bool member k (IntervalMap m) =-  case Map.lookupLE (LB (Finite k, True)) m of+  case Map.lookupLE (LB (Finite k, Interval.Closed)) m of     Just (_, (i, _)) -> k `Interval.member` i     Nothing -> False @@ -242,7 +242,7 @@ -- or 'Nothing' if the key isn't in the map. lookup :: Ord k => k -> IntervalMap k a -> Maybe a lookup k (IntervalMap m) =-  case Map.lookupLE (LB (Finite k, True)) m of+  case Map.lookupLE (LB (Finite k, Interval.Closed)) m of     Just (_, (i, a)) | k `Interval.member` i -> Just a     _ -> Nothing @@ -251,7 +251,7 @@ -- when the key is not in the map. findWithDefault :: Ord k => a -> k -> IntervalMap k a -> a findWithDefault def k (IntervalMap m) =-  case Map.lookupLE (LB (Finite k, True)) m of+  case Map.lookupLE (LB (Finite k, Interval.Closed)) m of     Just (_, (i, a)) | k `Interval.member` i -> a     _ -> def @@ -312,7 +312,7 @@ -- ------------------------------------------------------------------------ -- Delete/Update --- | Delete an interval and its value from the map. +-- | Delete an interval and its value from the map. -- When the interval does not overlap with the map, the original map is returned. delete :: Ord k => Interval k -> IntervalMap k a -> IntervalMap k a delete i m | Interval.null i = m@@ -324,7 +324,7 @@ -- | Update a value at a specific interval with the result of the provided function. -- When the interval does not overlatp with the map, the original map is returned. adjust :: Ord k => (a -> a) -> Interval k -> IntervalMap k a -> IntervalMap k a-adjust f = update (Just . f)  +adjust f = update (Just . f)  -- | The expression (@'update' f i map@) updates the value @x@ -- at @i@ (if it is in the map). If (@f x@) is 'Nothing', the element is@@ -334,7 +334,7 @@ update f i m =   case split i m of     (IntervalMap m1, IntervalMap m2, IntervalMap m3) ->-      IntervalMap $ Map.unions [m1, Map.mapMaybe (\(i,a) -> (\b -> (i,b)) <$> f a) m2, m3]+      IntervalMap $ Map.unions [m1, Map.mapMaybe (\(j,a) -> (\b -> (j,b)) <$> f a) m2, m3]  -- | The expression (@'alter' f i map@) alters the value @x@ at @i@, or absence thereof. -- 'alter' can be used to insert, delete, or update a value in a 'IntervalMap'.@@ -357,12 +357,12 @@ -- | The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. -- It prefers @t1@ when overlapping keys are encountered, union :: Ord k => IntervalMap k a -> IntervalMap k a -> IntervalMap k a-union m1 m2 = +union m1 m2 =   foldl' (\m (i,a) -> insert i a m) m2 (toList m1)  -- | Union with a combining function. unionWith :: Ord k => (a -> a -> a) -> IntervalMap k a -> IntervalMap k a -> IntervalMap k a-unionWith f m1 m2 = +unionWith f m1 m2 =   foldl' (\m (i,a) -> insertWith f i a m) m2 (toList m1)  -- | The union of a list of maps:@@ -385,19 +385,19 @@ intersection = intersectionWith const  -- | Intersection with a combining function.-intersectionWith :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c +intersectionWith :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c intersectionWith f im1@(IntervalMap m1) im2@(IntervalMap m2)   | Map.size m1 >= Map.size m2 = g f im1 im2   | otherwise = g (flip f) im2 im1   where-    g :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c -    g f im1 (IntervalMap m2) = IntervalMap $ Map.unions $ go im1 (Map.elems m2)+    g :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c+    g h jm1 (IntervalMap m3) = IntervalMap $ Map.unions $ go jm1 (Map.elems m3)       where         go _ [] = []         go im ((i,b) : xs) =           case split i im of-            (_, IntervalMap m, im2) ->-              Map.map (\(j, a) -> (j, f a b)) m : go im2 xs+            (_, IntervalMap m, jm2) ->+              Map.map (\(j, a) -> (j, h a b)) m : go jm2 xs  -- ------------------------------------------------------------------------ -- Traversal@@ -415,7 +415,7 @@ map :: (a -> b) -> IntervalMap k a -> IntervalMap k b map f (IntervalMap m) = IntervalMap $ Map.map (\(i, a) -> (i, f a)) m --- | @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.+-- | @'mapKeysMonotonic' f s@ is the map obtained by applying @f@ to each key of @s@. -- @f@ must be strictly monotonic. -- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@. mapKeysMonotonic :: forall k1 k2 a. (Ord k1, Ord k2) => (k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a@@ -435,7 +435,7 @@ keys (IntervalMap m) = [i | (i,_) <- Map.elems m]  -- | An alias for 'toAscList'. Return all key\/value pairs in the map--- in ascending key order. +-- in ascending key order. assocs :: IntervalMap k a -> [(Interval k, a)] assocs = toAscList @@ -443,15 +443,15 @@ keysSet :: Ord k => IntervalMap k a -> IntervalSet k keysSet (IntervalMap m) = IntervalSet.fromAscList [i | (i,_) <- Map.elems m] --- | Convert the map to a list of key\/value pairs. +-- | Convert the map to a list of key\/value pairs. toList :: IntervalMap k a -> [(Interval k, a)] toList = toAscList --- | Convert the map to a list of key/value pairs where the keys are in ascending order. +-- | Convert the map to a list of key/value pairs where the keys are in ascending order. toAscList :: IntervalMap k a -> [(Interval k, a)] toAscList (IntervalMap m) = Map.elems m --- | Convert the map to a list of key/value pairs where the keys are in descending order. +-- | Convert the map to a list of key/value pairs where the keys are in descending order. toDescList :: IntervalMap k a -> [(Interval k, a)] toDescList (IntervalMap m) = fmap snd $ Map.toDescList m @@ -477,8 +477,8 @@ split :: Ord k => Interval k -> IntervalMap k a -> (IntervalMap k a, IntervalMap k a, IntervalMap k a) split i (IntervalMap m) =   case splitLookupLE (LB (Interval.lowerBound' i)) m of-    (smaller, m1, xs) -> -      case splitLookupLE (LB (Interval.upperBound i, True)) xs of+    (smaller, m1, xs) ->+      case splitLookupLE (LB (Interval.upperBound i, Interval.Closed)) xs of         (middle, m2, larger) ->           ( IntervalMap $               case m1 of@@ -500,7 +500,7 @@               , let k = Interval.intersection (downTo i) j               , not (Interval.null k)               ]-          ) +          )  -- ------------------------------------------------------------------------ -- Submap@@ -511,7 +511,7 @@  -- |  The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if -- all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when--- applied to their respective values. +-- applied to their respective values. isSubmapOfBy :: Ord k => (a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool isSubmapOfBy f m1 m2 = and $   [ case lookupInterval i m2 of@@ -551,7 +551,7 @@     (NegInf, _) -> Interval.empty     (PosInf, _) -> Interval.whole     (Finite lb, incl) ->-      Interval.interval (NegInf,False) (Finite lb, not incl)+      Interval.interval (NegInf, Interval.Open) (Finite lb, notB incl)  downTo :: Ord r => Interval r -> Interval r downTo i =@@ -559,4 +559,9 @@     (PosInf, _) -> Interval.empty     (NegInf, _) -> Interval.whole     (Finite ub, incl) ->-      Interval.interval (Finite ub, not incl) (PosInf,False)+      Interval.interval (Finite ub, notB incl) (PosInf, Interval.Open)++notB :: Interval.Boundary -> Interval.Boundary+notB = \case+  Interval.Open   -> Interval.Closed+  Interval.Closed -> Interval.Open

@@ -33,7 +33,6 @@   -- * IntervalMap type     IntervalMap   , module Data.ExtendedReal-  , EndPoint    -- * Operators   , (!)

@@ -34,7 +34,6 @@   -- * IntervalMap type     IntervalMap   , module Data.ExtendedReal-  , EndPoint    -- * Operators   , (!)@@ -105,9 +104,8 @@   import Prelude hiding (null, lookup, map, filter, span)-import Control.Applicative hiding (empty) import Data.ExtendedReal-import Data.Interval (Interval, EndPoint)+import Data.Interval (Interval) import qualified Data.Interval as Interval import Data.IntervalMap.Base hiding   ( whole@@ -128,6 +126,9 @@ import qualified Data.IntervalSet as IntervalSet import Data.List (foldl') import qualified Data.Map.Strict as Map+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif  -- $strictness --@@ -185,7 +186,7 @@ update f i m =   case split i m of     (IntervalMap m1, IntervalMap m2, IntervalMap m3) ->-      IntervalMap $ Map.unions [m1, Map.mapMaybe (\(i,a) -> (\b -> seq b (i,b)) <$> f a) m2, m3]+      IntervalMap $ Map.unions [m1, Map.mapMaybe (\(j,a) -> (\b -> seq b (j,b)) <$> f a) m2, m3]  -- | The expression (@'alter' f i map@) alters the value @x@ at @i@, or absence thereof. -- 'alter' can be used to insert, delete, or update a value in a 'IntervalMap'.@@ -207,7 +208,7 @@  -- | Union with a combining function. unionWith :: Ord k => (a -> a -> a) -> IntervalMap k a -> IntervalMap k a -> IntervalMap k a-unionWith f m1 m2 = +unionWith f m1 m2 =   foldl' (\m (i,a) -> insertWith f i a m) m2 (toList m1)  -- | The union of a list of maps, with a combining operation:@@ -216,19 +217,19 @@ unionsWith f = foldl' (unionWith f) empty  -- | Intersection with a combining function.-intersectionWith :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c +intersectionWith :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c intersectionWith f im1@(IntervalMap m1) im2@(IntervalMap m2)   | Map.size m1 >= Map.size m2 = g f im1 im2   | otherwise = g (flip f) im2 im1   where-    g :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c -    g f im1 (IntervalMap m2) = IntervalMap $ Map.unions $ go im1 (Map.elems m2)+    g :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c+    g h jm1 (IntervalMap m3) = IntervalMap $ Map.unions $ go jm1 (Map.elems m3)       where         go _ [] = []         go im ((i,b) : xs) =           case split i im of-            (_, IntervalMap m, im2) ->-              Map.map (\(j, a) -> (j,) $! f a b) m : go im2 xs+            (_, IntervalMap m, jm2) ->+              Map.map (\(j, a) -> (j,) $! h a b) m : go jm2 xs  -- ------------------------------------------------------------------------ -- Traversal

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE CPP, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf #-}+{-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf #-} {-# LANGUAGE Trustworthy #-} #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-}@@ -22,7 +22,6 @@   -- * IntervalSet type     IntervalSet   , module Data.ExtendedReal-  , EndPoint    -- * Construction   , whole@@ -73,11 +72,12 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe-import Data.Monoid-import Data.Semigroup (Semigroup) import qualified Data.Semigroup as Semigroup-import Data.Interval (Interval, EndPoint)+import Data.Interval (Interval, Boundary(..)) import qualified Data.Interval as Interval+#if __GLASGOW_HASKELL__ < 804+import Data.Monoid (Monoid(..))+#endif #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as GHCExts #endif@@ -168,7 +168,7 @@   mappend = union   mconcat = unions -instance (Ord r) => Semigroup (IntervalSet r) where+instance (Ord r) => Semigroup.Semigroup (IntervalSet r) where   (<>)    = union #if !defined(VERSION_semigroups)   stimes  = Semigroup.stimesIdempotentMonoid@@ -289,13 +289,13 @@  -- | Complement the interval set. complement :: Ord r => IntervalSet r -> IntervalSet r-complement (IntervalSet m) = fromAscList $ f (NegInf,False) (Map.elems m)+complement (IntervalSet m) = fromAscList $ f (NegInf,Open) (Map.elems m)   where-    f prev [] = [ Interval.interval prev (PosInf,False) ]+    f prev [] = [ Interval.interval prev (PosInf,Open) ]     f prev (i : is) =       case (Interval.lowerBound' i, Interval.upperBound' i) of         ((lb, in1), (ub, in2)) ->-          Interval.interval prev (lb, not in1) : f (ub, not in2) is+          Interval.interval prev (lb, notB in1) : f (ub, notB in2) is  -- | Insert a new interval into the interval set. insert :: Ord r => Interval r -> IntervalSet r -> IntervalSet r@@ -365,7 +365,7 @@ fromList :: Ord r => [Interval r] -> IntervalSet r fromList = IntervalSet . fromAscList' . sortBy (compareLB `on` Interval.lowerBound') --- | Build a map from an ascending list of intervals. +-- | Build a map from an ascending list of intervals. -- /The precondition is not checked./ fromAscList :: Ord r => [Interval r] -> IntervalSet r fromAscList = IntervalSet . fromAscList'@@ -416,7 +416,7 @@         Nothing -> (smaller, Nothing, larger) -} -compareLB :: Ord r => (Extended r, Bool) -> (Extended r, Bool) -> Ordering+compareLB :: Ord r => (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering compareLB (lb1, lb1in) (lb2, lb2in) =   -- inclusive lower endpoint shuold be considered smaller   (lb1 `compare` lb2) `mappend` (lb2in `compare` lb1in)@@ -427,7 +427,7 @@     (NegInf, _) -> Interval.empty     (PosInf, _) -> Interval.whole     (Finite lb, incl) ->-      Interval.interval (NegInf,False) (Finite lb, not incl)+      Interval.interval (NegInf, Open) (Finite lb, notB incl)  downTo :: Ord r => Interval r -> Interval r downTo i =@@ -435,4 +435,9 @@     (PosInf, _) -> Interval.empty     (NegInf, _) -> Interval.whole     (Finite ub, incl) ->-      Interval.interval (Finite ub, not incl) (PosInf,False)+      Interval.interval (Finite ub, notB incl) (PosInf, Open)++notB :: Boundary -> Boundary+notB = \case+  Open   -> Closed+  Closed -> Open

@@ -692,7 +692,7 @@     i == read (show i)  case_read_old =-  read "interval (Finite 0, True) (PosInf, False)" @?= IntegerInterval.interval (Finite 0, True) (PosInf, False)+  read "interval (Finite 0, Closed) (PosInf, Open)" @?= IntegerInterval.interval (Finite 0, Interval.Closed) (PosInf, Interval.Open)  {--------------------------------------------------------------------   NFData@@ -763,6 +763,9 @@ {--------------------------------------------------------------------   Generators --------------------------------------------------------------------}++instance Arbitrary Interval.Boundary where+  arbitrary = arbitraryBoundedEnum  instance Arbitrary r => Arbitrary (Extended r) where   arbitrary =

@@ -778,8 +778,8 @@     i == read (show i)  case_read_old =-  read "interval (Finite (0 % 1), True) (PosInf, False)" @?= -  (Interval.interval (Finite 0, True) (PosInf, False) :: Interval Rational)+  read "interval (Finite (0 % 1), Closed) (PosInf, Open)" @?=+  (Interval.interval (Finite 0, Interval.Closed) (PosInf, Interval.Open) :: Interval Rational)  {--------------------------------------------------------------------   NFData@@ -812,6 +812,9 @@ {--------------------------------------------------------------------   Generators --------------------------------------------------------------------}++instance Arbitrary Interval.Boundary where+  arbitrary = arbitraryBoundedEnum  instance Arbitrary r => Arbitrary (Extended r) where   arbitrary =

@@ -1,8 +1,7 @@ {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}+{-# LANGUAGE CPP, TemplateHaskell, ScopedTypeVariables #-} module TestIntervalMap (intervalMapTestGroup) where -import Control.Applicative ((<$>)) import Control.DeepSeq import Control.Exception (evaluate) import Control.Monad@@ -11,12 +10,18 @@ import Data.Generics.Schemes import Data.Hashable import Data.Maybe-import Data.Monoid-import Data.Traversable+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+import Data.Traversable (Traversable(..))+#endif+#if __GLASGOW_HASKELL__ < 804+import Data.Semigroup ((<>))+#endif import Data.Typeable  import Test.ChasingBottoms.IsBottom import Test.QuickCheck.Function+import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.HUnit import Test.Tasty.TH@@ -32,14 +37,17 @@   empty --------------------------------------------------------------------} +prop_empty_is_bottom :: Property prop_empty_is_bottom =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     IML.isSubmapOf IML.empty a +prop_null_empty :: Property prop_null_empty =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     IML.null a == (a == IML.empty) +case_null_empty :: Assertion case_null_empty =   IML.null (IML.empty :: IntervalMap Rational Integer) @?= True @@ -47,17 +55,21 @@   whole --------------------------------------------------------------------} +case_nonnull_whole :: Assertion case_nonnull_whole =   IML.null (IML.whole 0 :: IntervalMap Rational Integer) @?= False +prop_whole_Lazy_Strict :: Property prop_whole_Lazy_Strict = do   forAll arbitrary $ \(a :: Integer) ->     (IML.whole a :: IntervalMap Rational Integer) == IMS.whole a +case_whole_nonstrict :: Assertion case_whole_nonstrict = do   _ <- evaluate (IML.whole bottom :: IntervalMap Rational Integer)   return () +case_whole_strict :: Assertion case_whole_strict =   isBottom (IMS.whole bottom :: IntervalMap Rational Integer) @?= True @@ -65,20 +77,24 @@   singleton --------------------------------------------------------------------} +prop_singleton_insert :: Property prop_singleton_insert = do   forAll arbitrary $ \(i :: Interval Rational) ->     forAll arbitrary $ \(a :: Integer) ->       IML.singleton i a == IML.insert i a IML.empty +prop_singleton_Lazy_Strict :: Property prop_singleton_Lazy_Strict = do   forAll arbitrary $ \(i :: Interval Rational) ->     forAll arbitrary $ \(a :: Integer) ->       IML.singleton i a == IMS.singleton i a +case_singleton_nonstrict :: Assertion case_singleton_nonstrict = do   _ <- evaluate (IML.singleton 0 bottom :: IntervalMap Rational Integer)   return () +case_singleton_strict :: Assertion case_singleton_strict =   isBottom (IMS.singleton 0 bottom :: IntervalMap Rational Integer) @?= True @@ -86,16 +102,19 @@   insert --------------------------------------------------------------------} +prop_insert_whole :: Property prop_insert_whole =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \a ->       IML.insert Interval.whole a m == IML.whole a +prop_insert_empty :: Property prop_insert_empty =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \a ->       IML.insert Interval.empty a m == m +prop_insert_comm :: Property prop_insert_comm =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->   forAll arbitrary $ \(i1,a1) ->@@ -104,12 +123,14 @@     ==>     (IML.insert i1 a1 (IML.insert i2 a2 m) == IML.insert i2 a2 (IML.insert i1 a1 m)) +prop_insert_isSubmapOf :: Property prop_insert_isSubmapOf =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \i ->       forAll arbitrary $ \a ->         IML.isSubmapOf (IML.singleton i a) (IML.insert i a m) +prop_insert_member :: Property prop_insert_member =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \i ->@@ -118,6 +139,7 @@           Just k -> IML.member k (IML.insert i a m)           Nothing -> True +prop_insert_lookup :: Property prop_insert_lookup =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \i ->@@ -126,6 +148,7 @@           Just k -> IML.lookup k (IML.insert i a m) == Just a           Nothing -> True +prop_insert_bang :: Property prop_insert_bang =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \i ->@@ -134,22 +157,26 @@           Just k -> IML.insert i a m IML.! k == a           Nothing -> True +prop_insert_Lazy_Strict :: Property prop_insert_Lazy_Strict =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \i ->       forAll arbitrary $ \a ->         IML.insert i a m == IMS.insert i a m +prop_insert_nonstrict :: Property prop_insert_nonstrict =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \i ->       IML.insert i bottom m `seq` True +prop_insert_strict :: Property prop_insert_strict =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \i ->       isBottom $ IMS.insert i bottom m +prop_insertWith_Lazy_Strict :: Property prop_insertWith_Lazy_Strict =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \(f :: Fun (Integer,Integer) Integer) ->@@ -157,11 +184,13 @@         forAll arbitrary $ \a ->           IML.insertWith (curry (apply f)) i a m == IMS.insertWith (curry (apply f)) i a m +case_insertWith_nonstrict :: Assertion case_insertWith_nonstrict = evaluate (IML.insertWith (\_ _ -> bottom) (3 <=..< 7) 1 m) >> return ()   where     m :: IntervalMap Rational Integer     m = IML.singleton (0 <=..< 10) 0 +case_insertWith_strict :: Assertion case_insertWith_strict = isBottom (IMS.insertWith (\_ _ -> bottom) (3 <=..< 7) 1 m) @?= True   where     m :: IntervalMap Rational Integer@@ -171,24 +200,29 @@   delete / update --------------------------------------------------------------------} +prop_delete_empty :: Property prop_delete_empty =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->      IML.delete Interval.empty m == m +prop_delete_whole :: Property prop_delete_whole =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->      IML.delete Interval.whole m == IML.empty +prop_delete_from_empty :: Property prop_delete_from_empty =   forAll arbitrary $ \(i :: Interval Rational) ->      IML.delete i (IML.empty :: IntervalMap Rational Integer) == IML.empty +prop_delete_comm :: Property prop_delete_comm =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->   forAll arbitrary $ \i1 ->   forAll arbitrary $ \i2 ->      IML.delete i1 (IML.delete i2 m) == IML.delete i2 (IML.delete i1 m) +prop_delete_notMember :: Property prop_delete_notMember =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \i ->@@ -196,6 +230,7 @@         Just k -> IML.notMember k (IML.delete i m)         Nothing -> True +prop_delete_lookup :: Property prop_delete_lookup =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \i ->@@ -203,6 +238,7 @@         Just k -> IML.lookup k (IML.delete i m) == Nothing         Nothing -> True +case_adjust :: Assertion case_adjust = IML.adjust (+1) (3 <=..< 7) m @?= expected   where     m :: IntervalMap Rational Integer@@ -225,12 +261,14 @@       , (8 <=..< 10, 8)       ] +prop_adjust_Lazy_Strict :: Property prop_adjust_Lazy_Strict =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \(f :: Fun Integer Integer) ->       forAll arbitrary $ \i ->         IML.adjust (apply f) i m == IMS.adjust (apply f) i m +case_asjust_nonstrict :: Assertion case_asjust_nonstrict = do   _ <- evaluate $ IML.adjust (\_ -> bottom) (3 <=..< 7) m   return ()@@ -238,11 +276,13 @@     m :: IntervalMap Rational Integer     m = IML.singleton (0 <=..< 10) 0 +case_asjust_strict :: Assertion case_asjust_strict = isBottom (IMS.adjust (\_ -> bottom) (3 <=..< 7) m) @?= True   where     m :: IntervalMap Rational Integer     m = IMS.singleton (0 <=..< 10) 0 +prop_alter :: Property prop_alter =   forAll arbitrary $ \(m :: IntervalMap Rational Int) ->   forAll arbitrary $ \i ->@@ -252,12 +292,14 @@       Just k ->         IML.lookup k (IML.alter (apply f) i m) == apply f (IML.lookup k m) +prop_alter_Lazy_Strict :: Property prop_alter_Lazy_Strict =   forAll arbitrary $ \(m :: IntervalMap Rational Int) ->   forAll arbitrary $ \i ->   forAll arbitrary $ \f ->     IML.alter (apply f) i m == IMS.alter (apply f) i m +prop_alter_nonstrict :: Property prop_alter_nonstrict =   forAll arbitrary $ \(m :: IntervalMap Rational Int) ->   forAll arbitrary $ \i ->@@ -265,6 +307,7 @@     ==>     (IML.alter (\_ -> Just bottom) i m `seq` True) +prop_alter_strict :: Property prop_alter_strict =   forAll arbitrary $ \(m :: IntervalMap Rational Int) ->   forAll arbitrary $ \i ->@@ -276,60 +319,72 @@   Union --------------------------------------------------------------------} +prop_union_assoc :: Property prop_union_assoc =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->   forAll arbitrary $ \b ->   forAll arbitrary $ \c ->     IML.union a (IML.union b c) == IML.union (IML.union a b) c +prop_union_unitL :: Property prop_union_unitL =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     IML.union IML.empty a == a +prop_union_unitR :: Property prop_union_unitR =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     IML.union a IML.empty == a +prop_union_isSubmapOf :: Property prop_union_isSubmapOf =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->   forAll arbitrary $ \b ->     IML.isSubmapOf a (IML.union a b) +prop_union_isSubmapOf_equiv :: Property prop_union_isSubmapOf_equiv =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->   forAll arbitrary $ \b ->     IML.isSubmapOf (IML.union a b) b     == IML.isSubmapOf a b +case_unions_empty_list :: Assertion case_unions_empty_list =   IML.unions [] @?= (IML.empty :: IntervalMap Rational Integer) +prop_unions_singleton_list :: Property prop_unions_singleton_list =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     IML.unions [a] == a +prop_unions_two_elems :: Property prop_unions_two_elems =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->   forAll arbitrary $ \b ->     IML.unions [a,b] == IML.union a b +case_unionWith :: Assertion case_unionWith = actual @?= expected   where     actual, expected :: IntervalMap Rational Integer     actual = IML.unionWith (+) (IML.singleton (0 <=..<= 10) 1) (IML.singleton (5 <=..<= 15) 2)     expected = IML.fromList [(0 <=..< 5, 1), (5 <=..<= 10, 3), (10 <..<= 15, 2)] +prop_unionWith_Lazy_Strict :: Property prop_unionWith_Lazy_Strict =   forAll arbitrary $ \(a :: IntervalMap Rational Int) ->   forAll arbitrary $ \b ->   forAll arbitrary $ \f ->     IML.unionWith (curry (apply f)) a b == IMS.unionWith (curry (apply f)) a b +prop_unionWith_nonstrict :: Property prop_unionWith_nonstrict =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->   forAll arbitrary $ \b ->     IML.unionWith (\_ _ -> bottom) a b `seq` True +prop_unionWith_strict :: Property prop_unionWith_strict =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->   forAll arbitrary $ \b ->@@ -341,28 +396,33 @@   Intersection --------------------------------------------------------------------} +prop_intersection_isSubmapOf :: Property prop_intersection_isSubmapOf =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     forAll arbitrary $ \b ->       IML.isSubmapOf (IML.intersection a b) a +case_intersectionWith :: Assertion case_intersectionWith = actual @?= expected   where     actual, expected :: IntervalMap Rational Integer     actual = IML.intersectionWith (+) (IML.singleton (0 <=..< 10) 1) (IML.singleton (5 <..<= 5) 1)     expected = IML.singleton (5 <..< 5) 2 +prop_intersectionWith_Lazy_Strict :: Property prop_intersectionWith_Lazy_Strict =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->   forAll arbitrary $ \(b :: IntervalMap Rational Integer) ->   forAll arbitrary $ \(f :: Fun (Integer,Integer) Integer) ->     IML.intersectionWith (curry (apply f)) a b == IMS.intersectionWith (curry (apply f)) a b +prop_intersectionWith_nonstrict :: Property prop_intersectionWith_nonstrict =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->   forAll arbitrary $ \(b :: IntervalMap Rational Integer) ->     IML.intersectionWith (\_ _ -> bottom :: Integer) a b `seq` True +prop_intersectionWith_strict :: Property prop_intersectionWith_strict =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->   forAll arbitrary $ \(b :: IntervalMap Rational Integer) ->@@ -374,6 +434,7 @@   Difference --------------------------------------------------------------------} +prop_difference_isSubmapOf :: Property prop_difference_isSubmapOf =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     forAll arbitrary $ \(b :: IntervalMap Rational Integer) ->@@ -383,15 +444,18 @@   member / lookup --------------------------------------------------------------------} +prop_notMember_empty :: Property prop_notMember_empty =   forAll arbitrary $ \(r::Rational) ->     r `IML.notMember` (IML.empty :: IntervalMap Rational Integer) +case_findWithDefault_case1 :: Assertion case_findWithDefault_case1 = IML.findWithDefault "B" 0 m @?= "A"   where     m :: IntervalMap Rational String     m = IML.singleton (0 <=..<1) "A" +case_findWithDefault_case2 :: Assertion case_findWithDefault_case2 = IML.findWithDefault "B" 1 m @?= "B"   where     m :: IntervalMap Rational String@@ -401,10 +465,12 @@   isSubsetOf --------------------------------------------------------------------} +prop_isSubmapOf_reflexive :: Property prop_isSubmapOf_reflexive =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     a `IML.isSubmapOf` a +prop_isProperSubsetOf_irreflexive :: Property prop_isProperSubsetOf_irreflexive =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     not (a `IML.isProperSubmapOf` a)@@ -413,6 +479,7 @@   span --------------------------------------------------------------------} +prop_span :: Property prop_span =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     IML.span a == IntervalSet.span (IML.keysSet a)@@ -421,21 +488,25 @@   map --------------------------------------------------------------------} +case_mapKeysMonotonic :: Assertion case_mapKeysMonotonic = IML.mapKeysMonotonic (+1) m1 @?= m2   where     m1, m2 :: IntervalMap Rational String     m1 = IML.fromList [(0 <=..< 1, "A"), (2 <..<= 3, "B")]     m2 = IML.fromList [(1 <=..< 2, "A"), (3 <..<= 4, "B")] +prop_map_Lazy_Strict :: Property prop_map_Lazy_Strict =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->   forAll arbitrary $ \(f :: Fun Integer Integer) ->     IML.map (apply f) m == IMS.map (apply f) m +prop_map_nonstrict :: Property prop_map_nonstrict =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     IML.map (const (bottom :: Integer)) a `seq` True +prop_map_strict :: Property prop_map_strict =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     not (IMS.null a)@@ -473,50 +544,60 @@   toList / fromList --------------------------------------------------------------------} +prop_fromList_toList_id :: Property prop_fromList_toList_id =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     IML.fromList (IML.toList a) == a +prop_toAscList_toDescList :: Property prop_toAscList_toDescList =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     IML.toDescList a == reverse (IML.toAscList a) +case_fromList :: Assertion case_fromList = actual @?= expected   where     actual, expected :: IntervalMap Rational Integer     actual = IML.fromList [(0 <=..< 10, 1), (5 <..<= 15, 2)]     expected = IML.fromList [(0 <=..<= 5, 1), (5 <..<= 15, 2)] +case_fromListWith :: Assertion case_fromListWith = actual @?= expected   where     actual, expected :: IntervalMap Rational Integer     actual = IML.fromListWith (+) [(0 <=..< 10, 1), (5 <..<= 15, 2)]     expected = IML.fromList [(0 <=..<= 5, 1), (5 <..< 10, 3), (10 <=..<= 15, 2)] +prop_fromList_Lazy_Strict :: Property prop_fromList_Lazy_Strict =   forAll arbitrary $ \xs ->     (IML.fromList xs :: IntervalMap Rational Integer) == IMS.fromList xs +case_fromList_nonstrict :: Assertion case_fromList_nonstrict = evaluate m >> return ()   where     m :: IntervalMap Rational Integer     m = IML.fromList [(0 <=..< 10, bottom), (5 <..<= 15, bottom)] +case_fromList_strict :: Assertion case_fromList_strict = isBottom m @?= True   where     m :: IntervalMap Rational Integer     m = IMS.fromList [(0 <=..< 10, bottom), (5 <..<= 15, bottom)] +prop_fromListWith_Lazy_Strict :: Property prop_fromListWith_Lazy_Strict =   forAll arbitrary $ \xs ->     forAll arbitrary $ \f ->       (IML.fromListWith (curry (apply f)) xs :: IntervalMap Rational Integer) == IMS.fromListWith (curry (apply f))  xs +case_fromListWith_nonstrict :: Assertion case_fromListWith_nonstrict = evaluate m >> return ()   where     m :: IntervalMap Rational Integer     m = IML.fromListWith (\_ _ -> bottom) [(0 <=..< 10, 1), (5 <..<= 15, 2)] +case_fromListWith_strict :: Assertion case_fromListWith_strict = isBottom m @?= True   where     m :: IntervalMap Rational Integer@@ -526,6 +607,7 @@   Filter --------------------------------------------------------------------} +case_filter :: Assertion case_filter = actual @?= expected   where     m, expected, actual :: IntervalMap Rational Integer@@ -543,6 +625,7 @@       ]     actual = IML.filter even m +prop_split :: Property prop_split =   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->     forAll arbitrary $ \i ->@@ -556,6 +639,7 @@            , and [i <! j | j <- IML.keys m3]            ]) +case_split_case1 :: Assertion case_split_case1 =   IML.split (5 <=..<= 9) m @?= (smaller, middle, larger)   where@@ -581,6 +665,7 @@       , (20 <..<= 30, "C")       ] +case_split_case2 :: Assertion case_split_case2 =   IML.split (5 <=..< 10) m @?= (smaller, middle, larger)   where@@ -606,6 +691,7 @@       , (20 <..<= 30, "C")       ] +case_split_case3 :: Assertion case_split_case3 =   IML.split (5 <=..<= 10) m @?= (smaller, middle, larger)   where@@ -630,6 +716,7 @@       , (20 <..<= 30, "C")       ] +case_split_case4 :: Assertion case_split_case4 =   IML.split (5 <=..< 10) m @?= (smaller, middle, larger)   where@@ -654,6 +741,7 @@       , (20  <..<= 30, "C")       ] +case_split_case5 :: Assertion case_split_case5 =   IML.split (5 <=..<= 10) m @?= (smaller, middle, larger)   where@@ -679,6 +767,7 @@       , (20 <..<= 30, "C")       ] +case_split_case6 :: Assertion case_split_case6 =   IML.split (5 <=..< 20) m @?= (smaller, middle, larger)   where@@ -704,6 +793,7 @@       , (20 <..<= 30, "C")       ] +case_split_case7 :: Assertion case_split_case7 =   IML.split (5 <=..<= 20) m @?= (smaller, middle, larger)   where@@ -728,6 +818,7 @@       [ (20 <..<= 30, "C")       ] +case_split_case8 :: Assertion case_split_case8 =   IML.split (5 <=..< 21) m @?= (smaller, middle, larger)   where@@ -757,6 +848,7 @@   Eq --------------------------------------------------------------------} +prop_Eq_reflexive :: Property prop_Eq_reflexive =   forAll arbitrary $ \(i :: IntervalMap Rational Integer) ->     i == i@@ -765,6 +857,7 @@   Show / Read --------------------------------------------------------------------} +prop_show_read_invariance :: Property prop_show_read_invariance =   forAll arbitrary $ \(i :: IntervalMap Rational Integer) ->     i == read (show i)@@ -773,24 +866,28 @@   Monoid --------------------------------------------------------------------} +prop_monoid_assoc :: Property prop_monoid_assoc =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->   forAll arbitrary $ \b ->   forAll arbitrary $ \c ->     a <> (b <> c) == (a <> b) <> c +prop_monoid_unitL :: Property prop_monoid_unitL =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->-    mempty <> a == a+    IML.empty <> a == a +prop_monoid_unitR :: Property prop_monoid_unitR =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->-    a <> mempty == a+    a <> IML.empty == a  {--------------------------------------------------------------------   NFData --------------------------------------------------------------------} +prop_rnf :: Property prop_rnf =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     rnf a == ()@@ -799,6 +896,7 @@   Hashable --------------------------------------------------------------------} +prop_hash :: Property prop_hash =   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->     hash a `seq` True@@ -807,6 +905,7 @@   Data ------------------------------------------------------------------ -} +case_Data :: Assertion case_Data = everywhere f i @?= (IML.singleton (1 <=..<= 2) 3 :: IntervalMap Integer Integer)   where     i :: IntervalMap Integer Integer@@ -819,6 +918,9 @@   Generators --------------------------------------------------------------------} +instance Arbitrary Interval.Boundary where+  arbitrary = arbitraryBoundedEnum+ instance Arbitrary r => Arbitrary (Extended r) where   arbitrary =     oneof@@ -839,4 +941,5 @@ ------------------------------------------------------------------------ -- Test harness +intervalMapTestGroup :: TestTree intervalMapTestGroup = $(testGroupGenerator)

@@ -463,6 +463,9 @@   Generators --------------------------------------------------------------------} +instance Arbitrary Interval.Boundary where+  arbitrary = arbitraryBoundedEnum+ instance Arbitrary r => Arbitrary (Extended r) where   arbitrary =     oneof