interval-algebra 1.4.0 → 2.0.0

raw patch · 9 files changed

+240/−100 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−1
• interval-algebra.cabal +1/−1
• src/IntervalAlgebra/Arbitrary.hs +18/−22
• src/IntervalAlgebra/Core.hs +60/−38
• src/IntervalAlgebra/IntervalDiagram.hs +6/−9
• src/IntervalAlgebra/IntervalUtilities.hs +121/−7
• src/IntervalAlgebra/PairedInterval.hs +7/−0
• test/IntervalAlgebra/IntervalUtilitiesSpec.hs +3/−7
• test/IntervalAlgebraSpec.hs +14/−15

@@ -1,5 +1,14 @@ # Changelog for interval-algebra +## 2.0++* Adds `Abitrary (Interval a)` instance generic over `Ord a, Arbitrary a`.+* Removes the `moment'` function from the `IntervalSizeable` class.+Use type application with `moment` instead, as in `moment @Int`, `moment @Day`, etc.+* Adds the following utility functions:+`lookback`, `lookahead`, `makeGapsWithinPredicate`,+`pairGaps`, `anyGapsWithinAtLeastDuration`, `allGapsWithinLessThanDuration`+ ## 1.4.0  * Adds the `safeInterval` function to `Core`,@@ -59,7 +68,7 @@  ## 0.10.0 -* Adds `diffFromBegin` (`diffFromEnd`) functions (not totally satisfied with these names) which change the reference point of the interval in the second argument by the difference from the `begin` (`end`) of the interval in the first argument.+* Adds `shiftFromBegin` (`shiftFromEnd`) functions (not totally satisfied with these names) which change the reference point of the interval in the second argument by the difference from the `begin` (`end`) of the interval in the first argument. * Adds a `Functor` instance for `PairedInterval b`s, which maps an `PairedInterval c a` to `PairedInterval c b`. That is, `fmap` acts on the interval type.  ## 0.9.0

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

@@ -10,6 +10,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Safe              #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}   module IntervalAlgebra.Arbitrary@@ -56,7 +58,7 @@                                                 , converse                                                 , duration                                                 , makePairedInterval-                                                , moment'+                                                , moment                                                 , predicate                                                 , strictWithinRelations                                                 )@@ -82,9 +84,6 @@ maxDiffTime :: Int maxDiffTime = 86399 -instance Arbitrary (Interval Int) where-  arbitrary = liftM2 beginerval arbitrarySizedPositive arbitrary- instance Arbitrary DT.Day where   arbitrary = sized (\s -> DT.ModifiedJulianDay <$> s `resize` arbitrary)   shrink    = (DT.ModifiedJulianDay <$>) . shrink . DT.toModifiedJulianDay@@ -100,31 +99,28 @@ instance Arbitrary DT.UTCTime  where   arbitrary = liftA2 UTCTime arbitrary arbitrary -instance Arbitrary (Interval DT.Day) where-  arbitrary = liftM2 beginerval arbitrary arbitrary--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+-- reference @iv@ is of 'moment' duration, it is not possible to generate -- intervals from the strict enclose relations StartedBy, Contains, FinishedBy.--- If `iv` and `rs` are such that no possible relations can be generated, this+-- If @iv@ and @rs@ are such that no possible relations can be generated, this -- function returns `Nothing`. Otherwise, it returns `Just` an interval that--- satisfies at least one of the possible relations in `rs` relative to--- `iv`.+-- satisfies at least one of the possible relations in @rs@ relative to+-- @iv@. ----- >>> generate $ arbitraryWithRelation (beginerval 10 (0::Int)) (fromList [Before])+-- @+-- > import Test.QuickCheck (generate)+-- > import Data.Set (fromList)+-- > isJust $ generate $ arbitraryWithRelation (beginerval 10 (0::Int)) (fromList [Before]) -- Just (20, 22)--- >>> generate $ arbitraryWithRelation (beginerval 1 (0::Int)) (fromList [StartedBy])+-- > generate $ arbitraryWithRelation (beginerval 1 (0::Int)) (fromList [StartedBy]) -- Nothing--- >>> generate $ arbitraryWithRelation (beginerval 1 (0::Int)) (fromList [StartedBy, Before])+-- > generate $ arbitraryWithRelation (beginerval 1 (0::Int)) (fromList [StartedBy, Before]) -- Just (4, 13)+-- @+-- arbitraryWithRelation-  :: (IntervalSizeable a b, Intervallic i a, Arbitrary (i a))+  :: forall i a b+   . (IntervalSizeable a b, Intervallic i a, Arbitrary (i a))   => i a -- ^ reference interval   -> Data.Set.Set IntervalRelation -- ^ set of `IntervalRelation`s, of which at least one will hold for the generated interval relative to the reference   -> Gen (Maybe (i a))@@ -136,4 +132,4 @@  where   notStrictEnclose = Data.Set.difference rs (converse strictWithinRelations)   isEnclose        = Data.Set.null notStrictEnclose-  isMom            = duration iv == moment' iv+  isMom            = duration iv == moment @a

@@ -181,8 +181,8 @@   , endervalFromBegin   , beginervalMoment   , endervalMoment-  , diffFromBegin-  , diffFromEnd+  , shiftFromBegin+  , shiftFromEnd   , momentize      -- ** Algebraic operations@@ -202,7 +202,9 @@   , IntervalSizeable(..)   ) where -import           Control.Applicative            ( Applicative(pure) )+import           Control.Applicative            ( Applicative(pure)+                                                , liftA2+                                                ) import           Control.DeepSeq                ( NFData ) import           Data.Binary                    ( Binary ) import           Data.Fixed                     ( Pico )@@ -261,6 +263,7 @@                                                 , Show                                                 , String                                                 , any+                                                , curry                                                 , fromInteger                                                 , fromRational                                                 , map@@ -273,6 +276,11 @@                                                 , toInteger                                                 , toRational                                                 )+import           Test.QuickCheck                ( Arbitrary(..)+                                                , resize+                                                , sized+                                                , suchThat+                                                )  {- | An @'Interval' a@ is a pair \( (x, y) \text{ such that } x < y\). To create intervals use the @'parseInterval'@, @'beginerval'@, or @'enderval'@ functions.@@ -283,20 +291,24 @@ newtype ParseErrorInterval = ParseErrorInterval String     deriving (Eq, Show) +-- | Helper defining what a valid relation is between begin and end of an+-- Interval.+isValidBeginEnd :: (Ord a) => a -> a -> Bool+isValidBeginEnd b e = b < e+ -- | Safely parse a pair of @a@s to create an @'Interval' a@. -- -- >>> parseInterval 0 1 -- Right (0, 1) --  -- >>> parseInterval 1 0--- Left "0<1"+-- Left (ParseErrorInterval "0<=1") --  parseInterval   :: (Show a, Ord a) => a -> a -> Either ParseErrorInterval (Interval a) parseInterval x y-  | x < y     = Right $ Interval (x, y)-  | otherwise = Left $ ParseErrorInterval $ show y ++ "<=" ++ show x-+  | isValidBeginEnd x y = Right $ Interval (x, y)+  | otherwise           = Left $ ParseErrorInterval $ show y ++ "<=" ++ show x -- | A synonym for `parseInterval` prsi :: (Show a, Ord a) => a -> a -> Either ParseErrorInterval (Interval a) prsi = parseInterval@@ -630,13 +642,9 @@ class (Ord a, Num b, Ord b) => IntervalSizeable a b | a -> b where      -- | The smallest duration for an 'Interval a'.-    moment :: b+    moment :: forall a . b     moment = 1 -    -- | Gives back a 'moment' based on the input's type.-    moment' :: Intervallic i a => i a -> b-    moment' x = moment @a-     -- | Determine the duration of an @'i a'@.     duration :: Intervallic i a => i a -> b     duration x = diff (end x) (begin x)@@ -659,15 +667,16 @@ -- (-1, 3) -- expand-  :: (IntervalSizeable a b, Intervallic i a)+  :: forall i a b+   . (IntervalSizeable a b, Intervallic i a)   => b -- ^ duration to subtract from the 'begin'   -> b -- ^ duration to add to the 'end'   -> i a   -> i a expand l r p = setInterval p i  where-  s = if l < moment' p then 0 else negate l-  e = if r < moment' p then 0 else r+  s = if l < moment @a then 0 else negate l+  e = if r < moment @a then 0 else r   i = Interval (add s $ begin p, add e $ end p)  -- | Expands an @i a@ to "left".@@ -699,15 +708,17 @@ -- (0, 2) -- beginerval-  :: (IntervalSizeable a b)+  :: forall a b+   . (IntervalSizeable a b)   => b -- ^ @dur@ation to add to the 'begin'    -> a -- ^ the 'begin' point of the 'Interval'   -> Interval a beginerval dur x = Interval (x, y)  where   i = Interval (x, x)-  d = max (moment' i) dur+  d = max (moment @a) dur   y = add d x+{-# INLINABLE beginerval #-}  -- | A synonym for `beginerval` bi@@ -716,8 +727,8 @@   -> a -- ^ the 'begin' point of the 'Interval'   -> Interval a bi = beginerval-{-# INLINABLE beginerval #-} + -- | Safely creates an 'Interval a' using @x@ as the 'end' and adding --   @negate max 'moment' dur@ to @x@ as the 'begin'. --@@ -731,12 +742,14 @@ -- (-2, 0) -- enderval-  :: (IntervalSizeable a b)+  :: forall a b+   . (IntervalSizeable a b)   => b -- ^ @dur@ation to subtract from the 'end'    -> a -- ^ the 'end' point of the 'Interval'   -> Interval a-enderval dur x = Interval (add (negate $ max (moment' i) dur) x, x)+enderval dur x = Interval (add (negate $ max (moment @a) dur) x, x)   where i = Interval (x, x)+{-# INLINABLE enderval #-}  -- | A synonym for `enderval` ei@@ -745,8 +758,8 @@   -> a -- ^ the 'end' point of the 'Interval'   -> Interval a ei = enderval-{-# INLINABLE enderval #-} + -- | Safely creates an @'Interval'@ from a pair of endpoints. -- IMPORTANT: This function uses 'beginerval',  -- thus if the second element of the pair is `<=` the first element,@@ -785,16 +798,16 @@ -- >>> beginervalMoment (10 :: Int) -- (10, 11) -- -beginervalMoment :: (IntervalSizeable a b) => a -> Interval a-beginervalMoment x = beginerval (moment' i) x where i = Interval (x, x)+beginervalMoment :: forall a b . (IntervalSizeable a b) => a -> Interval a+beginervalMoment x = beginerval (moment @a) x where i = Interval (x, x)  -- | Safely creates a new @Interval@ with 'moment' length with 'end' at @x@ -- -- >>> endervalMoment (10 :: Int) -- (9, 10) -- -endervalMoment :: (IntervalSizeable a b) => a -> Interval a-endervalMoment x = enderval (moment' i) x where i = Interval (x, x)+endervalMoment :: forall a b . (IntervalSizeable a b) => a -> Interval a+endervalMoment x = enderval (moment @a) x where i = Interval (x, x)  -- | Creates a new @Interval@ spanning the extent x and y. --@@ -808,36 +821,34 @@   e = max (end x) (end y)  -- | Modifies the endpoints of second argument's interval by taking the difference---   from the first's input's 'begin'.--- --- >>> diffFromBegin (Interval ((5::Int), 6)) (Interval (10, 15))+--   from the first's input's 'begin'. +-- >>> shiftFromBegin (Interval ((5::Int), 6)) (Interval (10, 15)) -- (5, 10) ----- >>> diffFromBegin (Interval ((1::Int), 2)) (Interval (3, 15))+-- >>> shiftFromBegin (Interval ((1::Int), 2)) (Interval (3, 15)) -- (2, 14) ---diffFromBegin+shiftFromBegin   :: (IntervalSizeable a b, Functor i1, Intervallic i0 a)   => i0 a   -> i1 a   -> i1 b-diffFromBegin i = fmap (`diff` begin i)+shiftFromBegin i = fmap (`diff` begin i)  -- | Modifies the endpoints of second argument's interval by taking the difference --   from the first's input's 'end'.------ >>> diffFromEnd (Interval ((5::Int), 6)) (Interval (10, 15))+-- >>> shiftFromEnd (Interval ((5::Int), 6)) (Interval (10, 15)) -- (4, 9) ----- >>> diffFromEnd (Interval ((1::Int), 2)) (Interval (3, 15))+-- >>> shiftFromEnd (Interval ((1::Int), 2)) (Interval (3, 15)) -- (1, 13) ---diffFromEnd+shiftFromEnd   :: (IntervalSizeable a b, Functor i1, Intervallic i0 a)   => i0 a   -> i1 a   -> i1 b-diffFromEnd i = fmap (`diff` end i)+shiftFromEnd i = fmap (`diff` end i)  -- | Changes the duration of an 'Intervallic' value to a moment starting at the  --   'begin' of the interval.@@ -845,8 +856,9 @@ -- >>> momentize (Interval (6, 10)) -- (6, 7) ---momentize :: (IntervalSizeable a b, Intervallic i a) => i a -> i a-momentize i = setInterval i (beginerval (moment' i) (begin i))+momentize+  :: forall i a b . (IntervalSizeable a b, Intervallic i a) => i a -> i a+momentize i = setInterval i (beginerval (moment @a) (begin i))  {- | The @'IntervalCombinable'@ typeclass provides methods for (possibly) combining@@ -936,3 +948,13 @@   moment = toEnum 1 :: NominalDiffTime   add    = addUTCTime   diff   = diffUTCTime++-- Arbitrary instances+instance (Ord a, Arbitrary a) => Arbitrary (Interval a) where+  arbitrary =+    sized+        (\s -> liftA2 (curry Interval)+                      (s `resize` arbitrary)+                      (s `resize` arbitrary)+        )+      `suchThat` (\i -> isValidBeginEnd (intervalBegin i) (intervalEnd i))

@@ -103,7 +103,7 @@ Moreover, the type @b@ should be castable to @Int@, using its @'Witch.From' b Int@  instance. ->>> import PrettyPrinter (pretty)+>>> import Prettyprinter (pretty) >>> import IntervalAlgebra (beginerval) >>> pretty $ MkIntervalText '-' (beginerval 5 (0::Int)) -----@@ -144,8 +144,7 @@  Values of this type should only be created through the 'parseIntervalTextLine' function,-which checks that the inputs are parsed correctly and-uses the 'makeIntervalLine' function to form intervals +which checks that the inputs are parsed correctly to form intervals  that will be pretty-printed correctly.  >>> let i1 =  MkIntervalText '*' (beginerval 10 (5::Int))@@ -249,7 +248,7 @@   makeIntervalLine     :: NE.NonEmpty (IntervalText Int) -> NE.NonEmpty (IntervalText Int)   makeIntervalLine x =-    NE.head x NE.:| zipWith diffFromEnd (toList x) (NE.tail x)+    NE.head x NE.:| zipWith shiftFromEnd (toList x) (NE.tail x)    -- Creates all pairs of a list   pairs = go@@ -560,14 +559,11 @@  This function provides the most flexibility in producing interval diagrams. --To create @'IntervalText'@ values use its @'From'@ instance, as in:-->>> let mkIntrvl c d b = into @(IntervalText Int) (c, bi d (b :: Int))- Here's a basic diagram that shows how to put more than one interval interval on a line: +>>> :set -XTypeApplications -XFlexibleContexts -XOverloadedStrings+>>> let mkIntrvl c d b = into @(IntervalText Int) (c, bi d (b :: Int)) >>> let x = mkIntrvl  '=' 20 0 >>> let l1 = [ mkIntrvl '-' 1 4 ] >>> let l2 = [ mkIntrvl '*' 3 5, mkIntrvl '*' 5 10, mkIntrvl 'x' 1 17 ]@@ -684,6 +680,7 @@ using the 'defaultIntervalDiagramOptions'.   >>> import Data.Maybe (fromMaybe)+>>> import IntervalAlgebra.IntervalUtilities (gapsWithin) >>> pretty $ simpleIntervalDiagram (bi 10 (0 :: Int)) (fmap (bi 1) [0..9]) -  -

@@ -6,12 +6,12 @@ Maintainer  : bsaul@novisci.com Stability   : experimental -In the examples below, @iv@ is a synonym for 'beginerval' used to save space. -}  {-# LANGUAGE Safe #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TupleSections #-}  module IntervalAlgebra.IntervalUtilities   (@@ -56,6 +56,16 @@   , filterEnclose   , filterEnclosedBy +    -- * Functions for manipulating intervals+  , lookback+  , lookahead++    -- * Gaps+  , makeGapsWithinPredicate+  , pairGaps+  , anyGapsWithinAtLeastDuration+  , allGapsWithinLessThanDuration+     -- * Misc utilities   , relations   , relationsL@@ -70,7 +80,7 @@ import qualified Control.Foldl                 as L import safe      Control.Monad                  ( Functor(fmap) ) import safe      Data.Bool                      ( (&&)-                                                , Bool+                                                , Bool(..)                                                 , not                                                 , otherwise                                                 , (||)@@ -90,10 +100,15 @@                                                 , maybeToList                                                 ) import safe      Data.Monoid                    ( Monoid(mempty) )-import safe      Data.Ord                       ( Ord(max, min) )+import safe      Data.Ord                       ( (<)+                                                , (>=)+                                                , Ord(max, min)+                                                ) import safe      Data.Semigroup                 ( Semigroup((<>)) ) import safe      Data.Traversable               ( Traversable(sequenceA) )-import safe      Data.Tuple                     ( fst )+import safe      Data.Tuple                     ( fst+                                                , uncurry+                                                ) import safe      GHC.Int                        ( Int ) import safe      GHC.Show                       ( Show ) import safe      IntervalAlgebra.Core           ( (<|>)@@ -155,7 +170,6 @@                                                 )  - ------------------------------------------------- -- Unexported utilties used in functions below -- -------------------------------------------------@@ -174,6 +188,103 @@   step (fs, Just x ) y = (fs <> pure (f x y), Just y)   done (fs, _) = fs +-- | Create a predicate function that checks whether within a provided spanning+--   interval, are there (e.g. any, all) gaps of (e.g. <, <=, >=, >) a specified+--   duration among  the input intervals?+makeGapsWithinPredicate+  :: ( Monoid (t (Interval a))+     , Monoid (t (Maybe (Interval a)))+     , Applicative t+     , Witherable.Witherable t+     , IntervalSizeable a b+     , Intervallic i0 a+     , IntervalCombinable i1 a+     )+  => ((b -> Bool) -> t b -> Bool)+  -> (b -> b -> Bool)+  -> (b -> i0 a -> t (i1 a) -> Bool)+makeGapsWithinPredicate f op gapDuration interval l =+  maybe False (f (`op` gapDuration) . durations) (gapsWithin interval l)++-- | Gets the durations of gaps (via 'IntervalAlgebra.(><)') between all pairs+--   of the input.+pairGaps+  :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a)+  => [i a]+  -> [Maybe b]+pairGaps es = fmap (fmap duration . uncurry (><)) (pairs es)+-- Generate all pair-wise combinations of a single list.+-- pairs :: [a] -> [(a, a)]+-- copied from the hgeometry library+-- (https://hackage.haskell.org/package/hgeometry-0.12.0.4/docs/src/Data.Geometry.Arrangement.Internal.html#allPairs)+ where+  pairs = go+   where+    go []       = []+    go (x : xs) = fmap (x, ) xs <> go xs++-- | Creates a new @Interval@ of a provided lookback duration ending at the +--   'begin' of the input interval.+--+-- >>> lookback 4 (beginerval 10 (1 :: Int))+-- (-3, 1)+lookback+  :: (Intervallic i a, IntervalSizeable a b)+  => b   -- ^ lookback duration+  -> i a+  -> Interval a+lookback d x = enderval d (begin x)++-- | Creates a new @Interval@ of a provided lookahead duration beginning at the +--   'end' of the input interval.+--+-- >>> lookahead 4 (beginerval 1 (1 :: Int))+-- (2, 6)+lookahead+  :: (Intervallic i a, IntervalSizeable a b)+  => b   -- ^ lookahead duration+  -> i a+  -> Interval a+lookahead d x = beginerval d (end x)++-- | Within a provided spanning interval, are there any gaps of at least the+--   specified duration among the input intervals?+anyGapsWithinAtLeastDuration+  :: ( IntervalSizeable a b+     , Intervallic i0 a+     , IntervalCombinable i1 a+     , Monoid (t (Interval a))+     , Monoid (t (Maybe (Interval a)))+     , Applicative t+     , Witherable.Witherable t+     )+  => b       -- ^ duration of gap+  -> i0 a  -- ^ within this interval+  -> t (i1 a)+  -> Bool+anyGapsWithinAtLeastDuration = makeGapsWithinPredicate any (>=)++-- | Within a provided spanning interval, are all gaps less than the specified+--   duration among the input intervals?+--+-- >>> allGapsWithinLessThanDuration 30 (beginerval 100 (0::Int)) [beginerval 5 (-1), beginerval 99 10]+-- True+allGapsWithinLessThanDuration+  :: ( IntervalSizeable a b+     , Intervallic i0 a+     , IntervalCombinable i1 a+     , Monoid (t (Interval a))+     , Monoid (t (Maybe (Interval a)))+     , Applicative t+     , Witherable.Witherable t+     )+  => b       -- ^ duration of gap+  -> i0 a  -- ^ within this interval+  -> t (i1 a)+  -> Bool+allGapsWithinLessThanDuration = makeGapsWithinPredicate all (<)++ -- 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@@ -191,15 +302,17 @@ -- -- >>> relationsL [iv 1 0, iv 1 1]  -- [Meets]+-- relationsL :: (Foldable f, Intervallic i a) => f (i a) -> [IntervalRelation] relationsL = relations  -- | A generic form of 'relations' which can output any 'Applicative' and  --   'Monoid' structure. ----- >>> (relations [iv 1 0, iv 1 1]) :: [IntervalRelation (Interval Int)]+-- >>> (relations [iv 1 0,iv 1 1]) :: [IntervalRelation] -- [Meets] --+-- relations   :: (Foldable f, Applicative m, Intervallic i a, Monoid (m IntervalRelation))   => f (i a)@@ -239,6 +352,7 @@ --   sorted*. See 'gapsL' for a version that always returns a list. -- -- >>> gaps [iv 4 1, iv 4 8, iv 3 11]+-- Nothing -- gaps   :: ( IntervalCombinable i a@@ -416,7 +530,7 @@  -- | Returns 'Nothing' if *any* of the element of input satisfy the predicate condition. ----- >>> nothingIfAny (starts (iv 2 3)) [iv 3 3, iv 1 5]+-- >>> nothingIfAny (startedBy (iv 2 3)) [iv 3 3, iv 1 5] -- Just [(3, 6),(5, 6)] -- -- >>> nothingIfAny (starts (iv 2 3)) [iv 3 3, iv 1 5]

@@ -23,6 +23,7 @@   , trivialize   ) where +import safe      Control.Applicative            ( liftA2 ) import safe      Control.DeepSeq                ( NFData ) import safe      Data.Bifunctor                 ( Bifunctor(bimap) ) import safe      Data.Binary                    ( Binary )@@ -34,6 +35,7 @@                                                 , before                                                 , extenterval                                                 )+import safe      Test.QuickCheck                ( Arbitrary(..) ) import safe      Witherable                     ( Filterable(filter) )  -- | An @Interval a@ paired with some other data of type @b@.@@ -105,3 +107,8 @@ --   @PairedInterval Empty a@(s). trivialize :: Functor f => f (Interval a) -> f (PairedInterval Empty a) trivialize = fmap toTrivialPair+++-- Arbitrary instance+instance (Arbitrary b, Ord a, Arbitrary a) => Arbitrary (PairedInterval b a) where+  arbitrary = liftA2 makePairedInterval arbitrary arbitrary

@@ -1,9 +1,7 @@-{- HLINT ignore -} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeApplications  #-}--+{- HLINT ignore -} module IntervalAlgebra.IntervalUtilitiesSpec   ( spec   ) where@@ -35,7 +33,7 @@                                                 , disjointRelations                                                 , duration                                                 , intervalRelations-                                                , moment'+                                                , moment                                                 , predicate                                                 , safeInterval                                                 , starts@@ -105,8 +103,6 @@                                                 ) import           Witherable                     ( Filterable ) -- -- Types for testing  -- SmallInterval is just to test properties for which events of interest are so@@ -294,7 +290,7 @@   rels  = refRelations ir   isEnclose =     Data.Set.null $ Data.Set.difference rels (converse strictWithinRelations)-  isMom = duration refIv == moment' refIv+  isMom = duration refIv == moment @Int   -- Check that the only relation remaining after applying a function is Before

@@ -103,11 +103,11 @@       `shouldBe` True      it "beginervalMoment duration is moment"-      $          moment' (beginervalMoment (-13 :: Int))-      `shouldBe` (1 :: Int)+      $          duration (beginervalMoment (-13 :: Int))+      `shouldBe` (moment @Int)     it "endervalMoment duration is moment"-      $          moment' (endervalMoment (26 :: Int))-      `shouldBe` (1 :: Int)+      $          duration (endervalMoment (26 :: Int))+      `shouldBe` (moment @Int)      it "parsing fails on bad inputs" $ parseInterval 10 0 `shouldBe` Left       (IA.ParseErrorInterval "0<=10")@@ -203,7 +203,6 @@    describe "IntervalSizeable tests" $ do     it "moment is 1" $ moment @Int `shouldBe` 1-    it "moment' is 1" $ moment' (beginerval 1 (0 :: Int)) `shouldBe` 1     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)"@@ -244,22 +243,22 @@       $          Right (enderval (-2 :: Int) 10)       `shouldBe` parseInterval (9 :: Int) (10 :: Int) -    it "diffFromBegin can convert Interval Int to Interval Int"-      $          diffFromBegin (beginerval 2 (4 :: Int)) (beginerval 2 10)+    it "shiftFromBegin can convert Interval Int to Interval Int"+      $          shiftFromBegin (beginerval 2 (4 :: Int)) (beginerval 2 10)       `shouldBe` beginerval 2 6 -- (6, 8) -    it "diffFromEnd can convert Interval Int to Interval Int"-      $          diffFromEnd (beginerval 2 (4 :: Int)) (beginerval 2 10)+    it "shiftFromEnd can convert Interval Int to Interval Int"+      $          shiftFromEnd (beginerval 2 (4 :: Int)) (beginerval 2 10)       `shouldBe` beginerval 2 4 -- (4, 6) -    it "diffFromBegin can convert Interval Day to Interval Integer"-      $          diffFromBegin (beginerval 2 (fromGregorian 2001 1 1))-                               (beginerval 2 (fromGregorian 2001 1 10))+    it "shiftFromBegin can convert Interval Day to Interval Integer"+      $          shiftFromBegin (beginerval 2 (fromGregorian 2001 1 1))+                                (beginerval 2 (fromGregorian 2001 1 10))       `shouldBe` beginerval 2 9 -- (9, 11) -    it "diffFromEnd can convert Interval Day to Interval Integer"-      $          diffFromEnd (beginerval 2 (fromGregorian 2001 1 1))-                             (beginerval 2 (fromGregorian 2001 1 10))+    it "shiftFromEnd can convert Interval Day to Interval Integer"+      $          shiftFromEnd (beginerval 2 (fromGregorian 2001 1 1))+                              (beginerval 2 (fromGregorian 2001 1 10))       `shouldBe` beginerval 2 7 -- (7, 9)      it "momentize works"