data-interval 2.1.0 → 2.1.1
raw patch · 11 files changed
+205/−31 lines, 11 filesdep ~latticesnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: lattices
API changes (from Hackage documentation)
Files
- CHANGELOG.markdown +6/−0
- README.md +0/−1
- data-interval.cabal +8/−4
- src/Data/IntegerInterval.hs +2/−2
- src/Data/Interval.hs +16/−9
- src/Data/IntervalRelation.hs +25/−2
- src/Data/IntervalSet.hs +2/−2
- test/TestIntegerInterval.hs +2/−2
- test/TestInterval.hs +10/−2
- test/TestIntervalRelation.hs +132/−5
- test/TestIntervalSet.hs +2/−2
CHANGELOG.markdown view
@@ -1,3 +1,9 @@+2.1.1+-----++* fix boundary comparison in `relate` (#30, thanks to marcosh)+* fix behaviour of `lattices` flag+ 2.1.0 -----
README.md view
@@ -1,7 +1,6 @@ data-interval ============= -[](https://travis-ci.org/msakai/data-interval) [](https://github.com/msakai/data-interval/actions/workflows/build.yaml) [](https://hackage.haskell.org/package/data-interval) [](https://packdeps.haskellers.com/feed?needle=data-interval)
data-interval.cabal view
@@ -1,5 +1,5 @@ Name: data-interval-Version: 2.1.0+Version: 2.1.1 License: BSD3 License-File: COPYING Author: Masahiro Sakai (masahiro.sakai@gmail.com)@@ -26,7 +26,9 @@ GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.4- GHC ==8.10.2+ GHC ==8.10.7+ GHC ==9.0.1+ GHC ==9.2.1 source-repository head type: git@@ -42,7 +44,7 @@ base >=4 && <5 , containers , deepseq- , hashable >=1.1.2.5 && <1.4+ , hashable >=1.1.2.5 && <1.5 , extended-reals >=0.2 && <1.0 if impl(ghc <8.0) Build-depends:@@ -87,7 +89,6 @@ base >=4 && <5 , ChasingBottoms , containers- , lattices , deepseq , hashable , data-interval@@ -107,6 +108,9 @@ if impl(ghc <7.10) Build-depends: transformers >=0.2+ if flag(lattices)+ build-depends:+ lattices >=1.2.1.1 && <2.1 Default-Language: Haskell2010 Other-Extensions: TemplateHaskell
src/Data/IntegerInterval.hs view
@@ -83,7 +83,7 @@ , relate ) where -#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices import Algebra.Lattice #endif import Control.Exception (assert)@@ -135,7 +135,7 @@ ub@(Finite _) -> (ub, Closed) ub@_ -> (ub, Open) -#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices #if MIN_VERSION_lattices(2,0,0) instance Lattice IntegerInterval where
src/Data/Interval.hs view
@@ -83,7 +83,7 @@ , relate ) where -#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices import Algebra.Lattice #endif import Control.Exception (assert)@@ -120,7 +120,7 @@ infix 4 >?? infix 4 /=?? -#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices #if MIN_VERSION_lattices(2,0,0) instance (Ord r) => Lattice (Interval r) where@@ -857,16 +857,16 @@ -- 'i1' ad 'i2' are equal (True , True ) -> Equal -- 'i1' is strictly contained in `i2`- (True , False) | lowerBound i1 == lowerBound i2 -> Starts- | upperBound i1 == upperBound i2 -> Finishes- | otherwise -> During+ (True , False) | compareBound (lowerBound' i1) (lowerBound' i2) == EQ -> Starts+ | compareBound (upperBound' i1) (upperBound' i2) == EQ -> Finishes+ | otherwise -> During -- 'i2' is strictly contained in `i1`- (False, True ) | lowerBound i1 == lowerBound i2 -> StartedBy- | upperBound i1 == upperBound i2 -> FinishedBy- | otherwise -> Contains+ (False, True ) | compareBound (lowerBound' i1) (lowerBound' i2) == EQ -> StartedBy+ | compareBound (upperBound' i1) (upperBound' i2) == EQ -> FinishedBy+ | otherwise -> Contains -- neither `i1` nor `i2` is contained in the other (False, False) -> case ( null (i1 `intersection` i2)- , upperBound' i1 <= upperBound' i2+ , compareBound (upperBound' i1) (upperBound' i2) <= EQ , i1 `isConnected` i2 ) of (True , True , True ) -> JustBefore@@ -875,3 +875,10 @@ (True , False, False) -> After (False, True , _ ) -> Overlaps (False, False, _ ) -> OverlappedBy+ where+ compareBound :: Ord r => (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering+ compareBound (PosInf, _) (PosInf, _) = EQ+ compareBound (PosInf, _) _ = GT+ compareBound (NegInf, _) (NegInf, _) = EQ+ compareBound (NegInf, _) _ = LT+ compareBound a b = compare a b
src/Data/IntervalRelation.hs view
@@ -23,25 +23,48 @@ import Data.Data import GHC.Generics (Generic) --- | describes how two intervals @x@ and @y@ can be related.+-- | Describes how two intervals @x@ and @y@ can be related. -- See [Allen's interval algebra](https://en.wikipedia.org/wiki/Allen%27s_interval_algebra)+-- and [Intervals and their relations](http://marcosh.github.io/post/2020/05/04/intervals-and-their-relations.html). data Relation = Before+ -- ^ Any element of @x@ is smaller than any element of @y@,+ -- and intervals are not connected. In other words, there exists an element+ -- that is bigger than any element of @x@ and smaller than any element of @y@. | JustBefore+ -- ^ Any element of @x@ is smaller than any element of @y@,+ -- but intervals are connected and non-empty. This implies that intersection+ -- of intervals is empty, and union is a single interval. | Overlaps+ -- ^ Intersection of @x@ and @y@ is non-empty,+ -- @x@ start and finishes earlier than @y@. This implies that union+ -- is a single interval, and @x@ finishes no earlier than @y@ starts. | Starts+ -- ^ @x@ is a proper subset of @y@,+ -- and they share lower bounds. | During+ -- ^ @x@ is a proper subset of @y@,+ -- but they share neither lower nor upper bounds. | Finishes+ -- ^ @x@ is a proper subset of @y@,+ -- and they share upper bounds. | Equal+ -- ^ Intervals are equal. | FinishedBy+ -- ^ Inverse of 'Finishes'. | Contains+ -- ^ Inverse of 'During'. | StartedBy+ -- ^ Inverse of 'Starts'. | OverlappedBy+ -- ^ Inverse of 'Overlaps'. | JustAfter+ -- ^ Inverse of 'JustBefore'. | After+ -- ^ Inverse of 'Before'. deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data, Typeable) --- | inverts a relation, such that @'invert' ('Data.Interval.relate' x y) = 'Data.Interval.relate' y x@+-- | Inverts a relation, such that @'invert' ('Data.Interval.relate' x y) = 'Data.Interval.relate' y x@ invert :: Relation -> Relation invert relation = case relation of Before -> After
src/Data/IntervalSet.hs view
@@ -62,7 +62,7 @@ where import Prelude hiding (null, span)-#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices import Algebra.Lattice #endif import Control.DeepSeq@@ -133,7 +133,7 @@ instance Hashable r => Hashable (IntervalSet r) where hashWithSalt s (IntervalSet m) = hashWithSalt s (Map.toList m) -#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices #if MIN_VERSION_lattices(2,0,0) instance (Ord r) => Lattice (IntervalSet r) where
test/TestIntegerInterval.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP, TemplateHaskell, ScopedTypeVariables #-} module TestIntegerInterval (integerIntervalTestGroup) where -#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices import qualified Algebra.Lattice as L #endif import Control.DeepSeq@@ -724,7 +724,7 @@ Lattice --------------------------------------------------------------------} -#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices prop_Lattice_Leq_welldefined = forAll integerIntervals $ \a b ->
test/TestInterval.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP, TemplateHaskell, RankNTypes, ScopedTypeVariables #-} module TestInterval (intervalTestGroup) where -#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices import qualified Algebra.Lattice as L #endif import Control.DeepSeq@@ -380,6 +380,14 @@ forAll (nonEmptyIntervalPairs (\(lb1, _) (ub1, _) (lb2, _) (ub2, _) -> lb1 < lb2 && ub1 > ub2)) $ \(a, b) -> Interval.relate a b == Contains +prop_relate_closed_interval_contains_open_interval_with_same_boundary =+ forAll (arbitrary `suchThat` \(lb, rb) -> lb < rb) $+ \(lb :: Rational, rb) ->+ Interval.relate+ (Interval.interval (Finite lb, Interval.Closed) (Finite rb, Interval.Closed))+ (Interval.interval (Finite lb, Interval.Open) (Finite rb, Interval.Open))+ == Contains+ prop_relate_one_singleton_before_another = forAll (arbitrary `suchThat` uncurry (<)) $ \(r1 :: Rational, r2) -> Interval.relate (Interval.singleton r1) (Interval.singleton r2) == Before@@ -1155,7 +1163,7 @@ Lattice --------------------------------------------------------------------} -#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices prop_Lattice_Leq_welldefined = forAll intervals $ \a b ->
test/TestIntervalRelation.hs view
@@ -1,11 +1,13 @@ {-# LANGUAGE ScopedTypeVariables, TemplateHaskell #-} module TestIntervalRelation (intervalRelationTestGroup) where +import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Test.Tasty.TH -import Data.Interval+import Data.Interval as I import Data.IntervalRelation+import Data.Ord (Down(..)) import TestInstances @@ -14,12 +16,137 @@ --------------------------------------------------------------------} prop_invert_is_involution a =- invert (invert a) == a+ invert (invert a) === a prop_invert_inverts_relation =- forAll intervals $ \a ->- forAll intervals $ \b ->- relate a b == invert (relate b a)+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ relate a b === invert (relate b a)++------------------------------------------------------------------------++case_empty1 =+ relate (empty :: Interval Rational) empty @?= Equal++prop_empty2 =+ forAllShrink intervals shrink $ \a -> not (I.null a) ==>+ relate (empty :: Interval Rational) a === During++prop_empty3 =+ forAllShrink intervals shrink $ \a -> not (I.null a) ==>+ relate a (empty :: Interval Rational) === Contains++prop_universal_lt =+ forAllShrink intervals shrink $ \a -> not (I.null a) ==>+ forAllShrink intervals shrink $ \b -> not (I.null b) ==>+ let r = relate a b in counterexample (show r) $+ if a <! b then r `elem` [Before, JustBefore]+ else r `notElem` [Before, JustBefore]++prop_universal_le =+ forAllShrink intervals shrink $ \a -> not (I.null a) ==>+ forAllShrink intervals shrink $ \b -> not (I.null b) ==>+ let r = relate a b in counterexample (show r) $+ if a <=! b then r `elem` [Before, JustBefore, Overlaps, Starts, Equal, FinishedBy]+ else r `notElem` [Before, JustBefore]++prop_universal_eq =+ forAllShrink intervals shrink $ \a -> not (I.null a) ==>+ forAllShrink intervals shrink $ \b -> not (I.null b) ==>+ not (a ==! b) || relate a b == Equal++prop_universal_gt =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ (a >! b) === (b <! a)++prop_universal_ge =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ (a >=! b) === (b <=! a)++prop_universal_ne =+ forAllShrink intervals shrink $ \a -> not (I.null a) ==>+ forAllShrink intervals shrink $ \b -> not (I.null b) ==>+ let r = relate a b in counterexample (show r) $+ if a /=! b then r `elem` [Before, JustBefore, After, JustAfter]+ else r `notElem` [Before, JustBefore, After, JustAfter]++------------------------------------------------------------------------++prop_existential_lt =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ (a <? b) === not (a >=! b)++prop_existential_le =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ (a <=? b) === not (a >! b)++prop_existential_eq =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ (a ==? b) === not (a /=! b)++prop_existential_gt =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ (a >? b) === not (a <=! b)++prop_existential_ge =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ (a >=? b) === not (a <! b)++prop_existential_ne =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ (a /=? b) === not (a ==! b)++------------------------------------------------------------------------++prop_before =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ let r = relate a b in counterexample (show r) $+ (r == Before) === (a <! b && not (isConnected a b))++prop_just_before =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ let r = relate a b in counterexample (show r) $+ (r == JustBefore) === (a <! b && isConnected a b && not (I.null a) && not (I.null b))++prop_overlaps =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ let r = relate a b in counterexample (show r) $+ (r == Overlaps) === (not (I.null (intersection a b)) && fmap Down (lowerBound' a) < fmap Down (lowerBound' b) && upperBound' a < upperBound' b)++prop_starts =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ let r = relate a b in counterexample (show r) $+ (r == Starts) === (isProperSubsetOf a b && lowerBound' a == lowerBound' b)++prop_during =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ let r = relate a b in counterexample (show r) $+ (r == During) === (isProperSubsetOf a b && lowerBound' a /= lowerBound' b && upperBound' a /= upperBound' b)++prop_finishes =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ let r = relate a b in counterexample (show r) $+ (r == Finishes) === (isProperSubsetOf a b && upperBound' a == upperBound' b)++prop_equal =+ forAllShrink intervals shrink $ \a ->+ forAllShrink intervals shrink $ \b ->+ let r = relate a b in counterexample (show r) $+ (r == Equal) === (a == b) ------------------------------------------------------------------------ -- Test harness
test/TestIntervalSet.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP, TemplateHaskell, ScopedTypeVariables #-} module TestIntervalSet (intervalSetTestGroup) where -#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices import qualified Algebra.Lattice as L #endif import Control.Applicative ((<$>))@@ -297,7 +297,7 @@ Lattice --------------------------------------------------------------------} -#if MIN_VERSION_lattices+#ifdef MIN_VERSION_lattices prop_Lattice_Leq_welldefined = forAll arbitrary $ \(a :: IntervalSet Rational) (b :: IntervalSet Rational) ->