{-|
Module      : Interval Algebra
Description : Implementation of Allen's interval algebra
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com

The @IntervalAlgebra@ module provides data types and related classes for the
interval-based temporal logic described in [Allen (1983)](https://doi.org/10.1145/182.358434)
and axiomatized in [Allen and Hayes (1987)](https://doi.org/10.1111/j.1467-8640.1989.tb00329.x).
A good primer on Allen's algebra can be [found here](https://thomasalspaugh.org/pub/fnd/allen.html).

= Design

The module is built around three typeclasses designed to separate concerns of
constructing, relating, and combining types that contain @'Interval'@s:

1. @'Intervallic'@ provides an interface to the data structures which contain an
   @'Interval'@.
2. @'IntervalCombinable'@ provides an interface to methods of combining two
   @'Interval's@.
3. @'IntervalSizeable'@ provides methods for measuring and modifying the size of
    an interval.

-}

{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE NoImplicitPrelude      #-}
{-# LANGUAGE Safe                   #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeApplications       #-}

module IntervalAlgebra.Core
  (

    -- * Intervals
    Interval
  , Intervallic(..)
  , ParseErrorInterval(..)
  , begin
  , end

    -- ** Create new intervals
  , parseInterval
  , prsi
  , beginerval
  , bi
  , enderval
  , ei
  , safeInterval
  , si

    -- ** Modify intervals
  , expand
  , expandl
  , expandr

    -- * Interval Algebra

    -- ** Interval Relations and Predicates
  , IntervalRelation(..)
  , meets
  , metBy
  , before
  , after
  , overlaps
  , overlappedBy
  , finishedBy
  , finishes
  , contains
  , during
  , starts
  , startedBy
  , equals

    -- ** Additional predicates and utilities
  , precedes
  , precededBy
  , disjoint
  , notDisjoint
  , concur
  , within
  , encloses
  , enclosedBy
  , (<|>)
  , predicate
  , unionPredicates
  , disjointRelations
  , withinRelations
  , strictWithinRelations
  , ComparativePredicateOf1
  , ComparativePredicateOf2
  , beginervalFromEnd
  , endervalFromBegin
  , beginervalMoment
  , endervalMoment
  , shiftFromBegin
  , shiftFromEnd
  , momentize
  , toEnumInterval
  , fromEnumInterval

    -- ** Algebraic operations
  , intervalRelations
  , relate
  , compose
  , complement
  , union
  , intersection
  , converse

    -- * Combine two intervals
  , IntervalCombinable(..)
  , extenterval

    -- * Measure an interval
  , IntervalSizeable(..)
  ) where

import           Control.Applicative (Applicative (pure), liftA2)
import           Control.DeepSeq     (NFData)
import           Data.Binary         (Binary)
import           Data.Fixed          (Pico)
import           Data.Function       (flip, id, ($), (.))
import           Data.Ord            (Ord (..), Ordering (..), max, min)
import           Data.Semigroup      (Semigroup ((<>)))
import qualified Data.Set            (Set, difference, fromList, intersection,
                                      map, toList, union)
import           Data.Time           as DT (Day, DiffTime, NominalDiffTime,
                                            UTCTime, addDays, addUTCTime,
                                            diffDays, diffUTCTime,
                                            nominalDiffTimeToSeconds,
                                            secondsToNominalDiffTime)
import           Data.Tuple          (fst, snd)
import           GHC.Generics        (Generic)
import           Prelude             (Bool (..), Bounded (..), Either (..),
                                      Enum (..), Eq, Int, Integer, Maybe (..),
                                      Num, Rational, Show, String, any, curry,
                                      fromInteger, fromRational, map, negate,
                                      not, otherwise, realToFrac, replicate,
                                      show, toInteger, toRational, (!!), (&&),
                                      (+), (++), (-), (==))
import           Test.QuickCheck     (Arbitrary (..), resize, sized, suchThat)

{- $setup
>>> import IntervalAlgebra.IntervalDiagram
-}

{- | An @'Interval' a@ is a pair \( (x, y) \text{ such that } x < y\). To create
intervals use the @'parseInterval'@, @'beginerval'@, or @'enderval'@ functions.
-}
newtype Interval a = Interval (a, a) deriving (Interval a -> Interval a -> Bool
(Interval a -> Interval a -> Bool)
-> (Interval a -> Interval a -> Bool) -> Eq (Interval a)
forall a. Eq a => Interval a -> Interval a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interval a -> Interval a -> Bool
$c/= :: forall a. Eq a => Interval a -> Interval a -> Bool
== :: Interval a -> Interval a -> Bool
$c== :: forall a. Eq a => Interval a -> Interval a -> Bool
Eq, (forall x. Interval a -> Rep (Interval a) x)
-> (forall x. Rep (Interval a) x -> Interval a)
-> Generic (Interval a)
forall x. Rep (Interval a) x -> Interval a
forall x. Interval a -> Rep (Interval a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Interval a) x -> Interval a
forall a x. Interval a -> Rep (Interval a) x
$cto :: forall a x. Rep (Interval a) x -> Interval a
$cfrom :: forall a x. Interval a -> Rep (Interval a) x
Generic)

-- | A type identifying interval parsing errors.
newtype ParseErrorInterval = ParseErrorInterval String
    deriving (ParseErrorInterval -> ParseErrorInterval -> Bool
(ParseErrorInterval -> ParseErrorInterval -> Bool)
-> (ParseErrorInterval -> ParseErrorInterval -> Bool)
-> Eq ParseErrorInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseErrorInterval -> ParseErrorInterval -> Bool
$c/= :: ParseErrorInterval -> ParseErrorInterval -> Bool
== :: ParseErrorInterval -> ParseErrorInterval -> Bool
$c== :: ParseErrorInterval -> ParseErrorInterval -> Bool
Eq, Int -> ParseErrorInterval -> ShowS
[ParseErrorInterval] -> ShowS
ParseErrorInterval -> String
(Int -> ParseErrorInterval -> ShowS)
-> (ParseErrorInterval -> String)
-> ([ParseErrorInterval] -> ShowS)
-> Show ParseErrorInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseErrorInterval] -> ShowS
$cshowList :: [ParseErrorInterval] -> ShowS
show :: ParseErrorInterval -> String
$cshow :: ParseErrorInterval -> String
showsPrec :: Int -> ParseErrorInterval -> ShowS
$cshowsPrec :: Int -> ParseErrorInterval -> ShowS
Show)

{- | Helper defining what a valid relation is between begin and end of an
Interval.
-}
isValidBeginEnd :: (Ord a) => a -> a -> Bool
isValidBeginEnd :: forall a. Ord a => a -> a -> Bool
isValidBeginEnd a
b a
e = a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
e

{- | Safely parse a pair of @a@s to create an @'Interval' a@.

>>> parseInterval 0 1
Right (0, 1)

>>> parseInterval 1 0
Left (ParseErrorInterval "0<=1")
-}
parseInterval
  :: (Show a, Ord a) => a -> a -> Either ParseErrorInterval (Interval a)
parseInterval :: forall a.
(Show a, Ord a) =>
a -> a -> Either ParseErrorInterval (Interval a)
parseInterval a
x a
y
  | a -> a -> Bool
forall a. Ord a => a -> a -> Bool
isValidBeginEnd a
x a
y = Interval a -> Either ParseErrorInterval (Interval a)
forall a b. b -> Either a b
Right (Interval a -> Either ParseErrorInterval (Interval a))
-> Interval a -> Either ParseErrorInterval (Interval a)
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
y)
  | Bool
otherwise           = ParseErrorInterval -> Either ParseErrorInterval (Interval a)
forall a b. a -> Either a b
Left (ParseErrorInterval -> Either ParseErrorInterval (Interval a))
-> ParseErrorInterval -> Either ParseErrorInterval (Interval a)
forall a b. (a -> b) -> a -> b
$ String -> ParseErrorInterval
ParseErrorInterval (String -> ParseErrorInterval) -> String -> ParseErrorInterval
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
-- | A synonym for `parseInterval`
prsi :: (Show a, Ord a) => a -> a -> Either ParseErrorInterval (Interval a)
prsi :: forall a.
(Show a, Ord a) =>
a -> a -> Either ParseErrorInterval (Interval a)
prsi = a -> a -> Either ParseErrorInterval (Interval a)
forall a.
(Show a, Ord a) =>
a -> a -> Either ParseErrorInterval (Interval a)
parseInterval

intervalBegin :: Interval a -> a
intervalBegin :: forall a. Interval a -> a
intervalBegin (Interval (a, a)
x) = (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
x

intervalEnd :: Interval a -> a
intervalEnd :: forall a. Interval a -> a
intervalEnd (Interval (a, a)
x) = (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
x

instance (Show a, Ord a) => Show (Interval a) where
  show :: Interval a -> String
show Interval a
x = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin Interval a
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end Interval a
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance Binary a => Binary (Interval a)
instance NFData a => NFData (Interval a)

{- | The @'Intervallic'@ typeclass defines how to get and set the 'Interval'
content of a data structure. It also includes functions for getting the
endpoints of the 'Interval' via @'begin'@ and @'end'@.

>>> getInterval (Interval (0, 10))
(0, 10)

>>> begin (Interval (0, 10))
0

>>> end (Interval (0, 10))
10
-}
class Intervallic i where

    -- | Get the interval from an @i a@.
    getInterval :: i a -> Interval a

    -- | Set the interval in an @i a@.
    setInterval :: i a -> Interval b -> i b

-- | Access the endpoints of an @i a@ .
begin, end :: (Intervallic i) => i a -> a
begin :: forall (i :: * -> *) a. Intervallic i => i a -> a
begin = Interval a -> a
forall a. Interval a -> a
intervalBegin (Interval a -> a) -> (i a -> Interval a) -> i a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval
end :: forall (i :: * -> *) a. Intervallic i => i a -> a
end = Interval a -> a
forall a. Interval a -> a
intervalEnd (Interval a -> a) -> (i a -> Interval a) -> i a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval

{- | This *unexported* function is an internal convenience function for cases in
which @f@ is known to be strictly monotone.
-}
imapStrictMonotone :: (Intervallic i) => (a -> b) -> i a -> i b
imapStrictMonotone :: forall (i :: * -> *) a b. Intervallic i => (a -> b) -> i a -> i b
imapStrictMonotone a -> b
f i a
i = i a -> Interval b -> i b
forall (i :: * -> *) a b. Intervallic i => i a -> Interval b -> i b
setInterval i a
i ((a -> b) -> Interval a -> Interval b
forall {t} {a}. (t -> a) -> Interval t -> Interval a
op a -> b
f (i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i a
i))
  where op :: (t -> a) -> Interval t -> Interval a
op t -> a
f (Interval (t
b, t
e)) = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (t -> a
f t
b, t -> a
f t
e)

{- | The 'IntervalRelation' type and the associated predicate functions enumerate
the thirteen possible ways that two @'Interval'@ objects may 'relate' according
to Allen's interval algebra. Constructors are shown with their corresponding
predicate function.
-}
data IntervalRelation =
      Before        -- ^ `before`
    | Meets         -- ^ `meets`
    | Overlaps      -- ^ `overlaps`
    | FinishedBy    -- ^ `finishedBy`
    | Contains      -- ^ `contains`
    | Starts        -- ^ `starts`
    | Equals        -- ^ `equals`
    | StartedBy     -- ^ `startedBy`
    | During        -- ^ `during`
    | Finishes      -- ^ `finishes`
    | OverlappedBy  -- ^ `overlappedBy`
    | MetBy         -- ^ `metBy`
    | After         -- ^ `after`
    deriving (IntervalRelation -> IntervalRelation -> Bool
(IntervalRelation -> IntervalRelation -> Bool)
-> (IntervalRelation -> IntervalRelation -> Bool)
-> Eq IntervalRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntervalRelation -> IntervalRelation -> Bool
$c/= :: IntervalRelation -> IntervalRelation -> Bool
== :: IntervalRelation -> IntervalRelation -> Bool
$c== :: IntervalRelation -> IntervalRelation -> Bool
Eq, Int -> IntervalRelation -> ShowS
[IntervalRelation] -> ShowS
IntervalRelation -> String
(Int -> IntervalRelation -> ShowS)
-> (IntervalRelation -> String)
-> ([IntervalRelation] -> ShowS)
-> Show IntervalRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntervalRelation] -> ShowS
$cshowList :: [IntervalRelation] -> ShowS
show :: IntervalRelation -> String
$cshow :: IntervalRelation -> String
showsPrec :: Int -> IntervalRelation -> ShowS
$cshowsPrec :: Int -> IntervalRelation -> ShowS
Show, Int -> IntervalRelation
IntervalRelation -> Int
IntervalRelation -> [IntervalRelation]
IntervalRelation -> IntervalRelation
IntervalRelation -> IntervalRelation -> [IntervalRelation]
IntervalRelation
-> IntervalRelation -> IntervalRelation -> [IntervalRelation]
(IntervalRelation -> IntervalRelation)
-> (IntervalRelation -> IntervalRelation)
-> (Int -> IntervalRelation)
-> (IntervalRelation -> Int)
-> (IntervalRelation -> [IntervalRelation])
-> (IntervalRelation -> IntervalRelation -> [IntervalRelation])
-> (IntervalRelation -> IntervalRelation -> [IntervalRelation])
-> (IntervalRelation
    -> IntervalRelation -> IntervalRelation -> [IntervalRelation])
-> Enum IntervalRelation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IntervalRelation
-> IntervalRelation -> IntervalRelation -> [IntervalRelation]
$cenumFromThenTo :: IntervalRelation
-> IntervalRelation -> IntervalRelation -> [IntervalRelation]
enumFromTo :: IntervalRelation -> IntervalRelation -> [IntervalRelation]
$cenumFromTo :: IntervalRelation -> IntervalRelation -> [IntervalRelation]
enumFromThen :: IntervalRelation -> IntervalRelation -> [IntervalRelation]
$cenumFromThen :: IntervalRelation -> IntervalRelation -> [IntervalRelation]
enumFrom :: IntervalRelation -> [IntervalRelation]
$cenumFrom :: IntervalRelation -> [IntervalRelation]
fromEnum :: IntervalRelation -> Int
$cfromEnum :: IntervalRelation -> Int
toEnum :: Int -> IntervalRelation
$ctoEnum :: Int -> IntervalRelation
pred :: IntervalRelation -> IntervalRelation
$cpred :: IntervalRelation -> IntervalRelation
succ :: IntervalRelation -> IntervalRelation
$csucc :: IntervalRelation -> IntervalRelation
Enum)

instance Bounded IntervalRelation where
  minBound :: IntervalRelation
minBound = IntervalRelation
Before
  maxBound :: IntervalRelation
maxBound = IntervalRelation
After

instance Ord IntervalRelation where
  compare :: IntervalRelation -> IntervalRelation -> Ordering
compare IntervalRelation
x IntervalRelation
y = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IntervalRelation -> Int
forall a. Enum a => a -> Int
fromEnum IntervalRelation
x) (IntervalRelation -> Int
forall a. Enum a => a -> Int
fromEnum IntervalRelation
y)


{- | Does x `meets` y? Is x `metBy` y?

Example data with corresponding diagram:

>>> x = bi 5 0
>>> y = bi 5 5
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
-----      <- [x]
     ----- <- [y]
==========

Examples:

>>> x `meets` y
True

>>> x `metBy` y
False

>>> y `meets` x
False

>>> y `metBy` x
True
-}
meets, metBy
  :: (Eq a, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
meets :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
meets i0 a
x i1 a
y = i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i1 a
y
metBy :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
metBy = (i1 a -> i0 a -> Bool) -> i0 a -> i1 a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
meets


{- | Is x `before` y? Does x `precedes` y? Is x `after` y? Is x `precededBy` y?

Example data with corresponding diagram:

>>> x = bi 3 0
>>> y = bi 4 6
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
---        <- [x]
      ---- <- [y]
==========

Examples:

>>> x `before` y
True
>>> x `precedes` y
True

>>> x `after`y
False
>>> x `precededBy` y
False

>>> y `before` x
False
>>> y `precedes` x
False

>>> y `after` x
True
>>> y `precededBy` x
True
-}
before, after, precedes, precededBy
  :: (Ord a, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
before :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before i0 a
x i1 a
y = i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i1 a
y
after :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
after = (i1 a -> i0 a -> Bool) -> i0 a -> i1 a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before
precedes :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
precedes = ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before
precededBy :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
precededBy = ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
after


{- | Does x `overlaps` y? Is x `overlappedBy` y?

Example data with corresponding diagram:

>>> x = bi 6 0
>>> y = bi 6 4
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
------     <- [x]
    ------ <- [y]
==========

Examples:

>>> x `overlaps` y
True

>>> x `overlappedBy` y
False

>>> y `overlaps` x
False

>>> y `overlappedBy` x
True
-}
overlaps, overlappedBy
  :: (Ord a, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
overlaps :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps i0 a
x i1 a
y = i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i1 a
y
overlappedBy :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy = (i1 a -> i0 a -> Bool) -> i0 a -> i1 a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps


{-| Does x `starts` y? Is x `startedBy` y?

Example data with corresponding diagram:

>>> x = bi 3 4
>>> y = bi 6 4
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
    ---    <- [x]
    ------ <- [y]
==========

Examples:

>>> x `starts` y
True

>>> x `startedBy` y
False

>>> y `starts` x
False

>>> y `startedBy` x
True
-}
starts, startedBy
  :: (Ord a, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
starts :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts i0 a
x i1 a
y = i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i0 a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i1 a
y
startedBy :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy = (i1 a -> i0 a -> Bool) -> i0 a -> i1 a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts


{- | Does x `finishes` y? Is x `finishedBy` y?

Example data with corresponding diagram:

>>> x = bi 3 7
>>> y = bi 6 4
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
       --- <- [x]
    ------ <- [y]
==========

Examples:

>>> x `finishes` y
True

>>> x `finishedBy` y
False

>>> y `finishes` x
False

>>> y `finishedBy` x
True
-}
finishes, finishedBy
  :: (Ord a, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
finishes :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes i0 a
x i1 a
y = i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i1 a
y
finishedBy :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy = (i1 a -> i0 a -> Bool) -> i0 a -> i1 a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes


{-| Is x `during` y? Does x `contains` y?

Example data with corresponding diagram:

>>> x = bi 3 5
>>> y = bi 6 4
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
     ---   <- [x]
    ------ <- [y]
==========

Examples:

>>> x `during` y
True

>>> x `contains` y
False

>>> y `during` x
False

>>> y `contains` x
True
-}
during, contains
  :: (Ord a, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
during :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during i0 a
x i1 a
y = i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i1 a
y
contains :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains = (i1 a -> i0 a -> Bool) -> i0 a -> i1 a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during


{- | Does x `equals` y?

Example data with corresponding diagram:

>>> x = bi 6 4
>>> y = bi 6 4
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
    ------ <- [x]
    ------ <- [y]
==========

Examples:

>>> x `equals` y
True

>>> y `equals` x
True
-}
equals
  :: (Ord a, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
equals :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
equals i0 a
x i1 a
y = i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i0 a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i1 a
y Bool -> Bool -> Bool
&& i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== i1 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i1 a
y

-- | Operator for composing the union of two predicates
(<|>)
  :: (Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
  -> ComparativePredicateOf2 (i0 a) (i1 a)
  -> ComparativePredicateOf2 (i0 a) (i1 a)
<|> :: forall (i0 :: * -> *) (i1 :: * -> *) a.
(Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
-> ComparativePredicateOf2 (i0 a) (i1 a)
(<|>) ComparativePredicateOf2 (i0 a) (i1 a)
f ComparativePredicateOf2 (i0 a) (i1 a)
g = [ComparativePredicateOf2 (i0 a) (i1 a)]
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall a b.
[ComparativePredicateOf2 a b] -> ComparativePredicateOf2 a b
unionPredicates [ComparativePredicateOf2 (i0 a) (i1 a)
f, ComparativePredicateOf2 (i0 a) (i1 a)
g]

-- | The set of @IntervalRelation@ meaning two intervals are disjoint.
disjointRelations :: Data.Set.Set IntervalRelation
disjointRelations :: Set IntervalRelation
disjointRelations = [IntervalRelation] -> Set IntervalRelation
toSet [IntervalRelation
Before, IntervalRelation
After, IntervalRelation
Meets, IntervalRelation
MetBy]

-- | The set of @IntervalRelation@ meaning one interval is within the other.
withinRelations :: Data.Set.Set IntervalRelation
withinRelations :: Set IntervalRelation
withinRelations = [IntervalRelation] -> Set IntervalRelation
toSet [IntervalRelation
Starts, IntervalRelation
During, IntervalRelation
Finishes, IntervalRelation
Equals]

-- | The set of @IntervalRelation@ meaning one interval is *strictly* within the other.
strictWithinRelations :: Data.Set.Set IntervalRelation
strictWithinRelations :: Set IntervalRelation
strictWithinRelations = Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set IntervalRelation
withinRelations ([IntervalRelation] -> Set IntervalRelation
toSet [IntervalRelation
Equals])


{- | Are x and y `disjoint` ('before', 'after', 'meets', or 'metBy')?

Example data with corresponding diagram:

>>> x = bi 3 0
>>> y = bi 3 5
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
---      <- [x]
     --- <- [y]
========

Examples:

>>> x `disjoint` y
True

>>> y `disjoint` x
True

Example data with corresponding diagram:

>>> x = bi 3 0
>>> y = bi 3 3
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
---    <- [x]
   --- <- [y]
======

Examples:

>>> x `disjoint` y
True

>>> y `disjoint` x
True

Example data with corresponding diagram:

>>> x = bi 6 0
>>> y = bi 3 3
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
------ <- [x]
   --- <- [y]
======

Examples:

>>> x `disjoint` y
False

>>> y `disjoint` x
False
-}
disjoint
  :: (Ord a, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
disjoint :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
disjoint = Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate Set IntervalRelation
disjointRelations


{-| Does x `concur` with y? Is x `notDisjoint` with y?); This is
the 'complement' of 'disjoint'.

Example data with corresponding diagram:

>>> x = bi 3 0
>>> y = bi 3 4
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
---     <- [x]
    --- <- [y]
=======

Examples:

>>> x `notDisjoint` y
False
>>> y `concur` x
False

Example data with corresponding diagram:

>>> x = bi 3 0
>>> y = bi 3 3
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
---    <- [x]
   --- <- [y]
======

Examples:

>>> x `notDisjoint` y
False
>>> y `concur` x
False

Example data with corresponding diagram:

>>> x = bi 6 0
>>> y = bi 3 3
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
------ <- [x]
   --- <- [y]
======

Examples:

>>> x `notDisjoint` y
True
>>> y `concur` x
True
-}
notDisjoint, concur
  :: (Ord a, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
notDisjoint :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
notDisjoint = Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate (Set IntervalRelation -> Set IntervalRelation
complement Set IntervalRelation
disjointRelations)
concur :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
concur = ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
notDisjoint


{- | Is x `within` (`enclosedBy`) y? That is, 'during', 'starts', 'finishes', or
'equals'?

Example data with corresponding diagram:

>>> x = bi 6 4
>>> y = bi 6 4
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
    ------ <- [x]
    ------ <- [y]
==========

Examples:

>>> x `within` y
True

>>> y `enclosedBy` x
True

Example data with corresponding diagram:

>>> x = bi 6 4
>>> y = bi 5 4
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
    ------ <- [x]
    -----  <- [y]
==========

Examples:

>>> x `within` y
False

>>> y `enclosedBy` x
True

Example data with corresponding diagram:

>>> x = bi 6 4
>>> y = bi 4 5
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
    ------ <- [x]
     ----  <- [y]
==========

Examples:

>>> x `within` y
False
>>> y `enclosedBy` x
True

Example data with corresponding diagram:

>>> x = bi 2 7
>>> y = bi 1 5
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
       -- <- [x]
     -    <- [y]
=========

Examples:

>>> x `within` y
False

>>> y `enclosedBy` x
False
-}
within, enclosedBy
  :: (Ord a, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
within :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
within = Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate Set IntervalRelation
withinRelations
enclosedBy :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
enclosedBy = ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
within


{- | Does x `encloses` y? That is, is y 'within' x?

Example data with corresponding diagram:

>>> x = bi 6 4
>>> y = bi 6 4
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
    ------ <- [x]
    ------ <- [y]
==========

Examples:

>>> x `encloses` y
True

>>> y `encloses` x
True

Example data with corresponding diagram:

>>> x = bi 6 4
>>> y = bi 5 4
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
    ------ <- [x]
    -----  <- [y]
==========

Examples:

>>> x `encloses` y
True

>>> y `encloses` x
False

Example data with corresponding diagram:

>>> x = bi 6 4
>>> y = bi 4 5
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
    ------ <- [x]
     ----  <- [y]
==========

Examples:

>>> x `encloses` y
True

>>> y `encloses` x
False

Example data with corresponding diagram:

>>> x = bi 2 7
>>> y = bi 1 5
>>> pretty $ standardExampleDiagram [(x, "x"), (y, "y")] []
       -- <- [x]
     -    <- [y]
=========

Examples:

>>> x `encloses` y
False

>>> y `encloses` x
False
-}
encloses
  :: (Ord a, Intervallic i0, Intervallic i1)
  => ComparativePredicateOf2 (i0 a) (i1 a)
encloses :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
encloses = (i1 a -> i0 a -> Bool) -> i0 a -> i1 a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip i1 a -> i0 a -> Bool
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
enclosedBy

-- | The 'Data.Set.Set' of all 'IntervalRelation's.
intervalRelations :: Data.Set.Set IntervalRelation
intervalRelations :: Set IntervalRelation
intervalRelations =
  [IntervalRelation] -> Set IntervalRelation
forall a. Ord a => [a] -> Set a
Data.Set.fromList ((Int -> IntervalRelation) -> [Int] -> [IntervalRelation]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Int -> IntervalRelation
forall a. Enum a => Int -> a
toEnum [Int
0 .. Int
12] :: [IntervalRelation])

-- | Find the converse of a single 'IntervalRelation'
converseRelation :: IntervalRelation -> IntervalRelation
converseRelation :: IntervalRelation -> IntervalRelation
converseRelation IntervalRelation
x = Int -> IntervalRelation
forall a. Enum a => Int -> a
toEnum (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
- IntervalRelation -> Int
forall a. Enum a => a -> Int
fromEnum IntervalRelation
x)

-- | Shortcut to creating a 'Set IntervalRelation' from a list.
toSet :: [IntervalRelation] -> Data.Set.Set IntervalRelation
toSet :: [IntervalRelation] -> Set IntervalRelation
toSet = [IntervalRelation] -> Set IntervalRelation
forall a. Ord a => [a] -> Set a
Data.Set.fromList

-- | Compose a list of interval relations with _or_ to create a new
-- @'ComparativePredicateOf1' i a@. For example,
-- @unionPredicates [before, meets]@ creates a predicate function determining
-- if one interval is either before or meets another interval.
unionPredicates :: [ComparativePredicateOf2 a b] -> ComparativePredicateOf2 a b
unionPredicates :: forall a b.
[ComparativePredicateOf2 a b] -> ComparativePredicateOf2 a b
unionPredicates [ComparativePredicateOf2 a b]
fs a
x b
y = (ComparativePredicateOf2 a b -> Bool)
-> [ComparativePredicateOf2 a b] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ComparativePredicateOf2 a b
f -> ComparativePredicateOf2 a b
f a
x b
y) [ComparativePredicateOf2 a b]
fs

-- | Maps an 'IntervalRelation' to its corresponding predicate function.
toPredicate
  :: (Ord a, Intervallic i0, Intervallic i1)
  => IntervalRelation
  -> ComparativePredicateOf2 (i0 a) (i1 a)
toPredicate :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
toPredicate IntervalRelation
r = case IntervalRelation
r of
  IntervalRelation
Before       -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before
  IntervalRelation
Meets        -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
meets
  IntervalRelation
Overlaps     -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps
  IntervalRelation
FinishedBy   -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy
  IntervalRelation
Contains     -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains
  IntervalRelation
Starts       -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts
  IntervalRelation
Equals       -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
equals
  IntervalRelation
StartedBy    -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy
  IntervalRelation
During       -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during
  IntervalRelation
Finishes     -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes
  IntervalRelation
OverlappedBy -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy
  IntervalRelation
MetBy        -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
metBy
  IntervalRelation
After        -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
after

-- | Given a set of 'IntervalRelation's return a list of 'predicate' functions
--   corresponding to each relation.
predicates
  :: (Ord a, Intervallic i0, Intervallic i1)
  => Data.Set.Set IntervalRelation
  -> [ComparativePredicateOf2 (i0 a) (i1 a)]
predicates :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
Set IntervalRelation -> [ComparativePredicateOf2 (i0 a) (i1 a)]
predicates Set IntervalRelation
x = (IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a))
-> [IntervalRelation] -> [ComparativePredicateOf2 (i0 a) (i1 a)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
toPredicate (Set IntervalRelation -> [IntervalRelation]
forall a. Set a -> [a]
Data.Set.toList Set IntervalRelation
x)

-- | Forms a predicate function from the union of a set of 'IntervalRelation's.
predicate
  :: (Ord a, Intervallic i0, Intervallic i1)
  => Data.Set.Set IntervalRelation
  -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate = [ComparativePredicateOf2 (i0 a) (i1 a)]
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall a b.
[ComparativePredicateOf2 a b] -> ComparativePredicateOf2 a b
unionPredicates ([ComparativePredicateOf2 (i0 a) (i1 a)]
 -> ComparativePredicateOf2 (i0 a) (i1 a))
-> (Set IntervalRelation
    -> [ComparativePredicateOf2 (i0 a) (i1 a)])
-> Set IntervalRelation
-> ComparativePredicateOf2 (i0 a) (i1 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set IntervalRelation -> [ComparativePredicateOf2 (i0 a) (i1 a)]
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
Set IntervalRelation -> [ComparativePredicateOf2 (i0 a) (i1 a)]
predicates

-- | The lookup table for the compositions of interval relations.
composeRelationLookup :: [[[IntervalRelation]]]
composeRelationLookup :: [[[IntervalRelation]]]
composeRelationLookup =
  [ [[IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
pmosd, [IntervalRelation]
pmosd, [IntervalRelation]
pmosd, [IntervalRelation]
pmosd, [IntervalRelation]
full]
  , [[IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
m, [IntervalRelation]
m, [IntervalRelation]
m, [IntervalRelation]
osd, [IntervalRelation]
osd, [IntervalRelation]
osd, [IntervalRelation]
fef, [IntervalRelation]
dsomp]
  , [[IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
pmo, [IntervalRelation]
pmo, [IntervalRelation]
pmofd, [IntervalRelation]
o, [IntervalRelation]
o, [IntervalRelation]
ofd, [IntervalRelation]
osd, [IntervalRelation]
osd, [IntervalRelation]
cncr, [IntervalRelation]
dso, [IntervalRelation]
dsomp]
  , [[IntervalRelation]
p, [IntervalRelation]
m, [IntervalRelation]
o, [IntervalRelation]
f', [IntervalRelation]
d', [IntervalRelation]
o, [IntervalRelation]
f', [IntervalRelation]
d', [IntervalRelation]
osd, [IntervalRelation]
fef, [IntervalRelation]
dso, [IntervalRelation]
dso, [IntervalRelation]
dsomp]
  , [[IntervalRelation]
pmofd, [IntervalRelation]
ofd, [IntervalRelation]
ofd, [IntervalRelation]
d', [IntervalRelation]
d', [IntervalRelation]
ofd, [IntervalRelation]
d', [IntervalRelation]
d', [IntervalRelation]
cncr, [IntervalRelation]
dso, [IntervalRelation]
dso, [IntervalRelation]
dso, [IntervalRelation]
dsomp]
  , [[IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
pmo, [IntervalRelation]
pmo, [IntervalRelation]
pmofd, [IntervalRelation]
s, [IntervalRelation]
s, [IntervalRelation]
ses, [IntervalRelation]
d, [IntervalRelation]
d, [IntervalRelation]
dfo, [IntervalRelation]
m', [IntervalRelation]
p']
  , [[IntervalRelation]
p, [IntervalRelation]
m, [IntervalRelation]
o, [IntervalRelation]
f', [IntervalRelation]
d', [IntervalRelation]
s, [IntervalRelation]
e, [IntervalRelation]
s', [IntervalRelation]
d, [IntervalRelation]
f, [IntervalRelation]
o', [IntervalRelation]
m', [IntervalRelation]
p']
  , [[IntervalRelation]
pmofd, [IntervalRelation]
ofd, [IntervalRelation]
ofd, [IntervalRelation]
d', [IntervalRelation]
d', [IntervalRelation]
ses, [IntervalRelation]
s', [IntervalRelation]
s', [IntervalRelation]
dfo, [IntervalRelation]
o', [IntervalRelation]
o', [IntervalRelation]
m', [IntervalRelation]
p']
  , [[IntervalRelation]
p, [IntervalRelation]
p, [IntervalRelation]
pmosd, [IntervalRelation]
pmosd, [IntervalRelation]
full, [IntervalRelation]
d, [IntervalRelation]
d, [IntervalRelation]
dfomp, [IntervalRelation]
d, [IntervalRelation]
d, [IntervalRelation]
dfomp, [IntervalRelation]
p', [IntervalRelation]
p']
  , [[IntervalRelation]
p, [IntervalRelation]
m, [IntervalRelation]
osd, [IntervalRelation]
fef, [IntervalRelation]
dsomp, [IntervalRelation]
d, [IntervalRelation]
f, [IntervalRelation]
omp, [IntervalRelation]
d, [IntervalRelation]
f, [IntervalRelation]
omp, [IntervalRelation]
p', [IntervalRelation]
p']
  , [[IntervalRelation]
pmofd, [IntervalRelation]
ofd, [IntervalRelation]
cncr, [IntervalRelation]
dso, [IntervalRelation]
dsomp, [IntervalRelation]
dfo, [IntervalRelation]
o', [IntervalRelation]
omp, [IntervalRelation]
dfo, [IntervalRelation]
o', [IntervalRelation]
omp, [IntervalRelation]
p', [IntervalRelation]
p']
  , [[IntervalRelation]
pmofd, [IntervalRelation]
ses, [IntervalRelation]
dfo, [IntervalRelation]
m', [IntervalRelation]
p', [IntervalRelation]
dfo, [IntervalRelation]
m', [IntervalRelation]
p', [IntervalRelation]
dfo, [IntervalRelation]
m', [IntervalRelation]
p', [IntervalRelation]
p', [IntervalRelation]
p']
  , [[IntervalRelation]
full, [IntervalRelation]
dfomp, [IntervalRelation]
dfomp, [IntervalRelation]
p', [IntervalRelation]
p', [IntervalRelation]
dfomp, [IntervalRelation]
p', [IntervalRelation]
p', [IntervalRelation]
dfomp, [IntervalRelation]
p', [IntervalRelation]
p', [IntervalRelation]
p', [IntervalRelation]
p']
  ]
 where
  p :: [IntervalRelation]
p     = [IntervalRelation
Before]
  m :: [IntervalRelation]
m     = [IntervalRelation
Meets]
  o :: [IntervalRelation]
o     = [IntervalRelation
Overlaps]
  f' :: [IntervalRelation]
f'    = [IntervalRelation
FinishedBy]
  d' :: [IntervalRelation]
d'    = [IntervalRelation
Contains]
  s :: [IntervalRelation]
s     = [IntervalRelation
Starts]
  e :: [IntervalRelation]
e     = [IntervalRelation
Equals]
  s' :: [IntervalRelation]
s'    = [IntervalRelation
StartedBy]
  d :: [IntervalRelation]
d     = [IntervalRelation
During]
  f :: [IntervalRelation]
f     = [IntervalRelation
Finishes]
  o' :: [IntervalRelation]
o'    = [IntervalRelation
OverlappedBy]
  m' :: [IntervalRelation]
m'    = [IntervalRelation
MetBy]
  p' :: [IntervalRelation]
p'    = [IntervalRelation
After]
  ses :: [IntervalRelation]
ses   = [IntervalRelation]
s [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
e [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
s'
  fef :: [IntervalRelation]
fef   = [IntervalRelation]
f' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
e [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f
  pmo :: [IntervalRelation]
pmo   = [IntervalRelation]
p [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
o
  pmofd :: [IntervalRelation]
pmofd = [IntervalRelation]
pmo [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
d'
  osd :: [IntervalRelation]
osd   = [IntervalRelation]
o [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
s [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
d
  ofd :: [IntervalRelation]
ofd   = [IntervalRelation]
o [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
d'
  omp :: [IntervalRelation]
omp   = [IntervalRelation]
o' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
p'
  dfo :: [IntervalRelation]
dfo   = [IntervalRelation]
d [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
o'
  dfomp :: [IntervalRelation]
dfomp = [IntervalRelation]
dfo [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
p'
  dso :: [IntervalRelation]
dso   = [IntervalRelation]
d' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
s' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
o'
  dsomp :: [IntervalRelation]
dsomp = [IntervalRelation]
dso [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
p'
  pmosd :: [IntervalRelation]
pmosd = [IntervalRelation]
p [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
osd
  cncr :: [IntervalRelation]
cncr  = [IntervalRelation]
o [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
d' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
s [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
e [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
s' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
d [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
f [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
o'
  full :: [IntervalRelation]
full  = [IntervalRelation]
p [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
cncr [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
m' [IntervalRelation] -> [IntervalRelation] -> [IntervalRelation]
forall a. [a] -> [a] -> [a]
++ [IntervalRelation]
p'

{- | Compare two @i a@ to determine their 'IntervalRelation'.

>>> relate (Interval (0::Int, 1)) (Interval (1, 2))
Meets

>>> relate (Interval (1::Int, 2)) (Interval (0, 1))
MetBy
-}
relate
  :: (Ord a, Intervallic i0, Intervallic i1) => i0 a -> i1 a -> IntervalRelation
relate :: forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
i0 a -> i1 a -> IntervalRelation
relate i0 a
x i1 a
y | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`before` i1 a
y       = IntervalRelation
Before
           | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`after` i1 a
y        = IntervalRelation
After
           | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`meets` i1 a
y        = IntervalRelation
Meets
           | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`metBy` i1 a
y        = IntervalRelation
MetBy
           | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`overlaps` i1 a
y     = IntervalRelation
Overlaps
           | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`overlappedBy` i1 a
y = IntervalRelation
OverlappedBy
           | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`starts` i1 a
y       = IntervalRelation
Starts
           | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`startedBy` i1 a
y    = IntervalRelation
StartedBy
           | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`finishes` i1 a
y     = IntervalRelation
Finishes
           | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`finishedBy` i1 a
y   = IntervalRelation
FinishedBy
           | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`during` i1 a
y       = IntervalRelation
During
           | i0 a
x ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`contains` i1 a
y     = IntervalRelation
Contains
           | Bool
otherwise          = IntervalRelation
Equals

{- | Compose two interval relations according to the rules of the algebra.
The rules are enumerated according to
<https://thomasalspaugh.org/pub/fnd/allen.html#BasicCompositionsTable this table>.
-}
compose
  :: IntervalRelation -> IntervalRelation -> Data.Set.Set IntervalRelation
compose :: IntervalRelation -> IntervalRelation -> Set IntervalRelation
compose IntervalRelation
x IntervalRelation
y = [IntervalRelation] -> Set IntervalRelation
toSet ([[[IntervalRelation]]]
composeRelationLookup [[[IntervalRelation]]] -> Int -> [[IntervalRelation]]
forall a. [a] -> Int -> a
!! IntervalRelation -> Int
forall a. Enum a => a -> Int
fromEnum IntervalRelation
x [[IntervalRelation]] -> Int -> [IntervalRelation]
forall a. [a] -> Int -> a
!! IntervalRelation -> Int
forall a. Enum a => a -> Int
fromEnum IntervalRelation
y)

-- | Finds the complement of a @'Data.Set.Set' 'IntervalRelation'@.
complement :: Data.Set.Set IntervalRelation -> Data.Set.Set IntervalRelation
complement :: Set IntervalRelation -> Set IntervalRelation
complement = Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set IntervalRelation
intervalRelations

-- | Find the intersection of two 'Data.Set.Set's of 'IntervalRelation's.
intersection
  :: Data.Set.Set IntervalRelation
  -> Data.Set.Set IntervalRelation
  -> Data.Set.Set IntervalRelation
intersection :: Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
intersection = Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.intersection

-- | Find the union of two 'Data.Set.Set's of 'IntervalRelation's.
union
  :: Data.Set.Set IntervalRelation
  -> Data.Set.Set IntervalRelation
  -> Data.Set.Set IntervalRelation
union :: Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
union = Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.union

-- | Find the converse of a @'Data.Set.Set' 'IntervalRelation'@.
converse :: Data.Set.Set IntervalRelation -> Data.Set.Set IntervalRelation
converse :: Set IntervalRelation -> Set IntervalRelation
converse = (IntervalRelation -> IntervalRelation)
-> Set IntervalRelation -> Set IntervalRelation
forall b a. Ord b => (a -> b) -> Set a -> Set b
Data.Set.map IntervalRelation -> IntervalRelation
converseRelation

{- | The 'IntervalSizeable' typeclass provides functions to determine the size of
an 'Intervallic' type and to resize an 'Interval a'.
-}
class (Ord a, Num b, Ord b) => IntervalSizeable a b | a -> b where

    -- | The smallest duration for an 'Interval a'.
    moment :: forall a . b
    moment = b
1

    -- | Determine the duration of an @'i a'@.
    duration :: (Intervallic i) => i a -> b
    duration i a
x = a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i a
x) (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i a
x)

    -- | Shifts an @a@. Most often, the @b@ will be the same type as @a@.
    --   But for example, if @a@ is 'Day' then @b@ could be 'Int'.
    add :: b -> a -> a

    -- | Takes the difference between two @a@ to return a @b@.
    diff :: a -> a -> b

{- | Resize an @i a@ to by expanding to "left" by @l@ and to the "right" by @r@.
In the case that @l@ or @r@ are less than a 'moment' the respective endpoints
are unchanged.

>>> iv2to4 = safeInterval (2::Int, 4::Int)
>>> iv2to4' = expand 0 0 iv2to4
>>> iv1to5 = expand 1 1 iv2to4

>>> iv2to4
(2, 4)

>>> iv2to4'
(2, 4)

>>> iv1to5
(1, 5)

>>> pretty $ standardExampleDiagram [(iv2to4, "iv2to4"), (iv1to5, "iv1to5")] []
  --  <- [iv2to4]
 ---- <- [iv1to5]
=====
-}
expand
  :: forall i a b
   . (IntervalSizeable a b, Intervallic i)
  => b -- ^ duration to subtract from the 'begin'
  -> b -- ^ duration to add to the 'end'
  -> i a
  -> i a
expand :: forall (i :: * -> *) a b.
(IntervalSizeable a b, Intervallic i) =>
b -> b -> i a -> i a
expand b
l b
r i a
p = i a -> Interval a -> i a
forall (i :: * -> *) a b. Intervallic i => i a -> Interval b -> i b
setInterval i a
p Interval a
i
 where
  s :: b
s = if b
l b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< forall a b a. IntervalSizeable a b => b
moment @a then b
0 else b -> b
forall a. Num a => a -> a
negate b
l
  e :: b
e = if b
r b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< forall a b a. IntervalSizeable a b => b
moment @a then b
0 else b
r
  i :: Interval a
i = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
add b
s (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i a
p, b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
add b
e (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i a
p)

{- | Expands an @i a@ to the "left".

>>> iv2to4 = (safeInterval (2::Int, 4::Int))
>>> iv0to4 = expandl 2 iv2to4

>>> iv2to4
(2, 4)

>>> iv0to4
(0, 4)

>>> pretty $ standardExampleDiagram [(iv2to4, "iv2to4"), (iv0to4, "iv0to4")] []
  -- <- [iv2to4]
---- <- [iv0to4]
====
-}
expandl :: (IntervalSizeable a b, Intervallic i) => b -> i a -> i a
expandl :: forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i) =>
b -> i a -> i a
expandl b
i = b -> b -> i a -> i a
forall (i :: * -> *) a b.
(IntervalSizeable a b, Intervallic i) =>
b -> b -> i a -> i a
expand b
i b
0

{- | Expands an @i a@ to the "right".

>>> iv2to4 = (safeInterval (2::Int, 4::Int))
>>> iv2to6 = expandr 2 iv2to4

>>> iv2to4
(2, 4)

>>> iv2to6
(2, 6)

>>> pretty $ standardExampleDiagram [(iv2to4, "iv2to4"), (iv2to6, "iv2to6")] []
  --   <- [iv2to4]
  ---- <- [iv2to6]
======
-}
expandr :: (IntervalSizeable a b, Intervallic i) => b -> i a -> i a
expandr :: forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i) =>
b -> i a -> i a
expandr = b -> b -> i a -> i a
forall (i :: * -> *) a b.
(IntervalSizeable a b, Intervallic i) =>
b -> b -> i a -> i a
expand b
0

{- | Safely creates an 'Interval a' using @x@ as the 'begin' and adding @max
'moment' dur@ to @x@ as the 'end'.

>>> beginerval (0::Int) (0::Int)
(0, 1)

>>> beginerval (1::Int) (0::Int)
(0, 1)

>>> beginerval (2::Int) (0::Int)
(0, 2)
-}
beginerval
  :: forall a b
   . (IntervalSizeable a b)
  => b -- ^ @dur@ation to add to the 'begin'
  -> a -- ^ the 'begin' point of the 'Interval'
  -> Interval a
beginerval :: forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval b
dur a
x = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
y)
 where
  i :: Interval a
i = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
x)
  d :: b
d = b -> b -> b
forall a. Ord a => a -> a -> a
max (forall a b a. IntervalSizeable a b => b
moment @a) b
dur
  y :: a
y = b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
add b
d a
x
{-# INLINABLE beginerval #-}

-- | A synonym for `beginerval`
bi
  :: (IntervalSizeable a b)
  => b -- ^ @dur@ation to add to the 'begin'
  -> a -- ^ the 'begin' point of the 'Interval'
  -> Interval a
bi :: forall a b. IntervalSizeable a b => b -> a -> Interval a
bi = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval


{- | Safely creates an 'Interval a' using @x@ as the 'end' and adding @negate max
'moment' dur@ to @x@ as the 'begin'.

>>> enderval (0::Int) (0::Int)
(-1, 0)

>>> enderval (1::Int) (0::Int)
(-1, 0)

>>> enderval (2::Int) (0::Int)
(-2, 0)
-}
enderval
  :: forall a b
   . (IntervalSizeable a b)
  => b -- ^ @dur@ation to subtract from the 'end'
  -> a -- ^ the 'end' point of the 'Interval'
  -> Interval a
enderval :: forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval b
dur a
x = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
add (b -> b
forall a. Num a => a -> a
negate (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a. Ord a => a -> a -> a
max (forall a b a. IntervalSizeable a b => b
moment @a) b
dur) a
x, a
x)
  where i :: Interval a
i = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
x)
{-# INLINABLE enderval #-}

-- | A synonym for `enderval`
ei
  :: (IntervalSizeable a b)
  => b -- ^ @dur@ation to subtract from the 'end'
  -> a -- ^ the 'end' point of the 'Interval'
  -> Interval a
ei :: forall a b. IntervalSizeable a b => b -> a -> Interval a
ei = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
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,
-- the duration will be an @"Interval"@ of 'moment' duration.
--
-- >>> safeInterval (4, 5 ::Int)
-- (4, 5)
-- >>> safeInterval (4, 3 :: Int)
-- (4, 5)
--
safeInterval :: IntervalSizeable a b => (a, a) -> Interval a
safeInterval :: forall a b. IntervalSizeable a b => (a, a) -> Interval a
safeInterval (a
b, a
e) = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
diff a
e a
b) a
b

-- | A synonym for `safeInterval`
si :: IntervalSizeable a b => (a, a) -> Interval a
si :: forall a b. IntervalSizeable a b => (a, a) -> Interval a
si = (a, a) -> Interval a
forall a b. IntervalSizeable a b => (a, a) -> Interval a
safeInterval

-- | Creates a new Interval from the 'end' of an @i a@.
beginervalFromEnd
  :: (IntervalSizeable a b, Intervallic i)
  => b  -- ^ @dur@ation to add to the 'end'
  -> i a -- ^ the @i a@ from which to get the 'end'
  -> Interval a
beginervalFromEnd :: forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i) =>
b -> i a -> Interval a
beginervalFromEnd b
d i a
i = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval b
d (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i a
i)

-- | Creates a new Interval from the 'begin' of an @i a@.
endervalFromBegin
  :: (IntervalSizeable a b, Intervallic i)
  => b -- ^ @dur@ation to subtract from the 'begin'
  -> i a -- ^ the @i a@ from which to get the 'begin'
  -> Interval a
endervalFromBegin :: forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i) =>
b -> i a -> Interval a
endervalFromBegin b
d i a
i = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval b
d (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i a
i)

{- | Safely creates a new @Interval@ with 'moment' length with 'begin' at @x@

>>> beginervalMoment (10 :: Int)
(10, 11)
-}
beginervalMoment :: forall a b . (IntervalSizeable a b) => a -> Interval a
beginervalMoment :: forall a b. IntervalSizeable a b => a -> Interval a
beginervalMoment a
x = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (forall a b a. IntervalSizeable a b => b
moment @a) a
x where i :: Interval a
i = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
x)

{- | Safely creates a new @Interval@ with 'moment' length with 'end' at @x@

>>> endervalMoment (10 :: Int)
(9, 10)
-}
endervalMoment :: forall a b . (IntervalSizeable a b) => a -> Interval a
endervalMoment :: forall a b. IntervalSizeable a b => a -> Interval a
endervalMoment a
x = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval (forall a b a. IntervalSizeable a b => b
moment @a) a
x where i :: Interval a
i = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
x)

{- | Creates a new @Interval@ spanning the extent x and y.

>>> extenterval (Interval (0, 1)) (Interval (9, 10))
(0, 10)
-}
extenterval :: (Ord a, Intervallic i) => i a -> i a -> Interval a
extenterval :: forall a (i :: * -> *).
(Ord a, Intervallic i) =>
i a -> i a -> Interval a
extenterval i a
x i a
y = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
s, a
e)
 where
  s :: a
s = a -> a -> a
forall a. Ord a => a -> a -> a
min (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i a
x) (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i a
y)
  e :: a
e = a -> a -> a
forall a. Ord a => a -> a -> a
max (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i a
x) (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i a
y)

{- | Modifies the endpoints of second argument's interval by taking the difference
from the first's input's 'begin'.

Example data with corresponding diagram:

>>> a = bi 3 2 :: Interval Int
>>> a
(2, 5)
>>> x = bi 3 7 :: Interval Int
>>> x
(7, 10)
>>> y = bi 4 9 :: Interval Int
>>> y
(9, 13)
>>> pretty $ standardExampleDiagram [(a, "a"), (x, "x"), (y, "y")] []
  ---         <- [a]
       ---    <- [x]
         ---- <- [y]
=============

Examples:

>>> x' = shiftFromBegin a x
>>> x'
(5, 8)
>>> y' = shiftFromBegin a y
>>> y'
(7, 11)
>>> pretty $ standardExampleDiagram [(x', "x'"), (y', "y'")] []
     ---    <- [x']
       ---- <- [y']
===========
-}
shiftFromBegin
  :: (IntervalSizeable a b, Intervallic i1, Intervallic i0)
  => i0 a
  -> i1 a
  -> i1 b
shiftFromBegin :: forall a b (i1 :: * -> *) (i0 :: * -> *).
(IntervalSizeable a b, Intervallic i1, Intervallic i0) =>
i0 a -> i1 a -> i1 b
shiftFromBegin i0 a
i = (a -> b) -> i1 a -> i1 b
forall (i :: * -> *) a b. Intervallic i => (a -> b) -> i a -> i b
imapStrictMonotone (a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
`diff` i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i0 a
i)

{- | Modifies the endpoints of second argument's interval by taking the difference
from the first's input's 'end'.

Example data with corresponding diagram:

>>> a = bi 3 2 :: Interval Int
>>> a
(2, 5)
>>> x = bi 3 7 :: Interval Int
>>> x
(7, 10)
>>> y = bi 4 9 :: Interval Int
>>> y
(9, 13)
>>> pretty $ standardExampleDiagram [(a, "a"), (x, "x"), (y, "y")] []
  ---         <- [a]
       ---    <- [x]
         ---- <- [y]
=============

Examples:

>>> x' = shiftFromEnd a x
>>> x'
(2, 5)
>>> y' = shiftFromEnd a y
>>> y'
(4, 8)
>>> pretty $ standardExampleDiagram [(x', "x'"), (y', "y'")] []
  ---    <- [x']
    ---- <- [y']
========
-}
shiftFromEnd
  :: (IntervalSizeable a b, Intervallic i1, Intervallic i0)
  => i0 a
  -> i1 a
  -> i1 b
shiftFromEnd :: forall a b (i1 :: * -> *) (i0 :: * -> *).
(IntervalSizeable a b, Intervallic i1, Intervallic i0) =>
i0 a -> i1 a -> i1 b
shiftFromEnd i0 a
i = (a -> b) -> i1 a -> i1 b
forall (i :: * -> *) a b. Intervallic i => (a -> b) -> i a -> i b
imapStrictMonotone (a -> a -> b
forall a b. IntervalSizeable a b => a -> a -> b
`diff` i0 a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i0 a
i)

-- | Converts an @i a@ to an @i Int@ via @fromEnum@.  This assumes the provided
-- @fromEnum@ method is strictly monotone increasing: For @a@ types that are
-- @Ord@ with values @x, y@, then @x < y@ implies @fromEnum x < fromEnum y@, so
-- long as the latter is well-defined.
fromEnumInterval :: (Enum a, Intervallic i) => i a -> i Int
fromEnumInterval :: forall a (i :: * -> *). (Enum a, Intervallic i) => i a -> i Int
fromEnumInterval = (a -> Int) -> i a -> i Int
forall (i :: * -> *) a b. Intervallic i => (a -> b) -> i a -> i b
imapStrictMonotone a -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Converts an @i Int@ to an @i a@ via @toEnum@.  This assumes the provided
-- @toEnum@ method is strictly monotone increasing: For @a@ types that are
-- @Ord@, then for @Int@ values @x, y@ it holds that @x < y@ implies @toEnum x
-- < toEnum y@.
toEnumInterval :: (Enum a, Intervallic i) => i Int -> i a
toEnumInterval :: forall a (i :: * -> *). (Enum a, Intervallic i) => i Int -> i a
toEnumInterval = (Int -> a) -> i Int -> i a
forall (i :: * -> *) a b. Intervallic i => (a -> b) -> i a -> i b
imapStrictMonotone Int -> a
forall a. Enum a => Int -> a
toEnum



{- | Changes the duration of an 'Intervallic' value to a moment starting at the
'begin' of the interval.

>>> momentize (Interval (6, 10))
(6, 7)
-}
momentize
  :: forall i a b . (IntervalSizeable a b, Intervallic i) => i a -> i a
momentize :: forall (i :: * -> *) a b.
(IntervalSizeable a b, Intervallic i) =>
i a -> i a
momentize i a
i = i a -> Interval a -> i a
forall (i :: * -> *) a b. Intervallic i => i a -> Interval b -> i b
setInterval i a
i (b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (forall a b a. IntervalSizeable a b => b
moment @a) (i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i a
i))

{- | The @'IntervalCombinable'@ typeclass provides methods for (possibly)
combining two @i a@s to form a @'Maybe' i a@, or in case of @><@, a possibly
different @Intervallic@ type.
-}
class (Ord a, Intervallic i) => IntervalCombinable i a where

    -- | Maybe form a new @i a@ by the union of two @i a@s that 'meets'.
    (.+.) ::  i a -> i a -> Maybe (i a)
    (.+.) i a
x i a
y
      | i a
x ComparativePredicateOf2 (i a) (i a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Eq a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`meets` i a
y = i a -> Maybe (i a)
forall a. a -> Maybe a
Just (i a -> Maybe (i a)) -> i a -> Maybe (i a)
forall a b. (a -> b) -> a -> b
$ i a -> Interval a -> i a
forall (i :: * -> *) a b. Intervallic i => i a -> Interval b -> i b
setInterval i a
y (Interval a -> i a) -> Interval a -> i a
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
b, a
e)
      | Bool
otherwise   = Maybe (i a)
forall a. Maybe a
Nothing
      where b :: a
b = i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin i a
x
            e :: a
e = i a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end i a
y
    {-# INLINABLE (.+.) #-}

    -- | 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 (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)), Applicative f) =>
               i a
            -> i a
            -> f (i a)
{-# DEPRECATED (<+>) "A specialized function without clear use-cases." #-}

{-
Misc
-}

-- | Defines a predicate of two objects of type @a@.
type ComparativePredicateOf1 a = (a -> a -> Bool)

-- | Defines a predicate of two object of different types.
type ComparativePredicateOf2 a b = (a -> b -> Bool)

-- {-
-- Instances
-- -}

-- | Imposes a total ordering on @'Interval' a@ based on first ordering the
--   'begin's then the 'end's.
instance (Ord a) => Ord (Interval a) where
  <= :: Interval a -> Interval a -> Bool
(<=) Interval a
x Interval a
y | Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin Interval a
y  = Bool
True
           | Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin Interval a
y = Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end Interval a
y
           | Bool
otherwise          = Bool
False
  < :: Interval a -> Interval a -> Bool
(<) Interval a
x Interval a
y | Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin Interval a
y  = Bool
True
          | Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin Interval a
y = Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end Interval a
y
          | Bool
otherwise          = Bool
False

instance Intervallic Interval where
  getInterval :: forall a. Interval a -> Interval a
getInterval = Interval a -> Interval a
forall a. a -> a
id
  setInterval :: forall a b. Interval a -> Interval b -> Interval b
setInterval Interval a
_ Interval b
x = Interval b
x

instance (Ord a) => IntervalCombinable Interval a where
  >< :: Interval a -> Interval a -> Maybe (Interval a)
(><) Interval a
x Interval a
y | Interval a
x ComparativePredicateOf2 (Interval a) (Interval a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`before` Interval a
y = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
end Interval a
x, Interval a -> a
forall (i :: * -> *) a. Intervallic i => i a -> a
begin Interval a
y)
           | Bool
otherwise    = Maybe (Interval a)
forall a. Maybe a
Nothing
  {-# INLINABLE (><) #-}

  <+> :: forall (f :: * -> *).
(Semigroup (f (Interval a)), Applicative f) =>
Interval a -> Interval a -> f (Interval a)
(<+>) Interval a
x Interval a
y | Interval a
x ComparativePredicateOf2 (Interval a) (Interval a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
`before` Interval a
y = Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Interval a
x f (Interval a) -> f (Interval a) -> f (Interval a)
forall a. Semigroup a => a -> a -> a
<> Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Interval a
y
            | Bool
otherwise    = Interval a -> f (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Interval a -> Interval a -> Interval a
forall a (i :: * -> *).
(Ord a, Intervallic i) =>
i a -> i a -> Interval a
extenterval Interval a
x Interval a
y)
  {-# INLINABLE (<+>) #-}

instance IntervalSizeable Int Int where
  moment :: forall a. Int
moment = Int
1
  add :: Int -> Int -> Int
add    = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
  diff :: Int -> Int -> Int
diff   = (-)

instance IntervalSizeable Integer Integer where
  moment :: forall a. Integer
moment = Integer
1
  add :: Integer -> Integer -> Integer
add    = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
  diff :: Integer -> Integer -> Integer
diff   = (-)

instance IntervalSizeable DT.Day Integer where
  moment :: forall a. Integer
moment = Integer
1
  add :: Integer -> Day -> Day
add    = Integer -> Day -> Day
addDays
  diff :: Day -> Day -> Integer
diff   = Day -> Day -> Integer
diffDays

-- | Note that the @moment@ of this instance is a @'Data.Fixed.Pico'@
instance IntervalSizeable DT.UTCTime NominalDiffTime where
  moment :: forall a. NominalDiffTime
moment = Int -> NominalDiffTime
forall a. Enum a => Int -> a
toEnum Int
1 :: NominalDiffTime
  add :: NominalDiffTime -> UTCTime -> UTCTime
add    = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime
  diff :: UTCTime -> UTCTime -> NominalDiffTime
diff   = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime

-- Arbitrary instances
instance (Ord a, Arbitrary a) => Arbitrary (Interval a) where
  arbitrary :: Gen (Interval a)
arbitrary =
    (Int -> Gen (Interval a)) -> Gen (Interval a)
forall a. (Int -> Gen a) -> Gen a
sized
        (\Int
s -> (a -> a -> Interval a) -> Gen a -> Gen a -> Gen (Interval a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (((a, a) -> Interval a) -> a -> a -> Interval a
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval)
                      (Int
s Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
`resize` Gen a
forall a. Arbitrary a => Gen a
arbitrary)
                      (Int
s Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
`resize` Gen a
forall a. Arbitrary a => Gen a
arbitrary)
        )
      Gen (Interval a) -> (Interval a -> Bool) -> Gen (Interval a)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (\Interval a
i -> a -> a -> Bool
forall a. Ord a => a -> a -> Bool
isValidBeginEnd (Interval a -> a
forall a. Interval a -> a
intervalBegin Interval a
i) (Interval a -> a
forall a. Interval a -> a
intervalEnd Interval a
i))