interval-algebra 1.1.0 → 1.1.1

raw patch · 4 files changed

+77/−42 lines, 4 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−1
• interval-algebra.cabal +1/−1
• src/IntervalAlgebra/Arbitrary.hs +39/−35
• test/IntervalAlgebra/IntervalUtilitiesSpec.hs +32/−5

@@ -1,8 +1,12 @@ # Changelog for interval-algebra +## 1.1.1++* Modifies internals of `IntervalAlgebra.Arbitrary` module to give uniformity over support for `Integer` and `UTCTime` intervals, yielding better interval generators. Also bounds the `UTCTime` `utctDayTime` argument to `86399` rather than `86400` to avoid trivial and rare cases of property testing failures related to leap seconds.+ ## 1.1.0 -* Fixes bug in `parseInterval`. For example, `parseInterval 0 0` parsed to a `Right (Interval (0, 0))`. Oops, the inequality of the should have been `y <= x` not `y < x`. This was fixed and a test added catch this error.+* Fixes bug in `parseInterval`. For example, `parseInterval 0 0` parsed to a `Right (Interval (0, 0))`. Oops, the inequality of the should have been `y <= x` not `y < x`. This was fixed and a test added to catch this error.  ## 1.0.1 

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           interval-algebra-version:        1.1.0+version:        1.1.1 synopsis:       An implementation of Allen's interval algebra for temporal logic description:    Please see the README on GitHub at <https://github.com/novisci/interval-algebra> category:       Algebra,Time

@@ -6,55 +6,59 @@ Maintainer  : bsaul@novisci.com Stability   : experimental -}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE Safe #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Safe              #-} + module IntervalAlgebra.Arbitrary() where -import Test.QuickCheck      ( Arbitrary(arbitrary, shrink),-                             Gen, NonNegative )-import GHC.Int              ( Int )-import GHC.Num-import GHC.Real-import GHC.Float-import Control.Applicative  ( (<$>), liftA2 )-import Control.Monad        ( liftM2 )-import IntervalAlgebra      (Interval, beginerval)-import Data.Function        ( (.), ($) )-import Data.Fixed -import Data.Bool-import Data.Ord-import Data.Time as DT      ( Day(ModifiedJulianDay)-                            , toModifiedJulianDay-                            , picosecondsToDiffTime-                            , secondsToDiffTime-                            , secondsToNominalDiffTime-                            , UTCTime(..), NominalDiffTime)+import           Control.Applicative (liftA2, (<$>))+import           Control.Monad       (liftM2)+import           Data.Bool+import           Data.Fixed+import           Data.Function       (($), (.))+import           Data.Ord+import           Data.Time           as DT (Day (ModifiedJulianDay),+                                            NominalDiffTime, UTCTime (..),+                                            DiffTime,+                                            picosecondsToDiffTime,+                                            secondsToDiffTime,+                                            secondsToNominalDiffTime,+                                            toModifiedJulianDay)+import           GHC.Float+import           GHC.Int             (Int)+import           GHC.Num+import           GHC.Real+import           IntervalAlgebra     (Interval, beginerval)+import           Test.QuickCheck     (Arbitrary (arbitrary, shrink), Gen,+                                      arbitrarySizedNatural, resize) +-- NOTE: the default size for arbitrary :: Gen Int appears to be 30+arbitrarySizedPositive :: Integral a => Gen a+arbitrarySizedPositive = (+ 1) <$> arbitrarySizedNatural++maxDiffTime :: Int+maxDiffTime = 86400+ instance Arbitrary (Interval Int) where-  arbitrary = liftM2 beginerval arbitrary arbitrary+  arbitrary = liftM2 beginerval arbitrarySizedPositive arbitrary  instance Arbitrary DT.Day where     arbitrary = DT.ModifiedJulianDay <$> arbitrary     shrink    = (DT.ModifiedJulianDay <$>) . shrink . DT.toModifiedJulianDay --withinDiffTimeRange ::  Integer -> Integer-withinDiffTimeRange x-    | x < 0     = 0-    | x > 86400 = 86400-    | otherwise = x-    instance Arbitrary DT.NominalDiffTime where-   arbitrary = fromInteger . withinDiffTimeRange <$> (arbitrary :: Gen Integer)+   arbitrary = fromInteger <$> (maxDiffTime `resize` arbitrarySizedNatural) -instance Arbitrary DT.UTCTime  where-    arbitrary = liftA2 UTCTime  -                  arbitrary -                  (secondsToDiffTime . withinDiffTimeRange <$> (arbitrary :: Gen Integer) )+instance Arbitrary DT.DiffTime where+   arbitrary = fromInteger <$> (maxDiffTime `resize` arbitrarySizedNatural) +instance Arbitrary DT.UTCTime  where+    -- resize in utctDayTime is to avoid rare leap-seconds-related failure, in+    -- which e.g.  1858-12-31 00:00:00 UTC /= 1858-12-30 23:59:60 UTC+    arbitrary = liftA2 UTCTime arbitrary (86399 `resize` arbitrary)+                   instance Arbitrary (Interval DT.Day) where   arbitrary = liftM2 beginerval arbitrary arbitrary 

@@ -16,7 +16,9 @@                                           , (===), (==>)                                           , Arbitrary1 (liftArbitrary)                                           , listOf-                                          , orderedList)+                                          , resize+                                          , orderedList+                                          , elements) import Data.List                          (sort) import IntervalAlgebra.Arbitrary          ( ) import IntervalAlgebra                    ( Interval@@ -73,14 +75,25 @@  -- Types for testing +-- SmallInterval is just to test properties for which events of interest are so+-- rare QuickCheck gives up, e.g. filterEquals+data SmallInterval = SmallInterval { unSmall :: Interval Int } deriving (Show, Eq)++instance Arbitrary SmallInterval where+   arbitrary = SmallInterval . beginerval 0 <$> elements [0..10]+ -- A "state" here is just used test formMeetingSequence  newtype Events a = Events {getEvents :: [PairedInterval State a]}    deriving (Eq, Show, Ord)+ newtype State = State [Bool] deriving (Show, Eq)+ instance Semigroup State where      State x <> State y = State $ zipWith (||) x y+ instance Monoid State where     mempty = State [False, False, False]+ type StateEvent a = PairedInterval State a  @@ -94,8 +107,10 @@ instance Arbitrary State where    arbitrary =  State <$> suchThat (listOf arbitrary) (\x -> length x == 3) +-- SmallInterval again to address issue of generating from too large a possible+-- range of intervals instance Arbitrary (PairedInterval State Int) where-   arbitrary = liftM2 makePairedInterval arbitrary arbitrary+   arbitrary = liftM2 makePairedInterval arbitrary (unSmall <$> arbitrary)  instance Arbitrary (Events Int) where    arbitrary = Events <$> orderedList@@ -243,7 +258,7 @@    not (null es)  ==> all (==Meets) (relationsL $ formMeetingSequence es) === True    where es = getEvents x --- In the case that that the input has+-- In the case that the input has -- *     at least one Before relation between consequent pairs -- * AND does not have any empty states --@@ -259,7 +274,7 @@    where res = formMeetingSequence (getEvents x)          beforeCount = lengthWhen (== Before) (relationsL (getEvents x))          emptyCount  = lengthWhen (\x -> getPairData x == mempty ) res-         lengthWhen f x = length $ filter f x+         lengthWhen f = length . filter f  -- Check that formMeetingSequence doesn't return an empty list unless input is  -- empty.@@ -382,6 +397,18 @@ prop_clip_intersect x y =    clip x y === intersect (min x y) (max x y) +-- NOTE: use this instead of prop_filterEquals+prop_small_filterEquals :: SmallInterval -> [SmallInterval] -> Property+prop_small_filterEquals x l =+   not (null res) ==> and (fmap (predicate s i) res) === True+  where +     i = unSmall x+     li = map unSmall l+     res = filterEquals i li+     s = fromList [Equals]++-- RUNNER+ spec :: Spec spec = do    describe "gaps tests" $@@ -472,7 +499,7 @@          it "filterMetBy property" $ property (prop_filterMetBy @Int)          it "filterDuring property" $ property (prop_filterDuring @Int)          it "filterContains property" $ property (prop_filterContains @Int)-         it "filterEquals property" $ property (prop_filterEquals @Int)+         it "filterEquals property" $ property prop_small_filterEquals          it "filterDisjoint property" $ property (prop_filterDisjoint @Int)          it "filterNotDisjoint property" $ property (prop_filterNotDisjoint @Int)          it "filterWithin property" $ property (prop_filterWithin @Int)