{-|
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 Safe #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}

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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: (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 :: 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 :: ComparativePredicateOf2 (i0 a) (i1 a)
metBy = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
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 :: 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 :: ComparativePredicateOf2 (i0 a) (i1 a)
after = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
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 :: 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 :: 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 :: 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 :: ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
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 :: 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 :: ComparativePredicateOf2 (i0 a) (i1 a)
startedBy = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
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 :: 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 :: ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
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 :: 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 :: ComparativePredicateOf2 (i0 a) (i1 a)
contains = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
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 :: 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)
<|> :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: ComparativePredicateOf2 (i0 a) (i1 a)
encloses = (i1 a -> i0 a -> Bool) -> ComparativePredicateOf2 (i0 a) (i1 a)
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 :: [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 :: 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 :: 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 :: 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 :: 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 :: 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 b a. IntervalSizeable a b => b
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 b a. IntervalSizeable a b => b
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 :: 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 :: 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 :: 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 b a. IntervalSizeable a b => b
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 :: 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 :: 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 b a. IntervalSizeable a b => b
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 :: 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 :: (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 :: (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 :: 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 :: 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 :: a -> Interval a
beginervalMoment a
x = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (forall b a. IntervalSizeable a b => b
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 :: a -> Interval a
endervalMoment a
x = b -> a -> Interval a
forall a b. IntervalSizeable a b => b -> a -> Interval a
enderval (forall b a. IntervalSizeable a b => b
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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 b a. IntervalSizeable a b => b
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 :: Interval a -> Interval a
getInterval = Interval a -> Interval a
forall a. a -> a
id
  setInterval :: 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 (><) #-}

  <+> :: 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 :: 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 :: 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 :: 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 :: 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))