packages feed

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 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 ============= -[![Build Status (Travis-CI)](https://travis-ci.org/msakai/data-interval.svg?branch=master)](https://travis-ci.org/msakai/data-interval) [![Build Status (GitHub Actions)](https://github.com/msakai/data-interval/actions/workflows/build.yaml/badge.svg)](https://github.com/msakai/data-interval/actions/workflows/build.yaml) [![Hackage](https://img.shields.io/hackage/v/data-interval.svg)](https://hackage.haskell.org/package/data-interval) [![Hackage Deps](https://img.shields.io/hackage-deps/v/data-interval.svg)](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) ->