interval-algebra 1.1.3 → 1.2.0

raw patch · 6 files changed

+40/−23 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• interval-algebra.cabal +1/−1
• src/IntervalAlgebra/Arbitrary.hs +5/−0
• src/IntervalAlgebra/Core.hs +4/−2
• src/IntervalAlgebra/PairedInterval.hs +3/−1
• test/IntervalAlgebra/IntervalUtilitiesSpec.hs +22/−19

@@ -1,5 +1,10 @@ # Changelog for interval-algebra +## 1.2.0++* Derives `Generic` instances for `Interval` and `PairedInterval`.+* Adds an `Arbitrary` instance for `PairedInterval`.+ ## 1.1.3  * `Arbitrary` instances for `DiffTime`, `NominalDiffTime` and `Day` are now sized, the absence of which had prevented the 'fix' from version 1.1.1 from being effective. `DiffTime` and `NominalDiffTime` generators are also now limited to a maximum `86399` seconds directly.

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           interval-algebra-version:        1.1.3+version:        1.2.0 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

@@ -9,6 +9,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Safe              #-}+{-# LANGUAGE FlexibleContexts #-}   module IntervalAlgebra.Arbitrary( arbitraryWithRelation ) where@@ -32,6 +33,7 @@ import           GHC.Num import           GHC.Real import           IntervalAlgebra     (Interval, IntervalRelation (..),+                                      PairedInterval, makePairedInterval,                                       IntervalSizeable, Intervallic, beginerval,                                       converse, duration, moment', predicate,                                       strictWithinRelations)@@ -70,6 +72,9 @@  instance Arbitrary (Interval DT.UTCTime) where   arbitrary = liftM2 beginerval arbitrary arbitrary++instance (Arbitrary b, Arbitrary (Interval a)) => Arbitrary (PairedInterval b a) where+  arbitrary = liftM2 makePairedInterval arbitrary arbitrary   -- | Conditional generation of intervals relative to a reference.  If the -- reference `iv` is of 'moment' duration, it is not possible to generate

@@ -27,10 +27,11 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveGeneric #-}  module IntervalAlgebra.Core( @@ -196,6 +197,7 @@                                 , (++), (==), (&&), (+), (-), (!!), realToFrac) import Data.Function            ( ($), id, (.), flip ) import Data.Functor             ( Functor(fmap) )+import GHC.Generics             ( Generic ) import Data.Ord                 ( Ord(..), Ordering(..), min, max ) import Data.Semigroup           ( Semigroup((<>)) ) import qualified Data.Set       ( Set@@ -222,7 +224,7 @@ {- | An @'Interval' a@ is a pair \( (x, y) \text{ such that } x < y\). To create intervals use the @'parseInterval'@, @'beginerval'@, or @'enderval'@ functions. -}-newtype Interval a = Interval (a, a) deriving (Eq)+newtype Interval a = Interval (a, a) deriving (Eq, Generic)  -- | A type identifying interval parsing errors. newtype ParseErrorInterval = ParseErrorInterval String 

@@ -10,6 +10,7 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveGeneric #-}  module IntervalAlgebra.PairedInterval (       PairedInterval@@ -30,10 +31,11 @@                                     , extenterval ) import safe Witherable              ( Filterable(filter) ) import safe Data.Bifunctor          ( Bifunctor(bimap) )+import safe GHC.Generics            ( Generic )  -- | An @Interval a@ paired with some other data of type @b@. newtype PairedInterval b a = PairedInterval (Interval a, b)-    deriving (Eq)+    deriving (Eq, Generic)  instance (Ord a) => Intervallic (PairedInterval b) a where     getInterval (PairedInterval x)        = fst x

@@ -74,7 +74,7 @@  -- A "state" here is just used test formMeetingSequence newtype Events a-  = Events { getEvents :: [PairedInterval State a] }+  = Events { getEvents :: [StateEvent a] }   deriving (Eq, Ord, Show)  newtype State@@ -87,8 +87,12 @@ instance Monoid State where     mempty = State [False, False, False] -type StateEvent a = PairedInterval State a+newtype StateEvent a = MkEvent { getEvent :: PairedInterval State a } +   deriving (Eq, Ord, Show) +unEvents :: [StateEvent a] -> [PairedInterval State a]+unEvents = fmap getEvent+ -- Type for checking arbitraryWithRelation -- A target and reference pair, where targetInterval satisfies at least one of -- refRelations relative to refInterval@@ -106,14 +110,13 @@ mkEv :: IntervalSizeable a a => (a, a) -> b -> PairedInterval b a mkEv i s = makePairedInterval s (readInterval i) - 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 (unSmall <$> arbitrary)+instance Arbitrary (StateEvent Int) where+   arbitrary = liftM2 (\x y -> MkEvent $ makePairedInterval x y) arbitrary (unSmall <$> arbitrary)  instance Arbitrary (Events Int) where    arbitrary = Events <$> orderedList@@ -135,7 +138,7 @@ iv = beginerval  evpi :: Int -> Int -> [Bool] -> StateEvent Int-evpi i j s = makePairedInterval (State s) (beginerval i j)+evpi i j s = MkEvent $ makePairedInterval (State s) (beginerval i j)  -- Test cases containmentInt :: Interval Int@@ -223,7 +226,7 @@   -c5in :: [StateEvent Int]+c5in :: [PairedInterval State Int] c5in = [      mkEv (-63, 21) (State [False,True,True])    , mkEv (-56, 20) (State [True,True,True])@@ -232,7 +235,7 @@    , mkEv (27, 28) (State [False,True,True])    ] -c5out :: [StateEvent Int]+c5out :: [PairedInterval State Int] c5out = [      mkEv (-63, -56) (State [False,True,True])    , mkEv (-56, 34) (State [True,True,True])@@ -279,7 +282,7 @@      Events Int    -> Property prop_formMeetingSequence0 x =-   not (null es)  ==> all (== Meets) (relationsL $ formMeetingSequence es) === True+   not (null es)  ==> all (== Meets) (relationsL $ formMeetingSequence (unEvents es)) === True    where es = getEvents x  -- In the case that the input has@@ -293,10 +296,10 @@    -> Property prop_formMeetingSequence1 x =    ( beforeCount > 0 &&-     not (any (\x -> getPairData x == State [False, False, False]) (getEvents x))+     not (any (\x -> getPairData x == State [False, False, False]) (unEvents $ getEvents x))    ) ==> beforeCount >= emptyCount-   where res = formMeetingSequence (getEvents x)-         beforeCount = lengthWhen (== Before) (relationsL (getEvents x))+   where res = formMeetingSequence (unEvents $ getEvents x)+         beforeCount = lengthWhen (== Before) (relationsL (unEvents $ getEvents x))          emptyCount  = lengthWhen (\x -> getPairData x == mempty ) res          lengthWhen f = length . filter f @@ -306,7 +309,7 @@      Events Int    -> Property prop_formMeetingSequence2 x = not (null $ getEvents x) ==> not $ null res-   where res = formMeetingSequence (getEvents x)+   where res = formMeetingSequence (unEvents $ getEvents x)  class ( Ord a ) => FiltrationProperties a  where    prop_filtration ::@@ -612,19 +615,19 @@    describe "formMeetingSequence unit tests" $       do          it "formMeetingSequence unit test 0" $-            formMeetingSequence c0in `shouldBe` c0out+            formMeetingSequence (unEvents c0in) `shouldBe` unEvents c0out          it "formMeetingSequence unit test 1"$-            formMeetingSequence c1in `shouldBe` c1out+            formMeetingSequence (unEvents c1in) `shouldBe` unEvents c1out          it "formMeetingSequence unit test 2"$-            formMeetingSequence c2in `shouldBe` c2out+            formMeetingSequence (unEvents c2in) `shouldBe` unEvents c2out          it "formMeetingSequence unit test 3"$-            formMeetingSequence c3in `shouldBe` c3out+            formMeetingSequence (unEvents c3in) `shouldBe` unEvents c3out          it "formMeetingSequence unit test 4"$-            formMeetingSequence c4in `shouldBe` c4out+            formMeetingSequence (unEvents c4in) `shouldBe` unEvents c4out          it "formMeetingSequence unit test 5"$             formMeetingSequence c5in `shouldBe` c5out          it "formMeetingSequence unit test 6"$-            formMeetingSequence ([] :: [StateEvent Int]) `shouldBe` []+            formMeetingSequence ([] :: [PairedInterval State Int]) `shouldBe` []     describe "formMeetingSequence property tests" $       modifyMaxSuccess (*50) $