interval-algebra 0.6.3 → 0.7.0

raw patch · 7 files changed

+656/−231 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• interval-algebra.cabal +1/−1
• src/IntervalAlgebra.hs +38/−49
• src/IntervalAlgebra/IntervalUtilities.hs +278/−82
• src/IntervalAlgebra/PairedInterval.hs +61/−19
• test/IntervalAlgebra/IntervalUtilitiesSpec.hs +262/−60
• test/IntervalAlgebraSpec.hs +5/−20

@@ -1,5 +1,16 @@ # Changelog for interval-algebra +## 0.7.0++* Adds a `Bifunctor` instance for `PairedInterval`s.+* Adds the two new functions to `IntervalUtilites`:+  * `foldMeetingSafe`: Folds over a list of Paired Intervals and in the case that the 'getPairData' is equal between two sequential meeting intervals, these two intervals are combined into one. This function is "safe" in the sense that if the input is invalid and contains any sequential pairs of intervals with an `IntervalRelation`, other than `Meets`, then the function returns an empty list.+  * `formMeetingSequence`: Converts an ordered sequence of `PairedInterval b a` that may have any interval relation+('before', 'starts', etc) into a sequence of sequentially meeting `PairedInterval b a`.  That is, a sequence where one the end of one interval meets the beginning of the subsequent interval. The `getPairData` of the input `PairedInterval`s are+combined using the Monoid `<>` function, hence the pair data must be a `Monoid` instance.+* Renames `pairData` accessor function to `getPairData` in PairedInterval module.+* Removes the `unsafeInterval` function.+ ## 0.6.3  * Extends the `IntervalCombinable` class to operate on general `Interval` containers.

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

@@ -61,7 +61,6 @@     -- * Types     , Interval     , parseInterval-    , unsafeInterval     , IntervalRelation(..)     , ComparativePredicateOf @@ -78,8 +77,10 @@                , Maybe(..), Either(..), String, Integer, Int, Bool(..), Num                , Foldable (maximum, minimum, foldMap, foldr)                , map, otherwise, flip, show, fst, snd, min, max, any, negate, not-               , replicate, id+               , replicate, id, uncurry                , (++), (==), (&&), (<), (>), (<=), ($), (+), (-), (.), (!!))+import Data.Monoid ( (<>), Monoid )               +import Data.Functor ( Functor(fmap) ) import Data.Time as DT ( Day, addDays, diffDays, addGregorianYearsClip, calendarYear ) import Data.Semigroup ( Semigroup((<>)) ) import Data.Set(Set, fromList, difference, intersection, union, map, toList)@@ -87,12 +88,11 @@ import GHC.Base (Applicative(pure))  {- | An @'Interval' a@ is a pair of @a@s \( (x, y) \text{ where } x < y\). The-@'Intervallic'@ class provides a safe @'parseInterval'@ function that returns a -@'Left'@ error if \(y < x\) and 'unsafeInterval' as constructor for creating an-interval that may not be valid. +@'parseInterval'@ function that returns @'Left'@ error if \(y < x\) and+@'Right' 'Interval'@ otherwise.  -} newtype Interval a = Interval (a, a) deriving (Eq)-+     -- | Safely parse a pair of @a@s to create an @'Interval' a@. parseInterval :: (Show a, Ord a) => a -> a -> Either String (Interval a) parseInterval x y@@ -100,14 +100,6 @@     |  y < x    = Left  $ show y ++ "<" ++ show x     | otherwise = Right $ Interval (x, y) -{- | Create a new @'Interval' a@. This function is __not__ safe as it does -    not enforce that \(x < y\). Use with caution. It is meant to be helper -    function in early prototyping of this package. This function may be -    deprecated in future releases.--}-unsafeInterval :: a -> a -> Interval a-unsafeInterval x y = Interval (x, y)- intervalBegin :: Interval a -> a intervalBegin (Interval x) = fst x @@ -559,46 +551,35 @@     where s = min (begin x) (begin y)           e = max (end x) (end y) + {- | The @'IntervalCombinable'@ typeclass provides methods for (possibly) combining two @i a@s to form an @'Interval'@. -} class (IntervalAlgebraic i a) => IntervalCombinable i a where -    -- | Maybe form a new @'Interval'@ by the union of two @'Interval'@s that 'meets'.-    (.+.) :: i a -> i a -> Maybe (Interval a)+    -- | Maybe form a new @i a@ by the union of two @i a@s that 'meets'.+    (.+.) ::   i a -> i a -> Maybe (i a)     (.+.) x y-      | x `meets` y = Just $ Interval (begin x, end y)+      | x `meets` y = Just $ setInterval y $ Interval (b, e)       | otherwise   = Nothing+      where b = begin x+            e = end y      -- | 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'.-    (><) ::  i a -> i a -> Maybe (Interval a)-    (><) x y-        | x `before` y = Just $ Interval ( end x, begin y )-        | otherwise    = Nothing-+    (><) :: i a -> i a -> Maybe (i a)+      -- | If @x@ is 'before' @y@, return @f x@ appended to @f y@. Otherwise,      --   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 (i a)), Semigroup (f (Interval a)), Applicative f) =>-            i a ->-            i a ->-            f (Interval a)-    (<+>) x y-      | x `before` y = pure (getInterval x) <> pure (getInterval y)-      | otherwise    = pure ( extenterval x y )+    (<+>):: ( Semigroup (f (i a)), Applicative f) =>+               i a+            -> i a+            -> f (i a) -    -- | Forms a 'Just' new interval from the intersection of two intervals, -    --   provided the intervals are not disjoint.-    intersect :: i a -> i a -> Maybe (Interval a)-    intersect x y-       | disjoint x y = Nothing-       | otherwise    = Just $ Interval (b, e)-           where b = max (begin x) (begin y)-                 e = min (end x) (end y)  -- {- -- Instances@@ -616,6 +597,9 @@       | begin x == begin y = end x < end y       | otherwise = False +instance Functor Interval where+    fmap f (Interval (x, y)) = Interval (f x, f y)+ instance (Intervallic Interval a) => Show (Interval a) where    show x = "(" ++ show (begin x) ++ ", " ++ show (end x) ++ ")" @@ -623,23 +607,28 @@     getInterval = id     setInterval _ x = x -instance IntervalAlgebraic Interval Int-instance IntervalCombinable Interval Int+instance (Eq a, Ord a, Show a) => IntervalAlgebraic Interval a++instance (Ord a, Show a) => IntervalCombinable Interval a where+    (><) x y+        | x `before` y = Just $ Interval (end x, begin y)+        | otherwise    = Nothing++    (<+>) x y+        | x `before` y = pure ( getInterval x ) <> pure ( getInterval y )+        | otherwise    = pure ( extenterval x y )+ instance IntervalSizeable Int Int where     moment = 1-    add = (+)-    diff = (-)+    add    = (+)+    diff   = (-) -instance IntervalAlgebraic Interval Integer-instance IntervalCombinable Interval Integer instance IntervalSizeable Integer Integer where     moment = 1-    add = (+)-    diff = (-)+    add    = (+)+    diff   = (-) -instance IntervalAlgebraic Interval DT.Day-instance IntervalCombinable Interval DT.Day instance IntervalSizeable DT.Day Integer where     moment = 1-    add = addDays-    diff = diffDays+    add    = addDays+    diff   = diffDays

@@ -1,6 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-} {-| Module      : Interval Algebra Utilities Description : Functions for operating on containers of Intervals.@@ -12,21 +9,31 @@ In the examples below, @iv@ is a synonym for 'beginerval' used to save space. -} +{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+ module IntervalAlgebra.IntervalUtilities (-      combineIntervals+      relations+    , relations'+    , intersect+    , combineIntervals     , combineIntervals'     , gaps     , gaps'     , durations     , clip-    , relations-    , relations'     , gapsWithin     , nothingIf     , nothingIfNone     , nothingIfAny     , nothingIfAll +    -- * Operations on Meeting sequences of intervals+    , foldMeetingSafe+    , formMeetingSequence+     -- * Filtering functions     , compareIntervals     , filterBefore@@ -51,17 +58,25 @@  ) where -import GHC.Base         ( otherwise, ($), (.), (<*>), seq, not-                        , Semigroup((<>))-                        , Functor(fmap)-                        , Applicative(pure)-                        , Int, Bool, Ord)-import GHC.Num          ()-import Data.Tuple       ( fst )+import GHC.Base         ( (<*>), seq)+import GHC.Show         ( Show )+import GHC.Num          ( )+import GHC.Int          ( Int ) +import Control.Applicative+                        ( Applicative(pure) )+import Data.Bool        ( Bool, otherwise, not )+import Data.Eq          ( Eq((==)) ) import Data.Foldable    ( Foldable(null, foldl', toList), all, any )-import Data.Monoid      ( (<>), Monoid(mempty) )-import Data.Maybe       (mapMaybe, catMaybes, fromMaybe, Maybe(..))+import Data.Function    ( ($), (.), flip )+import Data.Functor     ( Functor(fmap) )+import Data.Monoid      ( Monoid(mempty) )+import Data.Maybe       ( Maybe(..), maybe, maybeToList, mapMaybe, catMaybes, fromMaybe ) import Data.List        ( (++), map )+import Data.Ord         ( Ord(min, max) )+import Data.Semigroup   ( Semigroup((<>)) )+import Data.Tuple       ( fst )+import Safe             ( headMay, lastMay, initSafe, tailSafe)+import Witherable       ( Filterable(filter) ) import IntervalAlgebra  ( Interval                         , Intervallic(..)                         , IntervalAlgebraic(..)@@ -70,14 +85,18 @@                         , IntervalRelation(..)                         , ComparativePredicateOf                         , beginerval-                        , enderval)-import Safe             ( headMay, lastMay, initSafe, tailSafe)-import Witherable       ( Filterable(filter) )-+                        , enderval+                        , extenterval )+import IntervalAlgebra.PairedInterval+                        ( PairedInterval+                        , mkPairedInterval+                        , getPairData+                        , equalPairData ) ------------------------------------------------- -- Unexported utilties used in functions below -- ------------------------------------------------- +-- Just a synonym used to examples to save typing iv :: Int -> Int -> Interval Int iv = beginerval @@ -96,57 +115,59 @@     -> b              -- ^ this will be the second argument to @f@     -> (f a, Maybe b) applyAccume f (fs, Nothing) x = (fs, Just x)-applyAccume f (fs, Just x)  y  = (fs <> pure (f x y), Just y)+applyAccume f (fs, Just x)  y = (fs <> pure (f x y), Just y)  -- Lifts a list to a foldable, applicative monoid -liftListToFoldable :: (Applicative f+liftListToFoldable :: ( Applicative f                       , Monoid (f a)                       , Foldable f) =>     [a] -> f a liftListToFoldable = foldl' (\x y -> x <> pure y) mempty --- Box to avoid overlapping instances-newtype Box a = Box { unBox :: [a] }---- Defines how a Box of Intervals are combined. Specifically, the last element of--- x and first element of y are combined by '<+>'.-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---------------------------------------------------+-- Used to combine two lists by combining the last element of @x@ and the first +-- element of @y@ by @f@. The combining function @f@ will generally return a +-- singleton list in the case that the last of x and head of y can be combined+-- or a two element list in the case they cannot.+listCombiner :: (Maybe a -> Maybe a -> [a]) -- ^ f+                -> [a] -- ^ x+                -> [a] -- ^ y+                -> [a]+listCombiner f x y = initSafe x ++ f (lastMay x) (headMay y) ++ tailSafe 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.+-- | Returns a list of the 'IntervalRelation' between each consecutive pair +--   of intervals. This the specialized form of 'relations'' which can return+--   any 'Applicative', 'Monoid' structure. ----- >>> combineIntervals [iv 10 0, iv 5 2, iv 2 10, iv 2 13]--- [(0, 12),(13, 15)]-combineIntervals :: (IntervalCombinable Interval a-         , Applicative f-         , Monoid (f (Interval a))-         , Foldable f) =>-      f (Interval a) ->-      f (Interval a)-combineIntervals x = liftListToFoldable (combineIntervals' $ toList x)+-- >>> relations [iv 1 0, iv 1 1] +-- [Meets]+relations :: (IntervalAlgebraic i a, Foldable f)=>+       f (i a)+    -> [IntervalRelation (i a)]+relations = relations' --- | Returns a list of intervals where any intervals that meet or share support---   are combined into one interval. *To work properly, the input list should ---   be sorted*. +-- | A generic form of 'relations' which can output any 'Applicative' and +--   'Monoid' structure. +-- >>> (relations' [iv 1 0, iv 1 1]) :: [IntervalRelation (Interval Int)]+-- [Meets] ----- >>> combineIntervals' [iv 10 0, iv 5 2, iv 2 10, iv 2 13]--- [(0, 12),(13, 15)]-combineIntervals' :: (IntervalCombinable Interval a) => [Interval a] -> [Interval a]-combineIntervals' l = unBox $ foldl' (<>) (Box []) (map (\z -> Box [z]) l)+relations' :: ( IntervalAlgebraic i a+              , Foldable f+              , Applicative m+              , Monoid (m (IntervalRelation (i a))) )=>+        f (i a)+     -> m (IntervalRelation (i a))+relations' = foldlAccume relate +-- | Forms a 'Just' new interval from the intersection of two intervals, +--   provided the intervals are not disjoint.+intersect :: (IntervalSizeable a b, IntervalAlgebraic i a) => +    i a -> i a -> Maybe (Interval a)+intersect x y+    | disjoint x y = Nothing+    | otherwise    = Just $ beginerval (diff e b) b+        where b = max (begin x) (begin y)+              e = min (end x) (end y)+ -- | 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.@@ -202,30 +223,6 @@    where jy = equals <|> startedBy <|> contains <|> finishedBy          jx = starts <|> during <|> finishes --- | Returns a list of the 'IntervalRelation' between each consecutive pair ---   of intervals. This the specialized form of 'relations'' which can return---   any 'Applicative', 'Monoid' structure.------ >>> relations [iv 1 0, iv 1 1] --- [Meets]-relations :: (IntervalAlgebraic i a, Foldable f)=>-       f (i a)-    -> [IntervalRelation (i a)]-relations = relations'---- | A generic form of 'relations' which can output any 'Applicative' and ---   'Monoid' structure. --- >>> (relations' [iv 1 0, iv 1 1]) :: [IntervalRelation (Interval Int)]--- [Meets]----relations' :: ( IntervalAlgebraic i a-              , Foldable f-              , Applicative m-              , Monoid (m (IntervalRelation (i a))) )=>-        f (i a)-     -> m (IntervalRelation (i a))-relations' = foldlAccume relate- -- | Applies 'gaps' to all the non-disjoint intervals in @x@ that are *not* disjoint -- from @i@. Intervals that 'overlaps' or are 'overlappedBy' @i@ are 'clip'ped  -- to @i@, so that all the intervals are 'within' @i@. If there are no gaps, then@@ -252,6 +249,53 @@               nd  = toList (filterNotDisjoint i x)               ivs = liftListToFoldable (mapMaybe (clip i) nd) +-- The Box is an internal type used to hold accumulated, combined intervals in +-- 'combineIntervals''.+newtype Box a = Box { unBox :: [a] }++packBoxes :: [a] -> [Box a]+packBoxes  = Data.List.map (\z -> Box [z])++instance (Ord a, Show a, IntervalCombinable i a) => Semigroup (Box (i a)) where+    Box x <> Box y = Box $ listCombiner (<->) 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 [iv 10 0, iv 5 2, iv 2 10, iv 2 13]+-- [(0, 12),(13, 15)]+combineIntervals :: ( IntervalAlgebraic Interval a+                    , Applicative f+                    , Monoid (f (Interval a))+                    , Foldable f ) =>+      f (Interval a) ->+      f (Interval a)+combineIntervals x = liftListToFoldable (combineIntervals' $ toList x)++-- | Returns a list of intervals where any intervals that meet or share support+--   are combined into one interval. *To work properly, the input list should +--   be sorted*. +--+-- >>> combineIntervals' [iv 10 0, iv 5 2, iv 2 10, iv 2 13]+-- [(0, 12),(13, 15)]+combineIntervals' :: (IntervalAlgebraic Interval a) => +        [Interval a] -> [Interval a]+combineIntervals' l = unBox $ foldl' (<>) (Box []) (packBoxes l)++-- Internal function for combining maybe intervals in the 'combineIntervals'' +-- function+(<->) :: (IntervalCombinable i a) =>+       Maybe (i a)+    -> Maybe (i a)+    -> [i a]+(<->) Nothing Nothing   = []+(<->) Nothing (Just y)  = [y]+(<->) (Just x) Nothing  = [x]+(<->) (Just x) (Just y) = (<+>) x y+++ -- | Given a predicate combinator, a predicate, and list of intervals, returns  --   the input unchanged if the predicate combinator is @True@. Otherwise, returns --   an empty list. See 'nothingIfAny' and 'nothingIfNone' for examples.@@ -472,3 +516,155 @@                   , IntervalAlgebraic i1 a) =>                   i0 a -> f (i1 a) -> f (i1 a) filterEnclosedBy = filterMaker enclosedBy++-- | Folds over a list of Paired Intervals and in the case that the 'getPairData' +--   is equal between two sequential meeting intervals, these two intervals are +--   combined into one. This function is "safe" in the sense that if the input is+--   invalid and contains any sequential pairs of intervals with an @IntervalRelation@,+--   other than 'Meets', then the function returns an empty list. +foldMeetingSafe :: ( IntervalAlgebraic (PairedInterval b) a, Eq b) =>+           [ PairedInterval b a ] -- ^ Be sure this only contains intervals that sequentially 'meet'.+        -> [ PairedInterval b a ]+foldMeetingSafe l = maybe [] (getMeeting . foldMeeting) (parseMeeting l)++-- | Folds over a list of Meeting Paired Intervals and in the case that the 'getPairData' +--   is equal between two sequential meeting intervals, these two intervals are +--   combined into one.  +foldMeeting :: ( IntervalAlgebraic (PairedInterval b) a, Eq b) =>+            Meeting [PairedInterval b a ]+        ->  Meeting [PairedInterval b a ]+foldMeeting (Meeting l) = foldl' joinMeetingPairedInterval (Meeting []) (packMeeting l)++-- This type identifies that @a@ contains intervals that sequentially meet one +-- another.+newtype Meeting a = Meeting { getMeeting :: a } deriving (Eq, Show)++-- Box up Meeting.+packMeeting :: [a] -> [Meeting [a]]+packMeeting = Data.List.map (\z -> Meeting [z])++-- Test a list of intervals to be sure they all meet; if not return Nothing.+parseMeeting :: (IntervalAlgebraic i a)=> [i a] -> Maybe (Meeting [i a])+parseMeeting x+    | all ( == Meets ) (relations x) = Just $ Meeting x+    | otherwise = Nothing++-- A specific case of 'joinMeeting' for @PairedIntervals@.+joinMeetingPairedInterval :: (Eq b, Ord a, Show a) =>+                  Meeting [PairedInterval b a]+               -> Meeting [PairedInterval b a]+               -> Meeting [PairedInterval b a]+joinMeetingPairedInterval = joinMeeting equalPairData++-- A general function for combining any two @Meeting [i a]@ by 'listCombiner'.+joinMeeting :: (IntervalAlgebraic i a) =>+       ComparativePredicateOf (i a)+    -> Meeting [ i a ]+    -> Meeting [ i a ]+    -> Meeting [ i a ]+joinMeeting f (Meeting x) (Meeting y) = Meeting $ listCombiner (join2MeetingWhen f) x y++-- The intervals @x@ and @y@ should meet! The predicate function @p@ determines+-- when the two intervals that meet should be combined.+join2MeetingWhen :: (IntervalAlgebraic i a) =>+       ComparativePredicateOf (i a)+    -> Maybe (i a)+    -> Maybe (i a)+    -> [i a]+join2MeetingWhen p Nothing Nothing   = []+join2MeetingWhen p Nothing (Just y)  = [y]+join2MeetingWhen p (Just x) Nothing  = [x]+join2MeetingWhen p (Just x) (Just y)+    | p x y      = [ setInterval y (extenterval x y) ]+    | otherwise  =  pure x <> pure y++{- | +Takes two *ordered* events, x <= y, and "disjoins" them in the case that the+two events have different states, creating a sequence (list) of new events that +sequentially meet one another. Since x <= y, there are 7 possible interval+relations between x and y. If the states of x and y are equal and x is not +before y, then x and y are combined into a single event. +-}+disjoinPaired :: ( Eq b+                 , Monoid b+                 , IntervalAlgebraic (PairedInterval b) a+                 , IntervalSizeable a c) =>+       (PairedInterval b) a+    -> (PairedInterval b) a+    -> Meeting [(PairedInterval b) a]+disjoinPaired o e+   | x `before` y      = Meeting [ x, evp e1 b2 mempty, y ]+   | x `meets` y       = foldMeeting $ Meeting [ x, y ]+   | x `overlaps` y    = foldMeeting $ Meeting [ evp b1 b2 s1, evp b2 e1 sc, evp e1 e2 s2 ]+   | x `finishedBy` y  = foldMeeting $ Meeting [ evp b1 b2 s1, ev i2 sc ]+   | x `contains` y    = foldMeeting $ Meeting [ evp b1 b2 s1, evp b2 e2 sc, evp e2 e1 s1 ]+   | x `starts` y      = foldMeeting $ Meeting [ ev i1 sc, evp e1 e2 s2 ]+   | x `equals` y      = Meeting [ ev i1 sc ]+   where x  = min o e+         y  = max o e+         i1 = getInterval x+         i2 = getInterval y+         s1 = getPairData x+         s2 = getPairData y+         sc = s1 <> s2+         b1 = begin x+         b2 = begin y+         e1 = end x+         e2 = end y+         ev = flip mkPairedInterval+         evp = \b e s -> ev (beginerval (diff e b) b) s++{- | +The internal function for converting a non-disjoint, ordered sequence of+events into a disjoint, ordered sequence of events. The function operates+by recursion on a pair of events and the input events. The first of the +is the accumulator set -- the disjoint events that need no longer be +compared to input events. The second of the pair are disjoint events that+still need to be compared to be input events. +-}+mtEvt :: ( Monoid b, Eq b, IntervalSizeable a c) =>+       ([(PairedInterval b) a ], [(PairedInterval b) a ])+    -> [(PairedInterval b) a ]+    -> [(PairedInterval b) a ]+mtEvt (acc, o:os) []     = acc ++ o:os           -- the "final" pattern+mtEvt (acc, [])   []     = acc                 -- another "final" pattern +mtEvt (acc, [])   (e:es) = mtEvt (acc, [e]) es -- the "initialize" pattern+mtEvt (acc, o:os) (e:es)                       -- the "operating" patterns +     -- If input event is equal to the first comparator, skip the comparison.+    | e == o    = mtEvt (acc, o:os) es++     {- If the period of o is either before or meets the period of e, then +     the first of the combined events can be put into the accumulator. +     That is, since the inputs events are ordered, once the beginning of o +     is before or meets e, then we are assured that all periods up to the +     beginning of o are fully disjoint and subsequent input events will +     not overlap these in any way. -}+    | (before <|> meets) o e = mtEvt (acc ++ nh, mtEvt ([], nt) os ) es++    --The standard recursive operation.+    | otherwise = mtEvt (acc,  mtEvt ([], n) os ) es+  where n  = getMeeting $ disjoinPaired o e+        nh = maybeToList (headMay n)+        nt = tailSafe n++{- | +Convert an ordered sequence of @PairedInterval b a@. that may have any interval relation+('before', 'starts', etc) into a sequence of sequentially meeting @PairedInterval b a@. +That is, a sequence where one the end of one interval meets the beginning of +the subsequent event. The 'getPairData' of the input @PairedIntervals@ are+combined using the Monoid '<>' function, hence the pair data must be a +'Monoid' instance.+-}+formMeetingSequence :: ( Eq b+                       , Monoid b+                       , IntervalSizeable a c) =>+           [ PairedInterval b a ]+        -> [ PairedInterval b a ]+formMeetingSequence x = mtEvt ([], []) (mtEvt ([], []) x) +   -- the second pass of mtEvt is to handle the situation where the first pass+   -- disjoins all the events correctly into a meeting sequence but -- due to +   -- nesting of intervals in the input -- some of the sequential pairs have+   -- the same data after the first pass. The second pass merges any sequential+   -- intervals that have the same data.+   --+   -- There is probably a more efficient way to do this.

@@ -14,18 +14,22 @@ module IntervalAlgebra.PairedInterval (       PairedInterval     , mkPairedInterval-    , pairData+    , getPairData     , intervals-    , makePairPredicate+    , equalPairData+    , toTrivialPair+    , trivialize+    -- , makePairPredicate ) where -import IntervalAlgebra-    ( Interval-    , Intervallic(..)-    , IntervalAlgebraic(..)-    , ComparativePredicateOf )-import IntervalAlgebra.IntervalUtilities(compareIntervals, filterOverlaps)-import Witherable ( Filterable(filter) )+import IntervalAlgebra  ( Interval+                        , Intervallic(..)+                        , IntervalAlgebraic(..)+                        , IntervalCombinable(..)+                        , ComparativePredicateOf+                        , extenterval )+import Witherable       ( Filterable(filter) )+import Data.Bifunctor   ( Bifunctor(bimap) )  -- | An @Interval a@ paired with some other data of type @b@. newtype PairedInterval b a = PairedInterval (Interval a, b)@@ -35,33 +39,71 @@     getInterval (PairedInterval x)        = fst x     setInterval (PairedInterval (x, y)) i = PairedInterval (i, y) +instance Bifunctor PairedInterval where+    bimap f g (PairedInterval (x, y)) = PairedInterval (fmap g x, f y)+ -- | Defines A total ordering on 'PairedInterval b a' based on the 'Interval a' --   part. instance (Eq a, Eq b, Ord a, Show a) => Ord (PairedInterval b a) where   (<=) x y = getInterval x <= getInterval y   (<) x y  = getInterval x <  getInterval y -instance (Eq b) => IntervalAlgebraic (PairedInterval b) Int +instance (Eq b, Show a, Ord a) => IntervalAlgebraic (PairedInterval b) a  +instance (Show b, Show a, Ord a) => Show (PairedInterval b a) where+    show x = "{" ++ show (getInterval x) ++ ", " ++ show (getPairData x) ++ "}"++instance (Ord a, Show a, Eq b, Monoid b) => +          IntervalCombinable (PairedInterval b) a where+    (><) x y = fmap (mkPairedInterval mempty) (getInterval x >< getInterval y)++    (<+>) x y+        | x `before` y = pure x <> pure y+        | otherwise    = pure $ mkPairedInterval (getPairData x <> getPairData y)+                                                 (extenterval x y) ++ -- | Make a paired interval.  mkPairedInterval :: b -> Interval a -> PairedInterval b a mkPairedInterval d i = PairedInterval (i, d)  -- | Gets the data (i.e. non-interval) part of a @PairedInterval@.-pairData :: PairedInterval b a -> b-pairData (PairedInterval (_, y)) = y+getPairData :: PairedInterval b a -> b+getPairData (PairedInterval (_, y)) = y +-- | Tests for equality of the data in a @PairedInterval@.+equalPairData :: (Eq b) => ComparativePredicateOf (PairedInterval b a)+equalPairData x y = getPairData x == getPairData y+ -- | Gets the intervals from a list of paired intervals. intervals :: (Ord a, Show a) => [PairedInterval b a] -> [Interval a] intervals = map getInterval +-- Empty is used to trivially lift an @Interval a@ into a @PairedInterval@+data Empty = Empty deriving (Eq, Ord, Show)+instance Semigroup Empty where +    x <> y = Empty+instance Monoid Empty where+    mempty = Empty+    mappend x y = x <> y++-- | Lifts an @Interval a@ into a @PairedInterval Empty a@, where @Empty@ is a+--   trivial type that contains no data.+toTrivialPair :: Interval a -> PairedInterval Empty a+toTrivialPair = mkPairedInterval Empty++-- | Lifts a @Functor@ containing @Interval a@(s) into a @Functor@ containing+--   @PairedInterval Empty a@(s).+trivialize :: Functor f => f (Interval a) -> f (PairedInterval Empty a)+trivialize = fmap toTrivialPair+ -- | Takes a predicate of intervals and a predicate on the data part of a  --   paired interval to create a single predicate such that both input --   predicates should hold.-makePairPredicate :: (IntervalAlgebraic (PairedInterval b) a) =>-       ComparativePredicateOf (Interval a)-    -> ComparativePredicateOf b-    -> ComparativePredicateOf (PairedInterval b a)-makePairPredicate intervalPredicate dataPredicate x y =-         compareIntervals intervalPredicate x y &&-         dataPredicate (pairData x) (pairData y)+-- makePairPredicate :: (IntervalAlgebraic (PairedInterval b) a) =>+--        ComparativePredicateOf (Interval a)+--     -> ComparativePredicateOf b+--     -> ComparativePredicateOf (PairedInterval b a)+-- makePairPredicate intervalPredicate dataPredicate x y =+--          compareIntervals intervalPredicate x y &&+--          dataPredicate (getPairData x) (getPairData y)

@@ -1,81 +1,209 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE FlexibleInstances #-} module IntervalAlgebra.IntervalUtilitiesSpec (spec) where  import Test.Hspec.QuickCheck              ( modifyMaxSuccess ) import Test.Hspec                         ( Spec-                                          , it, shouldBe, describe, pending )-import Test.QuickCheck                    ( Property, Testable(property)-                                          , (===))+                                          , it, shouldBe, describe, pending, xcontext )+import Test.QuickCheck                    ( Property+                                          , Testable(property)+                                          , Arbitrary(arbitrary, shrink)+                                          , suchThat+                                          , (===), (==>)+                                          , Arbitrary1 (liftArbitrary), listOf, orderedList) import Data.List                          (sort)-import IntervalAlgebra.Arbitrary          ()+import IntervalAlgebra.Arbitrary          ( ) import IntervalAlgebra                    ( Interval                                           , Intervallic(..)                                           , IntervalCombinable(..)                                           , IntervalAlgebraic(..)                                           , IntervalRelation (..)-                                          , beginerval)-import IntervalAlgebra.IntervalUtilities  ( combineIntervals-                                          , gaps+                                          , beginerval, IntervalSizeable )+import IntervalAlgebra.IntervalUtilities  ( gaps                                           , durations-                                          , clip+                                          , intersect                                           , relations+                                          , clip                                           , gapsWithin                                           , nothingIfNone                                           , filterDisjoint-                                          , filterNotDisjoint )+                                          , filterNotDisjoint+                                          , combineIntervals+                                          , foldMeetingSafe+                                          , formMeetingSequence )+import IntervalAlgebra.PairedInterval     ( trivialize+                                          , mkPairedInterval+                                          , PairedInterval, getPairData )+import Control.Monad                      ( liftM2 )+import Data.Foldable -intInt :: Int -> Int -> Interval Int-intInt = beginerval+-- Types for testing +-- 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++instance Arbitrary State where+   arbitrary =  State <$> suchThat (listOf arbitrary) (\x -> length x == 3)++instance Arbitrary (PairedInterval State Int) where+   arbitrary = liftM2 mkPairedInterval arbitrary arbitrary++instance Arbitrary (Events Int) where+   arbitrary = Events <$> orderedList+++-- Testing functions+checkSeqStates :: (IntervalAlgebraic i Int)=> [i Int] -> Bool+checkSeqStates x = (length x > 1) || all (== Meets) (relations x)++-- Creation functions+iv :: Int -> Int -> Interval Int+iv = beginerval++evpi :: Int -> Int -> [Bool] -> StateEvent Int+evpi i j s = mkPairedInterval (State s) (beginerval i j)++-- Test cases containmentInt :: Interval Int-containmentInt = intInt (10 :: Int) (0 :: Int)+containmentInt = iv (10 :: Int) (0 :: Int)  noncontainmentInt :: Interval Int-noncontainmentInt = intInt  6 4+noncontainmentInt = iv  6 4  anotherInt :: Interval Int-anotherInt = intInt 5 (15 :: Int)+anotherInt = iv 5 (15 :: Int)  gapInt :: Interval Int-gapInt = intInt 5 (10 :: Int)+gapInt = iv 5 (10 :: Int) -prop_combineIntervals1:: (IntervalAlgebraic Interval a, IntervalCombinable Interval a)=>+meets1 :: [Interval Int]+meets1 = [iv 2 0, iv 2 2]++meets2 :: [Interval Int]+meets2 = [iv 2 0, iv 2 2, iv 10 4, iv 2 14]++meets3 :: [PairedInterval Int Int]+meets3 = map (uncurry mkPairedInterval) [+      (5,  iv 2 0)+    , (5,  iv 2 2)+    , (9,  iv 10 4)+    , (10, iv 2 14)]++meets3eq :: [PairedInterval Int Int]+meets3eq = map (uncurry mkPairedInterval) [+      (5,  iv 4 0)+    , (9,  iv 10 4)+    , (10, iv 2 14)]++c0in :: [StateEvent Int]+c0in =+  [ evpi 9 1  [True, False, False]+  , evpi 8 2  [True, False, False]+  , evpi 3 5  [False, True, False]+  , evpi 3 6  [False, True, False]]+c0out :: [StateEvent Int]+c0out =+  [ evpi 4 1  [True, False, False]+  , evpi 4 5  [True, True, False]+  , evpi 1 9  [True, False, False]]++c1in :: [StateEvent Int]+c1in =+  [ evpi 4 1  [True, False, False ]+  , evpi 4 6  [False, True, False ]]+c1out :: [StateEvent Int]+c1out =+  [ evpi 4 1  [True, False, False]+  , evpi 1 5  [False, False, False]+  , evpi 4 6  [False, True, False]]++c2in :: [StateEvent Int]+c2in =+  [ evpi 4 1  [True, False, False ]+  , evpi 5 5  [False, True, False ]]+c2out :: [StateEvent Int]+c2out =+  [ evpi 4 1  [True, False, False]+  , evpi 5 5  [False, True, False]]++c3in :: [StateEvent Int]+c3in =+  [ evpi 4 1  [True, False, False ]+  , evpi 6 4  [False, True, False ]]+c3out :: [StateEvent Int]+c3out =+  [ evpi 3 1  [True, False, False]+  , evpi 1 4  [True, True, False]+  , evpi 5 5  [False, True, False]]++c4in :: [StateEvent Int]+c4in =+  [ evpi 1 (-1)  [True, True, False ]+  , evpi 1 3     [True, False, True ]+  , evpi 1 3     [False, False, False]]+c4out :: [StateEvent Int]+c4out =+  [ evpi 1 (-1)  [True, True, False ]+  , evpi 3 0     [False, False, False]+  , evpi 1 3     [True, False, True ]]++-- Properties++-- Check that the only relation remaining after applying a function is Before+prop_before:: (IntervalAlgebraic Interval a, IntervalCombinable Interval a)=>+      ([Interval a] -> [Interval a])+   -> [Interval a]+   -> Property+prop_before f x = relations ci === replicate (length ci - 1) Before+      where ci = f (sort x)++prop_combineIntervals1:: (Ord a, Show a, Eq a)=>      [Interval a]    -> Property-prop_combineIntervals1 x = relations ci === replicate (length ci - 1) Before-      where ci = combineIntervals (sort x)+prop_combineIntervals1 = prop_before combineIntervals  prop_gaps1:: (IntervalAlgebraic Interval a, IntervalCombinable Interval a)=>      [Interval a]    -> Property-prop_gaps1 x = relations gs === replicate (length gs - 1) Before-      where gs = gaps (sort x)+prop_gaps1 = prop_before gaps +-- In the case that that the input has+-- *     at least one Before relation between consequent pairs+-- * AND does not have any empty states+--+-- THEN the number empty states in the output should smaller than or equal to+--      the number before relations in the output +prop_formMeetingSequence1::+     Events Int+   -> Property+prop_formMeetingSequence1 x =+   ( beforeCount > 0 &&+     not (any (\x -> getPairData x == State [False, False, False]) (getEvents x))+   ) ==> beforeCount >= emptyCount+   where res = formMeetingSequence (getEvents x)+         beforeCount = lengthWhen (== Before) (relations (getEvents x))+         emptyCount  = lengthWhen (\x -> getPairData x == mempty ) res+         lengthWhen f x = length $ filter f x +-- Check that formMeetingSequence doesn't return an empty list unless input is +-- empty.+prop_formMeetingSequence2::+     Events Int+   -> Property+prop_formMeetingSequence2 x = not (null $ getEvents x) ==> not $ null res+   where res = formMeetingSequence (getEvents x)+ spec :: Spec spec = do-   describe "combineIntervals unit tests" $-    modifyMaxSuccess (*10) $-    do-      it "noncontainmentInt combined into containmentInt" $-         combineIntervals [containmentInt, noncontainmentInt]-            `shouldBe` [containmentInt]-      it "noncontainmentInt combined into containmentInt; anotherInt unchanged" $-         combineIntervals [containmentInt, noncontainmentInt, anotherInt]-            `shouldBe` [containmentInt, anotherInt]-      it "idempotency of containmentInt" $-         combineIntervals [containmentInt] `shouldBe` [containmentInt]-      it "idempotency of noncontainmentInt" $-         combineIntervals [noncontainmentInt] `shouldBe` [noncontainmentInt]-      it "combineIntervals [] should be []" $-         combineIntervals ([] :: [Interval Int]) `shouldBe` []-      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)-    describe "gaps tests" $     modifyMaxSuccess (*10) $     do@@ -103,44 +231,118 @@            clip containmentInt gapInt `shouldBe` Nothing          it "clip Interval (4, 10) Interval (0, 10) should be Interval (4, 10)" $            clip noncontainmentInt containmentInt `shouldBe`-             Just (intInt 6 4)+             Just (iv 6 4)          it "clip x y === intersect sort x y " pending     describe "relations tests" $-      do-         it "relations [(0, 10), (4, 10), (10, 15), (15, 20)] == [FinishedBy, Meets, Meets]" $-            relations [containmentInt, noncontainmentInt, gapInt, anotherInt] `shouldBe`-               [FinishedBy, Meets, Meets]-         it "relations of [] shouldBe []" $-            relations ([] :: [Interval Int]) `shouldBe` []-         it "relations of singleton shouldBe []" $-            relations [containmentInt] `shouldBe` []-         it "more relations tests" pending+         do+            it "relations [(0, 10), (4, 10), (10, 15), (15, 20)] == [FinishedBy, Meets, Meets]" $+               relations [containmentInt, noncontainmentInt, gapInt, anotherInt] `shouldBe`+                  [FinishedBy, Meets, Meets]+            it "relations of [] shouldBe []" $+               relations ([] :: [Interval Int]) `shouldBe` []+            it "relations of singleton shouldBe []" $+               relations [containmentInt] `shouldBe` []+            it "more relations tests" pending     describe "gapsWithin tests" $       do          it "gapsWithin (1, 10) [(0,5), (7,9), (12,15)] should be [(5,7), (9,10)]" $-            gapsWithin (intInt 9 1) [intInt 5 0, intInt 2 7, intInt 3 12]-               `shouldBe` Just [intInt 2 5, intInt 1 9]+            gapsWithin (iv 9 1) [iv 5 0, iv 2 7, iv 3 12]+               `shouldBe` Just [iv 2 5, iv 1 9]          it "gapsWithin (1, 10) [] should be []" $-             gapsWithin (intInt 9 1) [] `shouldBe` Nothing+             gapsWithin (iv 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 2 3)) [intInt 1 3, intInt 1 5]+            nothingIfNone (starts (iv 2 3)) [iv 1 3, iv 1 5]                `shouldBe` Nothing          it "emptyIfNone (starts (3, 5)) [(3,6), (5,6)] shoiuld be input" $-            nothingIfNone (starts (intInt 2 3)) [intInt 3 3, intInt 1 5]-               `shouldBe` Just [ intInt 3 3, intInt 1 5]+            nothingIfNone (starts (iv 2 3)) [iv 3 3, iv 1 5]+               `shouldBe` Just [ iv 3 3, iv 1 5]          it "more emptyif tests" pending     describe "filtration tests" $-      do +      do          it "disjoint filter should filter out noncontainment" $-            filterDisjoint containmentInt [noncontainmentInt, anotherInt] +            filterDisjoint containmentInt [noncontainmentInt, anotherInt]                `shouldBe` [anotherInt]          it "notDisjoint filter should keep noncontainment" $-            filterNotDisjoint containmentInt [noncontainmentInt, anotherInt] +            filterNotDisjoint containmentInt [noncontainmentInt, anotherInt]                `shouldBe` [noncontainmentInt]++   describe "intersection tests" $+      do+         it "intersection of (0, 2) (2, 4) should be Nothing" $+            intersect (iv 2 0) (iv 2 2)    `shouldBe` Nothing+         it "intersection of (0, 2) (3, 4) should be Nothing" $+            intersect (iv 2 0) (iv 1 3)    `shouldBe` Nothing+         it "intersection of (2, 4) (0, 2) should be Nothing" $+            intersect (iv 2 2) (iv 2 0)    `shouldBe` Nothing+         it "intersection of (0, 2) (1, 3) should be Just (1, 2)" $+            intersect (iv 2 0) (iv 2 1)    `shouldBe` Just (iv 1 1)+         it "intersection of (0, 2) (-1, 3) should be Just (0, 2)" $+            intersect (iv 2 0) (iv 4 (-1)) `shouldBe` Just (iv 2 0)+         it "intersection of (0, 2) (0, 2) should be Just (0, 2)" $+            intersect (iv 2 0) (iv 2 0)    `shouldBe` Just (iv 2 0)+         it "intersection of (0, 2) (-1, 1) should be Just (0, 1)" $+            intersect (iv 2 0) (iv 2 (-1)) `shouldBe` Just (iv 1 0)+         it "intersection of (0, 3) (1, 2) should be Just (1, 2)" $+            intersect (iv 3 0) (iv 1 1)    `shouldBe` Just (iv 1 1)++   describe "combineIntervals unit tests" $+      do+         it "noncontainmentInt combined into containmentInt" $+               combineIntervals [containmentInt, noncontainmentInt]+                  `shouldBe` [containmentInt]+         it "noncontainmentInt combined into containmentInt; anotherInt unchanged" $+               combineIntervals [containmentInt, noncontainmentInt, anotherInt]+                  `shouldBe` [containmentInt, anotherInt]+         it "idempotency of containmentInt" $+               combineIntervals [containmentInt] `shouldBe` [containmentInt]+         it "idempotency of noncontainmentInt" $+               combineIntervals [noncontainmentInt] `shouldBe` [noncontainmentInt]+         it "combineIntervals [] should be []" $+               combineIntervals ([] :: [Interval Int]) `shouldBe` []+         it "combineIntervals [(0, 10), (2, 7), (10, 12), (13, 15)]" $+               combineIntervals [iv 10 0, iv 5 2, iv 2 10, iv 2 13]+                  `shouldBe` [iv 12 0, iv 2 13]++   describe "combineIntervals property tests" $+      modifyMaxSuccess (*10) $+      do+         it "after combining, only relation should be Before" $+               property ( prop_combineIntervals1 @Int)++   describe "foldMeets unit tests" $+      do+         it "foldMeetingSafe meets1" $+               foldMeetingSafe (trivialize meets1) `shouldBe`+                  trivialize [iv 4 0]+         it "foldMeetingSafe meets2" $+               foldMeetingSafe (trivialize meets2) `shouldBe`+                  trivialize [iv 16 0]+         it "foldMeetingSafe meets3" $+               foldMeetingSafe meets3 `shouldBe` meets3eq++   describe "formMeetingSequence unit tests" $+      do+         it "formMeetingSequence 0" $+            formMeetingSequence c0in `shouldBe` c0out+         it "formMeetingSequence 1"$+            formMeetingSequence c1in `shouldBe` c1out+         it "formMeetingSequence 2"$+            formMeetingSequence c2in `shouldBe` c2out+         it "formMeetingSequence 3"$+            formMeetingSequence c3in `shouldBe` c3out+         it "formMeetingSequence 4"$+            formMeetingSequence c4in `shouldBe` c4out++   describe "formMeetingSequence property tests" $+      do+          it "prop_formMeetingSequence1" $+            property prop_formMeetingSequence1+          it "prop_formMeetingSequence2" $+            property prop_formMeetingSequence2

@@ -2,9 +2,10 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE MonoLocalBinds #-} module IntervalAlgebraSpec (spec) where -import Test.Hspec                 ( hspec, describe, it, Spec, shouldBe )+import Test.Hspec                 ( hspec, describe, it, Spec, shouldBe, pending ) import Test.Hspec.QuickCheck      ( modifyMaxSuccess, modifyMaxDiscardRatio ) import Test.QuickCheck            ( (===)                                   , (==>)@@ -22,7 +23,7 @@                                   , expandl                                   , expand                                   , parseInterval-                                  , IntervalCombinable(intersect, (.+.))+                                  , IntervalCombinable((.+.))                                   , IntervalSizeable(moment, diff)                                   , IntervalAlgebraic(  equals, starts                                                       , finishes, finishedBy@@ -492,23 +493,8 @@          property (prop_compose @Int)    describe "IntervalCombinable tests" $-    do-      it "intersection of (0, 2) (2, 4) should be Nothing" $-        intersect (mkIntrvl 2 0) (mkIntrvl 2 2)    `shouldBe` Nothing-      it "intersection of (0, 2) (3, 4) should be Nothing" $-        intersect (mkIntrvl 2 0) (mkIntrvl 1 3)    `shouldBe` Nothing-      it "intersection of (2, 4) (0, 2) should be Nothing" $-        intersect (mkIntrvl 2 2) (mkIntrvl 2 0)    `shouldBe` Nothing-      it "intersection of (0, 2) (1, 3) should be Just (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 2 0) (mkIntrvl 4 (-1)) `shouldBe` Just (mkIntrvl 2 0)-      it "intersection of (0, 2) (0, 2) should be Just (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 2 0) (mkIntrvl 2 (-1)) `shouldBe` Just (mkIntrvl 1 0)-      it "intersection of (0, 3) (1, 2) should be Just (1, 2)" $-        intersect (mkIntrvl 3 0) (mkIntrvl 1 1)    `shouldBe` Just (mkIntrvl 1 1)+      do+        it "" pending    describe "Interval Algebra Axioms for meets properties" $     modifyMaxSuccess (*10) $@@ -550,4 +536,3 @@       modifyMaxSuccess (*100) $     do       it "exactly one relation must be true" $ property (prop_exclusiveRelations @Int)-