interval-algebra 0.6.2 → 0.6.3

raw patch · 8 files changed

+249/−214 lines, 8 filesdep +safePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: safe

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• interval-algebra.cabal +3/−1
• src/IntervalAlgebra.hs +14/−14
• src/IntervalAlgebra/IntervalUtilities.hs +81/−75
• src/IntervalAlgebra/PairedInterval.hs +2/−2
• test/IntervalAlgebra/IntervalUtilitiesSpec.hs +39/−30
• test/IntervalAlgebra/PairedIntervalSpec.hs +9/−7
• test/IntervalAlgebraSpec.hs +95/−85

@@ -1,5 +1,11 @@ # Changelog for interval-algebra +## 0.6.3++* Extends the `IntervalCombinable` class to operate on general `Interval` containers.+* Removes all usage of `unsafeInterval` from the testing suite in preparation of removing this function.+* Modifies internals of the `combineIntervals` function to use safe (exception-free) functions rather than footguns like `head` and `tail`.+ ## 0.6.2  * Fixes bug in `equals` which was checking for equality of the interval container, not just the interval.

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           interval-algebra-version:        0.6.2+version:        0.6.3 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@@ -37,6 +37,7 @@     , time >=1.8 && <2     , containers >= 0.6     , witherable >= 0.4+    , safe >= 0.3     , QuickCheck   default-language: Haskell2010 @@ -60,4 +61,5 @@     , containers >= 0.6     , interval-algebra     , time >=1.8 && <2+    , safe >= 0.3   default-language: Haskell2010

@@ -119,7 +119,7 @@ of a data structure. It also includes functions for getting the @'begin'@ and  @'end'@ this data. -}-class (Ord a) => Intervallic i a where+class (Ord a, Show a) => Intervallic i a where      -- | Get the interval from an @i a@     getInterval :: i a -> Interval a@@ -561,12 +561,12 @@  {- | The @'IntervalCombinable'@ typeclass provides methods for (possibly) combining-two @'Interval's@.+two @i a@s to form an @'Interval'@. -}-class (IntervalAlgebraic Interval a, Show a) => IntervalCombinable a where+class (IntervalAlgebraic i a) => IntervalCombinable i a where      -- | Maybe form a new @'Interval'@ by the union of two @'Interval'@s that 'meets'.-    (.+.) :: Interval a -> Interval a -> Maybe (Interval a)+    (.+.) :: i a -> i a -> Maybe (Interval a)     (.+.) x y       | x `meets` y = Just $ Interval (begin x, end y)       | otherwise   = Nothing@@ -574,7 +574,7 @@     -- | If @x@ is 'before' @y@, then form a new @Just Interval a@ from the      --   interval in the "gap" between @x@ and @y@ from the 'end' of @x@ to the     --   'begin' of @y@. Otherwise, 'Nothing'.-    (><) ::  Interval a -> Interval a -> Maybe (Interval a)+    (><) ::  i a -> i a -> Maybe (Interval a)     (><) x y         | x `before` y = Just $ Interval ( end x, begin y )         | otherwise    = Nothing@@ -583,17 +583,17 @@     --   return 'extenterval' of @x@ and @y@ (wrapped in @f@). This is useful for      --   (left) folding over an *ordered* container of @Interval@s and combining      --   intervals when @x@ is *not* 'before' @y@.-    (<+>):: (Semigroup (f (Interval a)), Applicative f) =>-            Interval a ->-            Interval a ->+    (<+>):: (Semigroup (f (i a)), Semigroup (f (Interval a)), Applicative f) =>+            i a ->+            i a ->             f (Interval a)     (<+>) x y-      | x `before` y = pure x <> pure y+      | x `before` y = pure (getInterval x) <> pure (getInterval y)       | otherwise    = pure ( extenterval x y )      -- | Forms a 'Just' new interval from the intersection of two intervals,      --   provided the intervals are not disjoint.-    intersect :: Interval a -> Interval a -> Maybe (Interval a)+    intersect :: i a -> i a -> Maybe (Interval a)     intersect x y        | disjoint x y = Nothing        | otherwise    = Just $ Interval (b, e)@@ -616,7 +616,7 @@       | begin x == begin y = end x < end y       | otherwise = False -instance (Intervallic Interval a, Show a) => Show (Interval a) where+instance (Intervallic Interval a) => Show (Interval a) where    show x = "(" ++ show (begin x) ++ ", " ++ show (end x) ++ ")"  instance (Ord a, Show a) => Intervallic Interval a where@@ -624,21 +624,21 @@     setInterval _ x = x  instance IntervalAlgebraic Interval Int-instance IntervalCombinable Int+instance IntervalCombinable Interval Int instance IntervalSizeable Int Int where     moment = 1     add = (+)     diff = (-)  instance IntervalAlgebraic Interval Integer-instance IntervalCombinable Integer+instance IntervalCombinable Interval Integer instance IntervalSizeable Integer Integer where     moment = 1     add = (+)     diff = (-)  instance IntervalAlgebraic Interval DT.Day-instance IntervalCombinable DT.Day+instance IntervalCombinable Interval DT.Day instance IntervalSizeable DT.Day Integer where     moment = 1     add = addDays

@@ -8,6 +8,8 @@ License     : BSD3 Maintainer  : bsaul@novisci.com Stability   : experimental++In the examples below, @iv@ is a synonym for 'beginerval' used to save space. -}  module IntervalAlgebra.IntervalUtilities (@@ -49,36 +51,35 @@  ) where -import GHC.Base-    ( otherwise, ($), (.), (<*>), seq, not-    , Semigroup((<>))-    , Functor(fmap)-    , Applicative(pure)-    , Int, Bool, Ord)-import GHC.Show ( Show )-import GHC.Num ()-import Data.Tuple ( fst )-import Data.Foldable ( Foldable(null, foldl', toList), all, any )-import Data.Monoid ( (<>), Monoid(mempty) )-import IntervalAlgebra-    ( Interval, Intervallic(..), IntervalAlgebraic(..)-    , IntervalCombinable(..), IntervalSizeable(..)-    , IntervalRelation(..)-    , ComparativePredicateOf-    , unsafeInterval-    , beginerval-    , enderval-    )-import Data.Maybe (mapMaybe, catMaybes, fromMaybe, Maybe(..))-import Data.List ( (++), map, head, init, last, tail )-import Witherable ( Filterable(filter) )+import GHC.Base         ( otherwise, ($), (.), (<*>), seq, not+                        , Semigroup((<>))+                        , Functor(fmap)+                        , Applicative(pure)+                        , Int, Bool, Ord)+import GHC.Num          ()+import Data.Tuple       ( fst )+import Data.Foldable    ( Foldable(null, foldl', toList), all, any )+import Data.Monoid      ( (<>), Monoid(mempty) )+import Data.Maybe       (mapMaybe, catMaybes, fromMaybe, Maybe(..))+import Data.List        ( (++), map )+import IntervalAlgebra  ( Interval+                        , Intervallic(..)+                        , IntervalAlgebraic(..)+                        , IntervalCombinable(..)+                        , IntervalSizeable(..)+                        , IntervalRelation(..)+                        , ComparativePredicateOf+                        , beginerval+                        , enderval)+import Safe             ( headMay, lastMay, initSafe, tailSafe)+import Witherable       ( Filterable(filter) )  ------------------------------------------------- -- Unexported utilties used in functions below -- ------------------------------------------------- -intInt :: Int -> Int -> Interval Int-intInt = unsafeInterval+iv :: Int -> Int -> Interval Int+iv = beginerval  -- Fold over consecutive pairs of foldable structure and collect the results in  -- a monoidal structure.@@ -109,23 +110,27 @@  -- Defines how a Box of Intervals are combined. Specifically, the last element of -- x and first element of y are combined by '<+>'.-instance (IntervalCombinable a) => Semigroup (Box (Interval a)) where-    Box x <> Box y-       | null x         = Box y-       | null y         = Box x-       | otherwise      = Box $ init x ++ (lx <+> fy) ++ tail y-       where lx = last x-             fy = head y+instance (IntervalCombinable Interval a) => Semigroup (Box (Interval a)) where+    Box x <> Box y = Box $ initSafe x ++ lastMay x <++> headMay y ++ tailSafe y +(<++>) :: (IntervalCombinable Interval a) => +       Maybe (Interval a)+    -> Maybe (Interval a) +    -> [Interval a]+(<++>) Nothing Nothing   = []+(<++>) Nothing (Just y)  = [y]+(<++>) (Just x) Nothing  = [x]+(<++>) (Just x) (Just y) = x <+> y+ -------------------------------------------------  -- | Returns a container of intervals where any intervals that meet or share support --   are combined into one interval. *To work properly, the input should  --   be sorted*. See 'combineIntervals'' for a version that works only on lists. ----- >>> combineIntervals [intInt 0 10, intInt 2 7, intInt 10 12, intInt 13 15]+-- >>> combineIntervals [iv 10 0, iv 5 2, iv 2 10, iv 2 13] -- [(0, 12),(13, 15)]-combineIntervals :: (IntervalCombinable a+combineIntervals :: (IntervalCombinable Interval a          , Applicative f          , Monoid (f (Interval a))          , Foldable f) =>@@ -137,18 +142,18 @@ --   are combined into one interval. *To work properly, the input list should  --   be sorted*.  ----- >>> combineIntervals' [intInt 0 10, intInt 2 7, intInt 10 12, intInt 13 15]+-- >>> combineIntervals' [iv 10 0, iv 5 2, iv 2 10, iv 2 13] -- [(0, 12),(13, 15)]-combineIntervals' :: (IntervalCombinable a) => [Interval a] -> [Interval a]+combineIntervals' :: (IntervalCombinable Interval a) => [Interval a] -> [Interval a] combineIntervals' l = unBox $ foldl' (<>) (Box []) (map (\z -> Box [z]) l)  -- | Returns a (possibly empty) container of intervals consisting of the gaps  --   between intervals in the input. *To work properly, the input should be --   sorted*. See 'gaps'' for a version that returns a list. ----- >>> gaps [intInt 1 5, intInt 8 12, intInt 11 14]+-- >>> gaps [iv 4 1, iv 4 8, iv 3 11] -- [(5, 8)]-gaps :: (IntervalCombinable a+gaps :: (IntervalCombinable Interval a          , Applicative f          , Monoid (f (Interval a))          , Foldable f) =>@@ -160,7 +165,7 @@ --   intervals in the input container. *To work properly, the input should be  --   sorted*. This version outputs a list. See 'gaps' for a version that lifts --   the result to same input structure @f@.-gaps' :: (IntervalCombinable a+gaps' :: (IntervalCombinable Interval a          , Applicative f          , Monoid (f (Interval a))          , Foldable f) =>@@ -170,7 +175,7 @@  -- | Returns the 'duration' of each 'Intervallic i a' in the 'Functor' @f@. ----- >>> durations [intInt 1 10, intInt 2 12, intInt 5 6]+-- >>> durations [iv 9 1, iv 10 2, iv 1 5] -- [9,10,1] durations :: (Functor f, Intervallic i a, IntervalSizeable a b)=>        f (i a)@@ -179,10 +184,10 @@  -- | In the case that x y are not disjoint, clips y to the extent of x. -- --- >>> clip (intInt 0 5) (intInt 3 6)+-- >>> clip (iv 5 0) (iv 3 3) -- Just (3, 5) ----- >>> clip (intInt 0 3) (intInt 4 6)+-- >>> clip (iv 3 0) (iv 2 4) -- Nothing clip :: (IntervalAlgebraic Interval a, IntervalSizeable a b)=>        Interval a@@ -201,7 +206,7 @@ --   of intervals. This the specialized form of 'relations'' which can return --   any 'Applicative', 'Monoid' structure. ----- >>> relations [intInt 0 1, intInt 1 2] +-- >>> relations [iv 1 0, iv 1 1]  -- [Meets] relations :: (IntervalAlgebraic i a, Foldable f)=>        f (i a)@@ -210,8 +215,9 @@  -- | A generic form of 'relations' which can output any 'Applicative' and  --   'Monoid' structure. --- >>> (relations' [intInt 0 1, intInt 1 2]) :: [IntervalRelation Int]+-- >>> (relations' [iv 1 0, iv 1 1]) :: [IntervalRelation (Interval Int)] -- [Meets]+-- relations' :: ( IntervalAlgebraic i a               , Foldable f               , Applicative m@@ -225,26 +231,26 @@ -- to @i@, so that all the intervals are 'within' @i@. If there are no gaps, then -- 'Nothing' is returned. ----- >>> gapsWithin (intInt 1 10) [intInt 0 5, intInt 7 9, intInt 12 15]+-- >>> gapsWithin (iv 9 1) [iv 5 0, iv 2 7, iv 3 12] -- Just [(5, 7),(9, 10)] -- gapsWithin :: ( Applicative f                , Foldable f                , Monoid (f (Interval a))                , IntervalSizeable a b-               , IntervalCombinable a+               , IntervalCombinable Interval a                , Filterable f                , IntervalAlgebraic Interval a)=>      Interval a     -- ^ i   -> f (Interval a) -- ^ x   -> Maybe (f (Interval a))-gapsWithin i x -  | null ivs  = Nothing  +gapsWithin i x+  | null ivs  = Nothing   | otherwise = Just $ gaps $ pure s <> ivs <> pure e         where s   = enderval   0 (begin i)               e   = beginerval 0 (end i)               nd  = toList (filterNotDisjoint i x)-              ivs = liftListToFoldable (mapMaybe (clip i) nd) +              ivs = liftListToFoldable (mapMaybe (clip i) nd)  -- | Given a predicate combinator, a predicate, and list of intervals, returns  --   the input unchanged if the predicate combinator is @True@. Otherwise, returns@@ -262,12 +268,12 @@ -- For example, the following returns 'Nothing' because none of the intervals -- in the input list 'starts' (3, 5). ----- >>> nothingIfNone (starts (intInt 3 5)) [intInt 3 4, intInt 5 6]+-- >>> nothingIfNone (starts (iv 2 3)) [iv 1 3, iv 1 5] -- Nothing -- -- In the following, (3, 5) 'starts' (3, 6), so 'Just' the input is returned. ----- >>> nothingIfNone (starts (intInt 3 5)) [intInt 3 6, intInt 5 6]+-- >>> nothingIfNone (starts (iv 2 3)) [iv 3 3, iv 1 5] -- Just [(3, 6),(5, 6)] -- nothingIfNone :: (Monoid (f (i a)), Foldable f, Filterable f, IntervalAlgebraic i a)=>@@ -298,7 +304,7 @@ -- | Lifts a predicate to be able to compare two different 'IntervalAlgebraic'  --   structure by comparing the intervals contain within each.  compareIntervals :: (IntervalAlgebraic i0 a, IntervalAlgebraic i1 a) =>-   ComparativePredicateOf (Interval a) +   ComparativePredicateOf (Interval a)     -> i0 a     -> i1 a     -> Bool@@ -319,7 +325,7 @@ filterOverlaps :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterOverlaps = filterMaker overlaps @@ -327,7 +333,7 @@ filterOverlappedBy :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterOverlappedBy = filterMaker overlappedBy @@ -335,7 +341,7 @@ filterBefore :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterBefore = filterMaker before @@ -343,31 +349,31 @@ filterAfter :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => -                  i0 a -> f (i1 a) -> f (i1 a) +                  , IntervalAlgebraic i1 a) =>+                  i0 a -> f (i1 a) -> f (i1 a) filterAfter = filterMaker after  -- | Filter by 'starts'. filterStarts :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a)-filterStarts = filterMaker starts +filterStarts = filterMaker starts  -- | Filter by 'startedBy'. filterStartedBy :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a)-filterStartedBy = filterMaker startedBy +filterStartedBy = filterMaker startedBy  -- | Filter by 'finishes'. filterFinishes :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterFinishes = filterMaker finishes @@ -375,15 +381,15 @@ filterFinishedBy :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a)-filterFinishedBy = filterMaker finishedBy +filterFinishedBy = filterMaker finishedBy  -- | Filter by 'meets'. filterMeets :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterMeets = filterMaker meets @@ -391,7 +397,7 @@ filterMetBy :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterMetBy = filterMaker metBy @@ -399,7 +405,7 @@ filterDuring :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterDuring = filterMaker during @@ -407,7 +413,7 @@ filterContains :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterContains = filterMaker contains @@ -415,7 +421,7 @@ filterEquals :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterEquals = filterMaker equals @@ -423,7 +429,7 @@ filterDisjoint :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterDisjoint = filterMaker disjoint @@ -431,7 +437,7 @@ filterNotDisjoint :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterNotDisjoint = filterMaker notDisjoint @@ -439,7 +445,7 @@ filterConcur ::  (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterConcur = filterMaker concur @@ -447,7 +453,7 @@ filterWithin :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterWithin = filterMaker within @@ -455,7 +461,7 @@ filterEnclose :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterEnclose = filterMaker enclose @@ -463,6 +469,6 @@ filterEnclosedBy :: (Filterable f                   , IntervalAlgebraic Interval a                   , IntervalAlgebraic i0 a-                  , IntervalAlgebraic i1 a) => +                  , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterEnclosedBy = filterMaker enclosedBy

@@ -31,7 +31,7 @@ newtype PairedInterval b a = PairedInterval (Interval a, b)     deriving (Eq) -instance (Ord a) => Intervallic (PairedInterval b) a where+instance (Ord a, Show a) => Intervallic (PairedInterval b) a where     getInterval (PairedInterval x)        = fst x     setInterval (PairedInterval (x, y)) i = PairedInterval (i, y) @@ -52,7 +52,7 @@ pairData (PairedInterval (_, y)) = y  -- | Gets the intervals from a list of paired intervals.-intervals :: Ord a => [PairedInterval b a] -> [Interval a]+intervals :: (Ord a, Show a) => [PairedInterval b a] -> [Interval a] intervals = map getInterval  -- | Takes a predicate of intervals and a predicate on the data part of a 

@@ -2,42 +2,51 @@ {-# LANGUAGE FlexibleContexts #-} module IntervalAlgebra.IntervalUtilitiesSpec (spec) where -import IntervalAlgebra ( -    Interval-   , Intervallic(..)-   , unsafeInterval-   , IntervalCombinable(..)-   , IntervalAlgebraic(..)-   , IntervalRelation (..) )-import IntervalAlgebra.Arbitrary ()-import IntervalAlgebra.IntervalUtilities-import Test.Hspec.QuickCheck ( modifyMaxSuccess )-import Test.Hspec ( it, shouldBe, describe, Spec, pending )-import Test.QuickCheck-import Data.List(sort)+import Test.Hspec.QuickCheck              ( modifyMaxSuccess )+import Test.Hspec                         ( Spec+                                          , it, shouldBe, describe, pending )+import Test.QuickCheck                    ( Property, Testable(property)+                                          , (===))+import Data.List                          (sort)+import IntervalAlgebra.Arbitrary          ()+import IntervalAlgebra                    ( Interval+                                          , Intervallic(..)+                                          , IntervalCombinable(..)+                                          , IntervalAlgebraic(..)+                                          , IntervalRelation (..)+                                          , beginerval)+import IntervalAlgebra.IntervalUtilities  ( combineIntervals+                                          , gaps+                                          , durations+                                          , clip+                                          , relations+                                          , gapsWithin+                                          , nothingIfNone+                                          , filterDisjoint+                                          , filterNotDisjoint )  intInt :: Int -> Int -> Interval Int-intInt = unsafeInterval+intInt = beginerval  containmentInt :: Interval Int-containmentInt = unsafeInterval (0 :: Int) (10 :: Int)+containmentInt = intInt (10 :: Int) (0 :: Int)  noncontainmentInt :: Interval Int-noncontainmentInt = unsafeInterval (4 :: Int) (10 :: Int)+noncontainmentInt = intInt  6 4  anotherInt :: Interval Int-anotherInt = unsafeInterval (15 :: Int) (20 :: Int)+anotherInt = intInt 5 (15 :: Int)  gapInt :: Interval Int-gapInt = unsafeInterval (10 :: Int) (15 :: Int)+gapInt = intInt 5 (10 :: Int) -prop_combineIntervals1:: (IntervalAlgebraic Interval a, IntervalCombinable a)=>+prop_combineIntervals1:: (IntervalAlgebraic Interval a, IntervalCombinable Interval a)=>      [Interval a]    -> Property prop_combineIntervals1 x = relations ci === replicate (length ci - 1) Before       where ci = combineIntervals (sort x) -prop_gaps1:: (IntervalAlgebraic Interval a, IntervalCombinable a)=>+prop_gaps1:: (IntervalAlgebraic Interval a, IntervalCombinable Interval a)=>      [Interval a]    -> Property prop_gaps1 x = relations gs === replicate (length gs - 1) Before@@ -61,9 +70,9 @@          combineIntervals [noncontainmentInt] `shouldBe` [noncontainmentInt]       it "combineIntervals [] should be []" $          combineIntervals ([] :: [Interval Int]) `shouldBe` []-      it "combineIntervals [intInt 0 10, intInt 2 7, intInt 10 12, intInt 13 15]" $-         combineIntervals [intInt 0 10, intInt 2 7, intInt 10 12, intInt 13 15]-            `shouldBe` [intInt 0 12, intInt 13 15]+      it "combineIntervals [(0, 10), (2, 7), (10, 12), (13, 15)]" $+         combineIntervals [intInt 10 0, intInt 5 2, intInt 2 10, intInt 2 13]+            `shouldBe` [intInt 12 0, intInt 2 13]       it "after combining, only relation should be Before" $          property (prop_combineIntervals1 @Int) @@ -94,7 +103,7 @@            clip containmentInt gapInt `shouldBe` Nothing          it "clip Interval (4, 10) Interval (0, 10) should be Interval (4, 10)" $            clip noncontainmentInt containmentInt `shouldBe`-             Just (unsafeInterval 4 10)+             Just (intInt 6 4)          it "clip x y === intersect sort x y " pending     describe "relations tests" $@@ -111,20 +120,20 @@    describe "gapsWithin tests" $       do          it "gapsWithin (1, 10) [(0,5), (7,9), (12,15)] should be [(5,7), (9,10)]" $-            gapsWithin (intInt 1 10) [intInt 0 5, intInt 7 9, intInt 12 15]-               `shouldBe` Just [intInt 5 7, intInt 9 10]+            gapsWithin (intInt 9 1) [intInt 5 0, intInt 2 7, intInt 3 12]+               `shouldBe` Just [intInt 2 5, intInt 1 9]          it "gapsWithin (1, 10) [] should be []" $-             gapsWithin (intInt 1 10) [] `shouldBe` Nothing+             gapsWithin (intInt 9 1) [] `shouldBe` Nothing          it "more gapsWithin tests" pending     describe "emptyIf tests" $       do          it "emptyIfNone (starts (3, 5)) [(3,4), (5,6)] should be empty" $-            nothingIfNone (starts (intInt 3 5)) [intInt 3 4, intInt 5 6]+            nothingIfNone (starts (intInt 2 3)) [intInt 1 3, intInt 1 5]                `shouldBe` Nothing          it "emptyIfNone (starts (3, 5)) [(3,6), (5,6)] shoiuld be input" $-            nothingIfNone (starts (intInt 3 5)) [intInt 3 6, intInt 5 6]-               `shouldBe` Just [ intInt 3 6, intInt 5 6]+            nothingIfNone (starts (intInt 2 3)) [intInt 3 3, intInt 1 5]+               `shouldBe` Just [ intInt 3 3, intInt 1 5]          it "more emptyif tests" pending     describe "filtration tests" $

@@ -1,20 +1,22 @@ module IntervalAlgebra.PairedIntervalSpec (spec) where -import Test.Hspec ( it, describe, Spec, shouldBe )-import IntervalAlgebra.PairedInterval-import IntervalAlgebra+import Test.Hspec                       ( it, describe, Spec, shouldBe )+import IntervalAlgebra.PairedInterval   ( PairedInterval, mkPairedInterval )+import IntervalAlgebra                  ( beginerval+                                        , IntervalSizeable(duration)+                                        , IntervalAlgebraic(equals, before) )  type TestPair = PairedInterval String Int  mkTestPr :: String -> Int -> Int -> TestPair-mkTestPr x i j = mkPairedInterval x (unsafeInterval i j)+mkTestPr x i j = mkPairedInterval x (beginerval i j)  t1 :: TestPair-t1 = mkTestPr "hi" 0 5+t1 = mkTestPr "hi" 5 0 t2 :: TestPair-t2 = mkTestPr "bye" 6 10+t2 = mkTestPr "bye" 4 6 t3 :: TestPair-t3 = mkTestPr "hello" 0 5+t3 = mkTestPr "hello" 5 0  spec :: Spec spec = do

@@ -1,21 +1,43 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeApplications #-}--- {-# LANGUAGE AllowAmbiguousTypes #-}--- {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-} module IntervalAlgebraSpec (spec) where -import Test.Hspec ( hspec, describe, it, Spec, shouldBe )-import Test.Hspec.QuickCheck ( modifyMaxSuccess, modifyMaxDiscardRatio )-import Test.QuickCheck-import IntervalAlgebra as IA-import Data.Maybe-import Control.Monad ()-import IntervalAlgebra.Arbitrary ()-import Data.Time as DT ( Day )-import Data.Set (member)+import Test.Hspec                 ( hspec, describe, it, Spec, shouldBe )+import Test.Hspec.QuickCheck      ( modifyMaxSuccess, modifyMaxDiscardRatio )+import Test.QuickCheck            ( (===)+                                  , (==>)+                                  , Arbitrary(arbitrary)+                                  , Property+                                  ,  Testable(property) )+import Data.Maybe                 ( fromJust )+import Data.Either                ( isRight )+import IntervalAlgebra.Arbitrary  ()+import Data.Time as DT            ( Day )+import Data.Set                   ( member )+import IntervalAlgebra as IA      ( enderval+                                  , beginerval+                                  , expandr+                                  , expandl+                                  , expand+                                  , parseInterval+                                  , IntervalCombinable(intersect, (.+.))+                                  , IntervalSizeable(moment, diff)+                                  , IntervalAlgebraic(  equals, starts+                                                      , finishes, finishedBy+                                                      , overlaps, during+                                                      , contains, compose+                                                      , relate, startedBy+                                                      , overlappedBy, disjoint+                                                      , before, after, meets+                                                      , metBy, (<|>))+                                  , ComparativePredicateOf+                                  , Intervallic(begin, end)+                                  , Interval ) -mkIntrvl = unsafeInterval+mkIntrvl :: Int -> Int -> Interval Int+mkIntrvl = beginerval  xor :: Bool -> Bool -> Bool xor a b = a /= b@@ -27,16 +49,6 @@   | x <  0    = negate x   | otherwise = x --- | A function for creating intervals when you think you know what you're doing.-safeInterval :: Ord a => a -> a -> Interval a-safeInterval x y = unsafeInterval (min x y) (max x y)---- | Create a 'Maybe Interval a' from two @a@s.-safeInterval'' :: Ord a => a -> a -> Maybe (Interval a)-safeInterval'' x y-    | y <= x    = Nothing-    | otherwise = Just $ safeInterval x y- -- | A set used for testing M1 defined so that the M1 condition is true. data M1set a = M1set {      m11 :: Interval a@@ -66,7 +78,7 @@   where p1 = x                          -- interval i in prop_IAaxiomM1         p2 = beginerval a (end x)       -- interval j in prop_IAaxiomM1         p3 = beginerval b (end x)       -- interval k in prop_IAaxiomM1-        p4 = safeInterval  (begin (expandl (makePos c) p2)) (begin p2)+        p4 = enderval (makePos c) (begin p2)  {- @@ -144,18 +156,18 @@  \]  -} -prop_IAaxiomM2 :: (Show a, IntervalAlgebraic Interval a) => M2set a -> Property+prop_IAaxiomM2 :: (IntervalAlgebraic Interval a, IntervalSizeable a b) => M2set a -> Property prop_IAaxiomM2 x =   (i `meets` j && k `meets` l) ==>     (i `meets` l)  `xor`-    isJust m `xor`-    isJust n+    isRight m `xor`+    isRight n     where i = m21 x           j = m22 x           k = m23 x           l = m24 x-          m = safeInterval'' (end i) (begin l)-          n = safeInterval'' (end k) (begin j)+          m = parseInterval (end i) (begin l)+          n = parseInterval (end k) (begin j)  prop_IAaxiomM2_Int :: M2set Int -> Property prop_IAaxiomM2_Int = prop_IAaxiomM2@@ -221,8 +233,8 @@       b -> Interval a -> Property prop_IAaxiomM3 b i =    (j `meets` i && i `meets` k) === True-   where j = safeInterval (begin (expandl b i)) (begin i)-         k = safeInterval (end i) (end (expandr b i))+   where j = enderval   b (begin i) +         k = beginerval b (end i)  prop_IAaxiomM3_Int :: Interval Int -> Property prop_IAaxiomM3_Int = prop_IAaxiomM3 1@@ -243,15 +255,16 @@  prop_IAaxiomM4 :: (IntervalAlgebraic Interval a, IntervalSizeable a b)=>      b -> M2set a -> Property-prop_IAaxiomM4 moment x =+prop_IAaxiomM4 b x =    ((m `meets` i && i `meets` j && j `meets` n) &&     (m `meets` k && k `meets` n)) === True    where i = m21 x          j = m22 x-         m = safeInterval (begin (expandl moment i)) (begin i)-         n = safeInterval (end j) (end (expandr moment j))-         k = safeInterval (end m) (begin n)-+         m = enderval   b (begin i)+         n = beginerval b (end j)+         k = beginerval g (end m)+         g = diff (begin n) (end m)+  prop_IAaxiomM4_Int :: M2set Int -> Property prop_IAaxiomM4_Int = prop_IAaxiomM4 1 @@ -295,13 +308,15 @@         ps = end (expandr (makePos b) x) -- creating l by shifting and expanding i  -prop_IAaxiomM5 :: (Show a, IntervalAlgebraic Interval a) => M5set a -> Property+prop_IAaxiomM5 :: (IntervalAlgebraic Interval a, IntervalSizeable a b) => +    M5set a -> Property prop_IAaxiomM5 x =    ((i `meets` j && j `meets` l) &&     (i `meets` k && k `meets` l))  === (j == k)    where i = m51 x-         j = safeInterval (end i) (begin l)-         k = safeInterval (end i) (begin l)+         j = beginerval g (end i)+         k = beginerval g (end i)+         g = diff (begin l) (end i)          l = m52 x  prop_IAaxiomM5_Int :: M5set Int -> Property@@ -321,15 +336,15 @@ \]  -} -prop_IAaxiomM4_1 :: (IntervalSizeable a b, IntervalCombinable a)=>+prop_IAaxiomM4_1 :: (IntervalSizeable a b, IntervalCombinable Interval a)=>                     b -> M2set a -> Property prop_IAaxiomM4_1 b x =    ((m `meets` i && i `meets` j && j `meets` n) &&     (m `meets` ij && ij `meets` n)) === True    where i = m21 x          j = m22 x-         m = safeInterval (begin (expandl b i)) (begin i)-         n = safeInterval (end j) (end (expandr b j))+         m = enderval   b (begin i)+         n = beginerval b (end j)          ij = fromJust $ i .+. j  prop_IAaxiomM4_1_Int :: M2set Int -> Property@@ -342,47 +357,50 @@ * Interval Relation property testing  -} -class (IntervalAlgebraic Interval a, IntervalCombinable a)=> IntervalRelationProperties a where+class ( IntervalAlgebraic Interval a+      , IntervalCombinable Interval a+      , IntervalSizeable a b+      ) => IntervalRelationProperties a b where      prop_IAbefore :: Interval a -> Interval a -> Property     prop_IAbefore i j =       IA.before i j ==> (i `meets` k) && (k `meets` j)-        where k = safeInterval (end i) (begin j)+        where k = beginerval (diff (begin j) (end i)) (end i)      prop_IAstarts:: Interval a -> Interval a -> Property     prop_IAstarts i j       | IA.starts i j = (j == fromJust (i .+. k)) === True       | otherwise     = IA.starts i j === False-        where k  = safeInterval (end i) (end j)+        where k = beginerval (diff (end j) (end i)) (end i)      prop_IAfinishes:: Interval a -> Interval a -> Property     prop_IAfinishes i j       | IA.finishes i j = (j == fromJust ( k .+. i)) === True       | otherwise       = IA.finishes i j === False-        where k = safeInterval (begin j) (begin i)+        where k = beginerval (diff (begin i) (begin j)) (begin j)      prop_IAoverlaps:: Interval a -> Interval a -> Property     prop_IAoverlaps i j       | IA.overlaps i j = ((i == fromJust ( k .+. l )) &&                           (j == fromJust ( l .+. m ))) === True       | otherwise       = IA.overlaps i j === False-        where k = safeInterval (begin i) (begin j)-              l = safeInterval (begin j) (end i)-              m = safeInterval (end i)   (end j)+        where k = beginerval (diff (begin j) (begin i)) (begin i)+              l = beginerval (diff (end i)   (begin j)) (begin j)+              m = beginerval (diff (end j)   (end i))   (end i)      prop_IAduring:: Interval a -> Interval a-> Property     prop_IAduring i j       | IA.during i j = (j == fromJust ( fromJust (k .+. i) .+. l)) === True       | otherwise     = IA.during i j === False-        where k = safeInterval (begin j) (begin i)-              l = safeInterval (end i) (end j)+        where k = beginerval (diff (begin i) (begin j)) (begin j)+              l = beginerval (diff (end j)   (end i))   (end i)      -- | For any two pair of intervals exactly one 'IntervalRelation' should hold     prop_exclusiveRelations::  Interval a -> Interval a -> Property     prop_exclusiveRelations x y =       (  1 == length (filter id $ map (\r -> r x y) allIArelations)) === True -instance IntervalRelationProperties Int+instance IntervalRelationProperties Int Int  allIArelations:: IntervalAlgebraic Interval a => [ComparativePredicateOf (Interval a)] allIArelations =   [  IA.equals@@ -429,76 +447,68 @@       it "expandl doesn't change end"   $ property (prop_expandl_end @Int)       it "expandr doesn't change begin" $ property (prop_expandr_begin @Int)       it "expand 0 5 Interval (0, 1) should be Interval (0, 6)" $-        expand 0 5 (unsafeInterval (0::Int) (1::Int)) `shouldBe` unsafeInterval (0::Int) (6::Int)+        expand 0 5 (beginerval (1::Int) (0::Int)) `shouldBe` beginerval (6::Int) (0::Int)       it "expand 5 0 Interval (0, 1) should be Interval (-5, 1)" $-        expand 5 0 (unsafeInterval (0::Int) (1::Int)) `shouldBe` unsafeInterval (-5::Int) (1::Int)+        expand 5 0 (beginerval (1::Int) (0::Int)) `shouldBe` beginerval (6::Int) (-5::Int)       it "expand 5 5 Interval (0, 1) should be Interval (-5, 6)" $-        expand 5 5 (unsafeInterval (0::Int) (1::Int)) `shouldBe` unsafeInterval (-5::Int) (6::Int)+        expand 5 5 (beginerval (1::Int) (0::Int)) `shouldBe` beginerval (11::Int) (-5::Int)       it "expand -1 5 Interval (0, 1) should be Interval (-5, 6)" $-        expand (-1) 5 (unsafeInterval (0::Int) (1::Int)) `shouldBe` unsafeInterval (0::Int) (6::Int)+        expand (-1) 5 (beginerval (1::Int) (0::Int)) `shouldBe` beginerval (6::Int) (0::Int)        it "expand 5 -5 Interval (0, 1) should be Interval (-5, 1)" $-        expand 5 (-5) (unsafeInterval (0::Int) (1::Int)) `shouldBe` unsafeInterval (-5::Int) (1::Int)+        expand 5 (-5) (beginerval (1::Int) (0::Int)) `shouldBe` beginerval (6::Int) (-5::Int)       it "expand moment 0 Interval (0, 1) should be Interval (-1, 1)" $-        expand (moment @Int) 0 (unsafeInterval (0::Int) (1::Int)) `shouldBe`-         unsafeInterval (-1::Int) (1::Int)+        expand (moment @Int) 0 (beginerval (1::Int) (0::Int)) `shouldBe`+         beginerval (2::Int) (-1::Int)         it "beginerval 2 10 should be Interval (10, 12)" $-        beginerval (2::Int) 10 `shouldBe` unsafeInterval (10::Int) (12::Int)+        Right (beginerval (2::Int) 10) `shouldBe` parseInterval (10::Int) (12::Int)       it "beginerval 0 10 should be Interval (10, 11)" $-        beginerval (0::Int) 10 `shouldBe` unsafeInterval (10::Int) (11::Int)+        Right (beginerval (0::Int) 10) `shouldBe` parseInterval (10::Int) (11::Int)       it "beginerval -2 10 should be Interval (10, 11)" $-        beginerval (-2::Int) 10 `shouldBe` unsafeInterval (10::Int) (11::Int)+        Right (beginerval (-2::Int) 10) `shouldBe` parseInterval (10::Int) (11::Int)       it "enderval 2 10 should be Interval (8, 10)" $-        enderval (2::Int) 10 `shouldBe` unsafeInterval (8::Int) (10::Int)+        Right (enderval (2::Int) 10) `shouldBe` parseInterval (8::Int) (10::Int)       it "enderval 0 10 should be Interval (9, 10)" $-        enderval (0::Int) 10 `shouldBe` unsafeInterval (9::Int) (10::Int)+        Right (enderval (0::Int) 10) `shouldBe` parseInterval (9::Int) (10::Int)       it "enderval -2 10 should be Interval (9, 10)" $-        enderval (-2::Int) 10 `shouldBe` unsafeInterval (9::Int) (10::Int)+        Right (enderval (-2::Int) 10) `shouldBe` parseInterval (9::Int) (10::Int)    describe "IntervalAlgebraic tests" $      modifyMaxSuccess (*10000) $      do       it "(startedBy <|> overlappedBy) Interval (0, 9) Interval (-1, 4) is True" $-        (startedBy <|> overlappedBy) (mkIntrvl (0::Int) (9::Int)) (mkIntrvl (-1::Int) (4::Int))+        (startedBy <|> overlappedBy) (mkIntrvl 9 0) (mkIntrvl 5 (-1))          `shouldBe` True       it "(startedBy <|> overlappedBy) Interval (0, 9) Interval (0, 4) is True" $-        (startedBy <|> overlappedBy) (mkIntrvl (0::Int) (9::Int)) (mkIntrvl (0::Int) (4::Int))+        (startedBy <|> overlappedBy) (mkIntrvl 9 0) (mkIntrvl 4 0)          `shouldBe` True       it "(startedBy <|> overlappedBy) Interval (0, 9) Interval (-1, 9) is False" $-        (startedBy <|> overlappedBy) (mkIntrvl (0::Int) (9::Int)) (mkIntrvl (-1::Int) (9::Int))+        (startedBy <|> overlappedBy) (mkIntrvl 9 0) (mkIntrvl 10 (-1))          `shouldBe` False       it "disjoint x y same as explicit union of predicates" $-         disjoint (mkIntrvl (0::Int) (2::Int)) (mkIntrvl (3::Int) (5::Int)) `shouldBe`-         (before <|> after <|> meets <|> metBy) (mkIntrvl (0::Int) (2::Int)) (mkIntrvl (3::Int) (5::Int))+         disjoint (mkIntrvl 2 0) (mkIntrvl 2 3) `shouldBe`+         (before <|> after <|> meets <|> metBy) (mkIntrvl 2 0) (mkIntrvl 2 3)       it "prop_compose holds" $          property (prop_compose @Int)    describe "IntervalCombinable tests" $     do       it "intersection of (0, 2) (2, 4) should be Nothing" $-        intersect (mkIntrvl (0::Int) (2::Int)) (mkIntrvl (2::Int) (4::Int)) -          `shouldBe` Nothing+        intersect (mkIntrvl 2 0) (mkIntrvl 2 2)    `shouldBe` Nothing       it "intersection of (0, 2) (3, 4) should be Nothing" $-        intersect (mkIntrvl (0::Int) (2::Int)) (mkIntrvl (3::Int) (4::Int)) -          `shouldBe` Nothing+        intersect (mkIntrvl 2 0) (mkIntrvl 1 3)    `shouldBe` Nothing       it "intersection of (2, 4) (0, 2) should be Nothing" $-        intersect (mkIntrvl (2::Int) (4::Int)) (mkIntrvl (0::Int) (2::Int)) -          `shouldBe` Nothing+        intersect (mkIntrvl 2 2) (mkIntrvl 2 0)    `shouldBe` Nothing       it "intersection of (0, 2) (1, 3) should be Just (1, 2)" $-        intersect (mkIntrvl (0::Int) (2::Int)) (mkIntrvl (1::Int) (3::Int)) -          `shouldBe` Just (mkIntrvl 1 2)+        intersect (mkIntrvl 2 0) (mkIntrvl 2 1)    `shouldBe` Just (mkIntrvl 1 1)       it "intersection of (0, 2) (-1, 3) should be Just (0, 2)" $-        intersect (mkIntrvl (0::Int) (2::Int)) (mkIntrvl (-1::Int) (3::Int)) -          `shouldBe` Just (mkIntrvl 0 2)+        intersect (mkIntrvl 2 0) (mkIntrvl 4 (-1)) `shouldBe` Just (mkIntrvl 2 0)       it "intersection of (0, 2) (0, 2) should be Just (0, 2)" $-        intersect (mkIntrvl (0::Int) (2::Int)) (mkIntrvl (0::Int) (2::Int)) -          `shouldBe` Just (mkIntrvl 0 2)+        intersect (mkIntrvl 2 0) (mkIntrvl 2 0)    `shouldBe` Just (mkIntrvl 2 0)       it "intersection of (0, 2) (-1, 1) should be Just (0, 1)" $-        intersect (mkIntrvl (0::Int) (2::Int)) (mkIntrvl (-1::Int) (1::Int)) -          `shouldBe` Just (mkIntrvl 0 1)+        intersect (mkIntrvl 2 0) (mkIntrvl 2 (-1)) `shouldBe` Just (mkIntrvl 1 0)       it "intersection of (0, 3) (1, 2) should be Just (1, 2)" $-        intersect (mkIntrvl (0::Int) (3::Int)) (mkIntrvl (1::Int) (2::Int)) -          `shouldBe` Just (mkIntrvl 1 2)+        intersect (mkIntrvl 3 0) (mkIntrvl 1 1)    `shouldBe` Just (mkIntrvl 1 1)    describe "Interval Algebra Axioms for meets properties" $     modifyMaxSuccess (*10) $