{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}

-- |
-- Module      : Interval Algebra
-- Description : Implementation of Allen's interval algebra
-- Copyright   : (c) NoviSci, Inc 2020-2022
--                   TargetRWE, 2023
-- License     : BSD3
-- Maintainer  : bsaul@novisci.com 2020-2022, bbrown@targetrwe.com 2023
--
-- 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 provides an 'Interval' type wrapping a canonical interval to be used with the 
-- relation algebra defined in the papers cited above. @'Interval' a@
-- wraps @(a, a)@, giving the interval's 'begin' and 'end' points.
-- 
-- However, the module provides typeclasses to generalize an 'Interval' and the
-- interval algebra for temporal logic, such that it could be used in settings 
-- where there is no need for continguity between the begin and end points, or 
-- where the "intervals" are qualitative and do not have a begin or end. See 
-- 'Iv' for an example.

-- Many exports of this module require `FlexibleContexts` and `TypeFamilies`
-- extensions to be enabled.
module IntervalAlgebra.Core
  ( -- * Canonical intervals
    Interval,
    PointedIv (..),
    SizedIv (..),
    Intervallic (..),
    begin,
    end,

    -- ** Create new intervals
    ParseErrorInterval (..),
    parseInterval,
    prsi,
    beginerval,
    bi,
    enderval,
    ei,
    safeInterval,
    si,

    -- ** Modify intervals within an @Intervallic@
    expand,
    expandl,
    expandr,
    
    -- ** Combine two intervals
    extenterval,

    -- * Interval Algebra
    Iv (..),

    -- ** 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,
    converseRelation,
  )
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.Kind           (Type)
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           GHC.IO.Handle       (NewlineMode (inputNL))
import           Test.QuickCheck     (Arbitrary (..), resize, sized, suchThat)

-- $setup
-- >>> import IntervalAlgebra.IntervalDiagram
-- >>> :set -XTypeFamilies

-- | 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

-- | Parse a pair of @a@s to create an @'Interval' a@. Note this
-- checks only that @begin < end@ and has no relation to checking
-- the conditions of 'SizedIv'.
--
-- >>> 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

instance (Show a, Ord a) => Show (Interval a) where
  show :: Interval a -> String
show (Interval (a, a)
x) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show ((a, a) -> a
forall a b. (a, b) -> a
fst (a, 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 ((a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance Binary a => Binary (Interval a)

instance NFData a => NFData (Interval a)

{- INTERVALLIC -}

-- | The @'Intervallic'@ typeclass defines how to get and set the 'Interval'
-- content of a data structure. 'Intervallic' types can be compared via
-- 'IntervalRelation' s on their underlying 'Interval', and functions of this
-- module define versions of the methods from 'Iv', 'PointedIv' and 'SizedIv'
-- for instances of 'Intervallic' by applying them to the contained interval.
--
-- Only the canonical representation @'Interval'@ should define an instance of all four
-- classes.
--
-- 'PairedInterval' is the prototypical example of an 'Intervallic'.
--
-- >>> 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 :: forall i a. (SizedIv (Interval a), Intervallic i) => i a -> a
begin :: i a -> a
begin = Interval a -> a
forall iv. PointedIv iv => iv -> Point iv
ivBegin (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 iv. PointedIv iv => iv -> Point iv
ivEnd (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)

{- RELATIONS -}

-- | The 'IntervalRelation' type and the associated predicate functions enumerate
-- the thirteen possible ways that two @'SizedIv'@ 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 (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, 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)

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 ::
    (Iv (Interval a), Intervallic i0, Intervallic i1) =>
    ComparativePredicateOf2 (i0 a) (i1 a)
meets :: ComparativePredicateOf2 (i0 a) (i1 a)
meets i0 a
x i1 a
y = Interval a -> Interval a -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivMeets (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i0 a
x) (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval 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 :: * -> *).
(Iv (Interval 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 ::
    (Iv (Interval a), Intervallic i0, Intervallic i1) =>
    ComparativePredicateOf2 (i0 a) (i1 a)
before :: ComparativePredicateOf2 (i0 a) (i1 a)
before i0 a
x i1 a
y = Interval a -> Interval a -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivBefore (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i0 a
x) (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval 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 :: * -> *).
(Iv (Interval 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 :: * -> *).
(Iv (Interval 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 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
after

-- | Aliases for 'ivBefore' and 'ivAfter'.
ivPrecedes, ivPrecededBy :: (Iv iv) => iv -> iv -> Bool
ivPrecedes :: iv -> iv -> Bool
ivPrecedes = iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivBefore
ivPrecededBy :: iv -> iv -> Bool
ivPrecededBy = iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivAfter

-- | 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 ::
    (Iv (Interval a), Intervallic i0, Intervallic i1) =>
    ComparativePredicateOf2 (i0 a) (i1 a)
overlaps :: ComparativePredicateOf2 (i0 a) (i1 a)
overlaps i0 a
x i1 a
y = Interval a -> Interval a -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivOverlaps (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i0 a
x) (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval 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 :: * -> *).
(Iv (Interval 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 ::
    (Iv (Interval a), Intervallic i0, Intervallic i1) =>
    ComparativePredicateOf2 (i0 a) (i1 a)
starts :: ComparativePredicateOf2 (i0 a) (i1 a)
starts i0 a
x i1 a
y = Interval a -> Interval a -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivStarts (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i0 a
x) (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval 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 :: * -> *).
(Iv (Interval 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 ::
    (Iv (Interval a), Intervallic i0, Intervallic i1) =>
    ComparativePredicateOf2 (i0 a) (i1 a)
finishes :: ComparativePredicateOf2 (i0 a) (i1 a)
finishes i0 a
x i1 a
y = Interval a -> Interval a -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivFinishes (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i0 a
x) (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval 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 :: * -> *).
(Iv (Interval 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 ::
    (Iv (Interval a), Intervallic i0, Intervallic i1) =>
    ComparativePredicateOf2 (i0 a) (i1 a)
during :: ComparativePredicateOf2 (i0 a) (i1 a)
during i0 a
x i1 a
y = Interval a -> Interval a -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivDuring (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i0 a
x) (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval 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 :: * -> *).
(Iv (Interval 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 ::
  (Iv (Interval a), Intervallic i0, Intervallic i1) =>
  ComparativePredicateOf2 (i0 a) (i1 a)
equals :: ComparativePredicateOf2 (i0 a) (i1 a)
equals i0 a
x i1 a
y = Interval a -> Interval a -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivEquals (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i0 a
x) (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i1 a
y)

{- Intervallic-specific relation utilities -}

-- | Operator for composing the union of two predicates on 'Intervallic' s.
(<|>) ::
  (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 ::
  (SizedIv (Interval a), 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 :: * -> *).
(SizedIv (Interval a), Ord a, Intervallic i0, Intervallic i1) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate Set IntervalRelation
disjointRelations

-- | Does @x `concur` y@, meaning @x@ and @y@ share some support? Is @x `notDisjoint` 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 ::
    (SizedIv (Interval a), 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 :: * -> *).
(SizedIv (Interval a), 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 :: * -> *).
(SizedIv (Interval a), 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 ::
    (SizedIv (Interval a), 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 :: * -> *).
(SizedIv (Interval a), 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 :: * -> *).
(SizedIv (Interval a), 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 ::
  (SizedIv (Interval a), 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 :: * -> *).
(SizedIv (Interval a), 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 ::
  (SizedIv (Interval a), 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 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
before
  IntervalRelation
Meets        -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
meets
  IntervalRelation
Overlaps     -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlaps
  IntervalRelation
FinishedBy   -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishedBy
  IntervalRelation
Contains     -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
contains
  IntervalRelation
Starts       -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
starts
  IntervalRelation
Equals       -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
equals
  IntervalRelation
StartedBy    -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
startedBy
  IntervalRelation
During       -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
during
  IntervalRelation
Finishes     -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
finishes
  IntervalRelation
OverlappedBy -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
overlappedBy
  IntervalRelation
MetBy        -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval a), Intervallic i0, Intervallic i1) =>
ComparativePredicateOf2 (i0 a) (i1 a)
metBy
  IntervalRelation
After        -> ComparativePredicateOf2 (i0 a) (i1 a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(Iv (Interval 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 ::
  (SizedIv (Interval a), 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 :: * -> *).
(SizedIv (Interval a), 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 ::
  (SizedIv (Interval a), 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 :: * -> *).
(SizedIv (Interval a), 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 ::
  (Iv (Interval a), Intervallic i0, Intervallic i1) => i0 a -> i1 a -> IntervalRelation
relate :: i0 a -> i1 a -> IntervalRelation
relate i0 a
x i1 a
y = Interval a -> Interval a -> IntervalRelation
forall iv. Iv iv => iv -> iv -> IntervalRelation
ivRelate (i0 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i0 a
x) (i1 a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i1 a
y)

-- | 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

{- Generic interval interfaces -}

-- | Generic interface for defining relations between abstract representations
-- of intervals, for the purpose of [Allen's interval algebra](https://en.wikipedia.org/wiki/Allen%27s_interval_algebra).
--
-- In general, these "intervals" need not be representable as temporal intervals with a fixed
-- beginning and ending. Specifically, the relations can be defined to provide temporal reasoning
-- in a qualitative setting, examples of which are in Allen 1983.
--
-- For intervals that can be cast in canonical form as 'Interval' s with begin and end points,
-- see 'PointedIv' and 'SizedIv'.
--
-- Instances of 'Iv' must ensure any pair of intervals satisfies exactly one
-- of the thirteen possible 'IntervalRelation' s.
--
-- When 'iv' is also an instance of 'PointedIv', with @Ord (Point iv)@,
-- the requirement implies
--
-- @
-- ivBegin i < ivEnd i
-- @
--
-- [Allen 1983](https://dl.acm.org/doi/10.1145/182.358434)
-- defines the 'IntervalRelation' s for such cases, which is provided in this module
-- for the canonical representation @'Interval' a@.
--
-- ==== __Examples__
--
-- The following example is modified from Allen 1983 to demonstrate the algebra used for temporal
-- reasoning in a qualitative setting, for a case where 'iv' does not have points.
--
-- It represents the temporal logic of the statement
--
-- > We found the letter during dinner, after we made the decision.
--
-- >>> :{
--data GoingsOn = Dinner | FoundLetter | MadeDecision
--  deriving (Show, Eq)
--instance Iv GoingsOn where
--  ivRelate MadeDecision Dinner = Before
--  ivRelate MadeDecision FoundLetter = Before
--  ivRelate FoundLetter Dinner = During
--  ivRelate x y
--    | x == y = Equals
--    | otherwise = converseRelation (ivRelate y x)
-- :}
class Iv iv where
  {-# MINIMAL ivRelate | ivBefore, ivMeets, ivOverlaps, ivStarts, ivFinishes, ivDuring, ivEquals #-}

  -- | The 'IntervalRelation' between two intervals.
  ivRelate :: iv -> iv -> IntervalRelation
  ivRelate iv
x iv
y
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivBefore` iv
y = IntervalRelation
Before
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivAfter` iv
y = IntervalRelation
After
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivMeets` iv
y = IntervalRelation
Meets
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivMetBy` iv
y = IntervalRelation
MetBy
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivOverlaps` iv
y = IntervalRelation
Overlaps
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivOverlappedBy` iv
y = IntervalRelation
OverlappedBy
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivStarts` iv
y = IntervalRelation
Starts
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivStartedBy` iv
y = IntervalRelation
StartedBy
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivFinishes` iv
y = IntervalRelation
Finishes
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivFinishedBy` iv
y = IntervalRelation
FinishedBy
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivDuring` iv
y = IntervalRelation
During
    | iv
x iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
`ivContains` iv
y = IntervalRelation
Contains
    | Bool
otherwise = IntervalRelation
Equals

  -- \| Is @'ivRelate' x y == Before@? @'ivAfter' = flip 'ivBefore'@.
  ivBefore,
    ivAfter ::
      -- | 'x'
      iv ->
      -- | 'y'
      iv ->
      Bool
  ivBefore iv
x = (IntervalRelation -> IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation
Before) (IntervalRelation -> Bool)
-> (iv -> IntervalRelation) -> iv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. iv -> iv -> IntervalRelation
forall iv. Iv iv => iv -> iv -> IntervalRelation
ivRelate iv
x
  ivAfter = (iv -> iv -> Bool) -> iv -> iv -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivBefore

  -- | Is @'ivRelate' x y == Meets@? @'ivMetBy' = flip 'ivMeets'@.
  ivMeets,
    ivMetBy ::
      -- | 'x'
      iv ->
      -- | 'y'
      iv ->
      Bool
  ivMeets iv
x = (IntervalRelation -> IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation
Meets) (IntervalRelation -> Bool)
-> (iv -> IntervalRelation) -> iv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. iv -> iv -> IntervalRelation
forall iv. Iv iv => iv -> iv -> IntervalRelation
ivRelate iv
x
  ivMetBy = (iv -> iv -> Bool) -> iv -> iv -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivMeets

  -- | Is @'ivRelate' x y == Overlaps@? @'ivOverlappedBy' = flip 'ivOverlaps'@.
  ivOverlaps,
    ivOverlappedBy ::
      -- | 'x'
      iv ->
      -- | 'y'
      iv ->
      Bool
  ivOverlaps iv
x = (IntervalRelation -> IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation
Overlaps) (IntervalRelation -> Bool)
-> (iv -> IntervalRelation) -> iv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. iv -> iv -> IntervalRelation
forall iv. Iv iv => iv -> iv -> IntervalRelation
ivRelate iv
x
  ivOverlappedBy = (iv -> iv -> Bool) -> iv -> iv -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivOverlaps

  -- | Is @'ivRelate' x y == Starts@? @'ivStartedBy' = flip 'ivStarts'@.
  ivStarts,
    ivStartedBy ::
      -- | 'x'
      iv ->
      -- | 'y'
      iv ->
      Bool
  ivStarts iv
x = (IntervalRelation -> IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation
Starts) (IntervalRelation -> Bool)
-> (iv -> IntervalRelation) -> iv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. iv -> iv -> IntervalRelation
forall iv. Iv iv => iv -> iv -> IntervalRelation
ivRelate iv
x
  ivStartedBy = (iv -> iv -> Bool) -> iv -> iv -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivStarts

  -- | Is @'ivRelate' x y == Finishes@? @'ivFinishedBy' = flip 'ivFinishes'@.
  ivFinishes,
    ivFinishedBy ::
      -- | 'x'
      iv ->
      -- | 'y'
      iv ->
      Bool
  ivFinishes iv
x = (IntervalRelation -> IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation
Finishes) (IntervalRelation -> Bool)
-> (iv -> IntervalRelation) -> iv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. iv -> iv -> IntervalRelation
forall iv. Iv iv => iv -> iv -> IntervalRelation
ivRelate iv
x
  ivFinishedBy = (iv -> iv -> Bool) -> iv -> iv -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivFinishes

  -- | Is @'ivRelate' x y == During@? @'ivContains' = flip 'ivDuring'@.
  ivDuring,
    ivContains ::
      -- | 'x'
      iv ->
      -- | 'y'
      iv ->
      Bool
  ivDuring iv
x = (IntervalRelation -> IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation
During) (IntervalRelation -> Bool)
-> (iv -> IntervalRelation) -> iv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. iv -> iv -> IntervalRelation
forall iv. Iv iv => iv -> iv -> IntervalRelation
ivRelate iv
x
  ivContains = (iv -> iv -> Bool) -> iv -> iv -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip iv -> iv -> Bool
forall iv. Iv iv => iv -> iv -> Bool
ivDuring

  -- | Is @'ivRelate' x y == Equals@?
  ivEquals ::
    -- | 'x'
    iv ->
    -- | 'y'
    iv ->
    Bool
  ivEquals iv
x = (IntervalRelation -> IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation
Equals) (IntervalRelation -> Bool)
-> (iv -> IntervalRelation) -> iv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. iv -> iv -> IntervalRelation
forall iv. Iv iv => iv -> iv -> IntervalRelation
ivRelate iv
x

-- | Class representing intervals that can be cast to and from the canonical
-- representation @'Interval' a@.
--
-- When 'iv' is also an instance of 'PointedIv', with @Ord (Point iv)@, it should
-- adhere to Allen's construction of the interval algebra for intervals represented
-- by left and right endpoints. See [sections 3 and 4](https://cse.unl.edu/~choueiry/Documents/Allen-CACM1983.pdf)
-- of Allen 1983.
--
-- Specifically, the requirements for interval relations imply
--
-- @
-- ivBegin i < ivEnd i
-- @
--
-- This module provides default implementations for methods of 'Iv' in that case.
--
-- Note @iv@ should not be an instance of @Intervallic@ unless @iv ~ Interval
-- a@, since @Intervallic@ is a class for getting and setting intervals as
-- @Interval a@ in particular.
--
-- A @Vector@ whose elements are provided in strict ascending order is an example of
-- a type that could implement 'PointedIv' without being equivalent to 'Interval',
-- with @ivBegin = head@ and @ivEnd = last@.
class PointedIv iv where
  type Point iv

  -- | Access the left ("begin") and right ("end") endpoints of an interval.
  ivBegin, ivEnd :: iv -> Point iv

-- | The 'SizedIv' typeclass is a generic interface for constructing and
-- manipulating intervals. The class imposes strong requirements on its
-- methods, in large part to ensure the constructors 'ivExpandr' and 'ivExpandl'
-- return "valid" intervals, particularly in the typical case where 'iv' also
-- implements the interval algebra.
--
-- In all cases, 'ivExpandr' and 'ivExpandl' should preserve the value of the
-- point *not* shifted. That is,
--
-- @
-- ivBegin (ivExpandr d i) == ivBegin i
-- ivEnd (ivExpandl d i) == ivEnd i
-- @
--
-- In addition, using 'Interval' as example, the following must hold:
--
-- When @iv@ is @Ord@, for all @i == Interval (b, e)@,
--
-- @
-- ivExpandr d i >= i
-- ivExpandl d i <= i
-- @
--
-- When @Moment iv@ is @Ord@,
--
-- @
-- duration (ivExpandr d i) >= max moment (duration i)
-- duration (ivExpandl d i) >= max moment (duration i)
-- @
--
-- In particular, if the duration 'd' by which to expand is less than 'moment',
-- and @'duration' i >= moment@ then these constructors should return the input.
--
-- @
-- ivExpandr d i == i
-- ivExpandl d i == i
-- @
--
-- When @Moment iv@ also is @Num@, the default 'moment' value is @1@ and in all
-- cases should be positive.
--
-- @
-- moment @iv > 0
-- @
--
-- When in addition @Point iv ~ Moment iv@, the class provides a default 'duration' as
-- @duration i = ivEnd i - ivBegin i@.
--
-- This module enforces @'Point' (Interval a) = a@. However, it need not be
-- that @a ~ Moment iv@. For example @Moment (Interval UTCTime) ~
-- NominalDiffTime@.
--
-- ==== SizedIv and the interval algebra
--
-- When 'iv' is an instance of 'Iv', the methods of this class should ensure
-- the validity of the resulting interval with respect to the interval algebra.
-- For example, when @'Point' iv@ is 'Ord', they must always produce a valid
-- interval 'i' such that @'ivBegin' i < 'ivEnd' i@.
--
-- In addition, the requirements of 'SizedIv' implementations in the common case
-- where @'Moment' iv@ is 'Num' and 'Ord' require the constructors to produce intervals
-- with 'duration' of at least 'moment'.
--
-- In order to preserve the properties above, @ivExpandr, ivExpandl@ will not want to assume
-- validity of the input interval. In other words, @'ivExpandr' d i@ need not be the
-- identity when @d < 'moment'@ since it will need to ensure the result is a valid interval
-- even if 'i' is not.
--
-- These two methods can therefore be used as constructors for valid intervals.
class (PointedIv iv) => SizedIv iv where
  -- | Type of 'moment'.
  type Moment iv

  -- | The smallest duration for an 'iv'. When 'Moment iv' is an instance of
  -- 'Num', the default is 1. If @'Moment' iv@ is @Ord@ and @Num@, @'moment' > 0@
  -- is required.
  moment :: Moment iv

  -- | The duration of an 'iv'. When @Moment iv ~ Point iv@ and @Point iv@ is
  -- @Num@ this defaults to @ivEnd i - ivBegin i@.
  duration :: iv -> Moment iv

  -- | Resize @iv@ by expanding to the "left" or to the "right" by some
  -- duration. If @iv@ implements the interval algebra via @Iv@, these
  -- methods must produce valid intervals regardless of the validity of the input
  -- and thus serve as constructors for intervals. See also 'beginerval',
  -- 'endverval', 'safeInterval' and related.
  --
  -- See the class documentation for details requirements.
  --
  -- >>> ivExpandr 1 (safeInterval (0, 1) :: Interval Int) == safeInterval (0, 2)
  -- True
  -- >>> ivExpandr 0 (safeInterval (0, 1) :: Interval Int) == safeInterval (0, 1)
  -- True
  -- >>> ivExpandl 1 (safeInterval (0, 1) :: Interval Int) == safeInterval (-1, 1)
  -- True
  -- >>> ivExpandl 0 (safeInterval (0, 1) :: Interval Int) == safeInterval (0, 1)
  -- True
  ivExpandr, ivExpandl :: Moment iv -> iv -> iv

  default moment :: (Num (Moment iv)) => Moment iv
  moment = Moment iv
1

  default duration :: (Point iv ~ Moment iv, Num (Point iv)) => iv -> Moment iv
  duration iv
i = iv -> Point iv
forall iv. PointedIv iv => iv -> Point iv
ivEnd iv
i Moment iv -> Moment iv -> Moment iv
forall a. Num a => a -> a -> a
- iv -> Point iv
forall iv. PointedIv iv => iv -> Point iv
ivBegin iv
i

-- | 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)
-- >>> 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 ::
  (SizedIv (Interval a), Intervallic i) =>
  -- | duration to subtract from the 'begin'
  Moment (Interval a) ->
  -- | duration to add to the 'end'
  Moment (Interval a) ->
  i a ->
  i a
expand :: Moment (Interval a) -> Moment (Interval a) -> i a -> i a
expand Moment (Interval a)
l Moment (Interval a)
r = Moment (Interval a) -> i a -> i a
forall a (i :: * -> *).
(SizedIv (Interval a), Intervallic i) =>
Moment (Interval a) -> i a -> i a
expandl Moment (Interval a)
l (i a -> i a) -> (i a -> i a) -> i a -> i a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Moment (Interval a) -> i a -> i a
forall a (i :: * -> *).
(SizedIv (Interval a), Intervallic i) =>
Moment (Interval a) -> i a -> i a
expandr Moment (Interval a)
r

-- | 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 :: (SizedIv (Interval a), Intervallic i) => Moment (Interval a) -> i a -> i a
expandl :: Moment (Interval a) -> i a -> i a
expandl Moment (Interval a)
l 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 (Interval a -> i a) -> Interval a -> i a
forall a b. (a -> b) -> a -> b
$ Moment (Interval a) -> Interval a -> Interval a
forall iv. SizedIv iv => Moment iv -> iv -> iv
ivExpandl Moment (Interval a)
l (Interval a -> Interval a) -> Interval a -> Interval a
forall a b. (a -> b) -> a -> b
$ i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i a
i

-- | 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 :: (SizedIv (Interval a), Intervallic i) => Moment (Interval a) -> i a -> i a
expandr :: Moment (Interval a) -> i a -> i a
expandr Moment (Interval a)
r 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 (Interval a -> i a) -> Interval a -> i a
forall a b. (a -> b) -> a -> b
$ Moment (Interval a) -> Interval a -> Interval a
forall iv. SizedIv iv => Moment iv -> iv -> iv
ivExpandr Moment (Interval a)
r (Interval a -> Interval a) -> Interval a -> Interval a
forall a b. (a -> b) -> a -> b
$ i a -> Interval a
forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval i a
i

-- | Safely creates an 'Interval a' using @x@ as the 'begin' and adding @max
-- 'moment' dur@ to @x@ as the 'end'. For the 'SizedIv' instances this
-- module exports, 'beginerval' is the same as 'interval'. However, it is defined
-- separately since 'beginerval' will /always/ have this behavior whereas
-- 'interval' behavior might differ by implementation.
--
-- >>> beginerval (0::Int) (0::Int)
-- (0, 1)
--
-- >>> beginerval (1::Int) (0::Int)
-- (0, 1)
--
-- >>> beginerval (2::Int) (0::Int)
-- (0, 2)
beginerval ::
  forall a.
  (SizedIv (Interval a)) =>
  -- | @dur@ation to add to the 'begin'
  Moment (Interval a) ->
  -- | the 'begin' point of the 'Interval'
  a ->
  Interval a
beginerval :: Moment (Interval a) -> a -> Interval a
beginerval Moment (Interval a)
dur a
x = Moment (Interval a) -> Interval a -> Interval a
forall iv. SizedIv iv => Moment iv -> iv -> iv
ivExpandr Moment (Interval a)
dur (Interval a -> Interval a) -> Interval a -> Interval a
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
x)

-- | A synonym for `beginerval`
bi ::
  forall a.
  (SizedIv (Interval a)) =>
  -- | @dur@ation to add to the 'begin'
  Moment (Interval a) ->
  -- | the 'begin' point of the 'Interval'
  a ->
  Interval a
bi :: Moment (Interval a) -> a -> Interval a
bi = Moment (Interval a) -> a -> Interval a
forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> 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.
  (SizedIv (Interval a)) =>
  -- | @dur@ation to subtract from the 'end'
  Moment (Interval a) ->
  -- | the 'end' point of the 'Interval'
  a ->
  Interval a
enderval :: Moment (Interval a) -> a -> Interval a
enderval Moment (Interval a)
dur a
x = Moment (Interval a) -> Interval a -> Interval a
forall iv. SizedIv iv => Moment iv -> iv -> iv
ivExpandl Moment (Interval a)
dur (Interval a -> Interval a) -> Interval a -> Interval a
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
x, a
x)

-- | A synonym for `enderval`
ei ::
  forall a.
  (SizedIv (Interval a)) =>
  -- | @dur@ation to subtract from the 'end'
  Moment (Interval a) ->
  -- | the 'end' point of the 'Interval'
  a ->
  Interval a
ei :: Moment (Interval a) -> a -> Interval a
ei = Moment (Interval a) -> a -> Interval a
forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
enderval

-- | Safely creates an @'Interval'@ from a pair of endpoints,
-- expanding from the left endpoint if necessary to create a valid interval
-- according to the rules of 'SizedIv'. This function simply wraps
-- 'ivExpandr'.
--
-- >>> safeInterval (4, 5 ::Int)
-- (4, 5)
-- >>> safeInterval (4, 3 :: Int)
-- (4, 5)
safeInterval ::
  forall a.
  (SizedIv (Interval a), Ord (Moment (Interval a))) =>
  (a, a) ->
  Interval a
safeInterval :: (a, a) -> Interval a
safeInterval (a
b, a
e)
  | Interval a -> Moment (Interval a)
forall iv. SizedIv iv => iv -> Moment iv
duration Interval a
i Moment (Interval a) -> Moment (Interval a) -> Bool
forall a. Ord a => a -> a -> Bool
< Moment (Interval a)
m = Moment (Interval a) -> Interval a -> Interval a
forall iv. SizedIv iv => Moment iv -> iv -> iv
ivExpandr Moment (Interval a)
m (Interval a -> Interval a) -> Interval a -> Interval a
forall a b. (a -> b) -> a -> b
$ (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
b, a
b)
  | Bool
otherwise = Interval a
i
  where
    i :: Interval a
i = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
b, a
e)
    m :: Moment (Interval a)
m = SizedIv (Interval a) => Moment (Interval a)
forall iv. SizedIv iv => Moment iv
moment @(Interval a)

-- | A synonym for `safeInterval`
si ::
  (SizedIv (Interval a), Ord (Moment (Interval a))) =>
  (a, a) ->
  Interval a
si :: (a, a) -> Interval a
si = (a, a) -> Interval a
forall a.
(SizedIv (Interval a), Ord (Moment (Interval a))) =>
(a, a) -> Interval a
safeInterval

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

-- | Creates a new 'Interval' from the 'begin' of another.
endervalFromBegin ::
  (SizedIv (Interval a), Intervallic i) =>
  -- | @dur@ation to subtract from the 'begin'
  Moment (Interval a) ->
  -- | the @i a@ from which to get the 'begin'
  i a ->
  Interval a
endervalFromBegin :: Moment (Interval a) -> i a -> Interval a
endervalFromBegin Moment (Interval a)
d i a
i = Moment (Interval a) -> a -> Interval a
forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
enderval Moment (Interval a)
d (i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval 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. (SizedIv (Interval a)) => a -> Interval a
beginervalMoment :: a -> Interval a
beginervalMoment = Moment (Interval a) -> a -> Interval a
forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
beginerval (SizedIv (Interval a) => Moment (Interval a)
forall iv. SizedIv iv => Moment iv
moment @(Interval a))

-- | Safely creates a new @Interval@ with 'moment' length with 'end' at @x@
--
-- >>> endervalMoment (10 :: Int)
-- (9, 10)
endervalMoment :: forall a. (SizedIv (Interval a)) => a -> Interval a
endervalMoment :: a -> Interval a
endervalMoment = Moment (Interval a) -> a -> Interval a
forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
enderval (SizedIv (Interval a) => Moment (Interval a)
forall iv. SizedIv iv => Moment iv
moment @(Interval a))

-- | Creates a new @Interval@ spanning the extent x and y.
--
-- >>> extenterval (Interval (0, 1)) (Interval (9, 10))
-- (0, 10)
extenterval :: (SizedIv (Interval a), 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.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i a
x) (i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval 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.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end i a
x) (i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval 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 ::
  (Num a, SizedIv (Interval a), Intervallic i1, Intervallic i0) =>
  i0 a ->
  i1 a ->
  i1 a
shiftFromBegin :: i0 a -> i1 a -> i1 a
shiftFromBegin i0 a
i = (a -> a) -> i1 a -> i1 a
forall (i :: * -> *) a b. Intervallic i => (a -> b) -> i a -> i b
imapStrictMonotone (\a
x -> a
x a -> a -> a
forall a. Num a => a -> a -> a
- i0 a -> a
forall (i :: * -> *) a.
(SizedIv (Interval 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 ::
  (Num a, SizedIv (Interval a), Intervallic i1, Intervallic i0) =>
  i0 a ->
  i1 a ->
  i1 a
shiftFromEnd :: i0 a -> i1 a -> i1 a
shiftFromEnd i0 a
i = (a -> a) -> i1 a -> i1 a
forall (i :: * -> *) a b. Intervallic i => (a -> b) -> i a -> i b
imapStrictMonotone (\a
x -> a
x a -> a -> a
forall a. Num a => a -> a -> a
- i0 a -> a
forall (i :: * -> *) a.
(SizedIv (Interval 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. Uses 'beginervalMoment'.
--
-- >>> momentize (Interval (6, 10))
-- (6, 7)
momentize ::
  forall i a. (SizedIv (Interval a), 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 (Interval a -> i a) -> Interval a -> i a
forall a b. (a -> b) -> a -> b
$ a -> Interval a
forall a. SizedIv (Interval a) => a -> Interval a
beginervalMoment (a -> Interval a) -> a -> Interval a
forall a b. (a -> b) -> a -> b
$ i a -> a
forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin i a
i

{-
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)

{- Common instance helpers -}

-- | Internal. Helper for SizedIv constructor implementations
-- defined in this module, so as to ensure the class properties.
ivExpandrI ::
  (Ord b) =>
  -- | 'moment' value to be passed here.
  b ->
  -- | 'duration'
  (a -> a -> b) ->
  -- | function for adding an amount of moments to a point.
  -- It must always satisfy addFun (dFun x y) y == x
  (b -> a -> a) ->
  -- | duration by which to expand.
  b ->
  Interval a ->
  Interval a
ivExpandrI :: b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandrI b
mom a -> a -> b
dFun b -> a -> a
addFun b
d (Interval (a
b, a
e))
  | b
d b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
mom = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
b, b -> a -> a
addFun (b -> b -> b
forall a. Ord a => a -> a -> a
max (a -> a -> b
dFun a
e a
b) b
mom) a
b)
  | Bool
otherwise = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (a
b, b -> a -> a
addFun b
d a
e)

ivExpandlI ::
  (Ord b) =>
  -- | 'moment' value to be passed here.
  b ->
  -- | 'duration'
  (a -> a -> b) ->
  -- | function for subtracting a amount of moments to a point.
  -- It must always satisfy subFun (dFun x y) x == y
  (b -> a -> a) ->
  -- | duration by which to expand.
  b ->
  Interval a ->
  Interval a
ivExpandlI :: b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandlI b
mom a -> a -> b
dFun b -> a -> a
subFun b
d (Interval (a
b, a
e))
  | b
d b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
mom = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (b -> a -> a
subFun (b -> b -> b
forall a. Ord a => a -> a -> a
max (a -> a -> b
dFun a
e a
b) b
mom) a
e, a
e)
  | Bool
otherwise = (a, a) -> Interval a
forall a. (a, a) -> Interval a
Interval (b -> a -> a
subFun b
d a
b, a
e)

{- 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, a)
pts1) <= :: Interval a -> Interval a -> Bool
<= (Interval (a, a)
pts2) = (a, a)
pts1 (a, a) -> (a, a) -> Bool
forall a. Ord a => a -> a -> Bool
<= (a, a)
pts2
  (Interval (a, a)
pts1) < :: Interval a -> Interval a -> Bool
< (Interval (a, a)
pts2) = (a, a)
pts1 (a, a) -> (a, a) -> Bool
forall a. Ord a => a -> a -> Bool
< (a, a)
pts2

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 PointedIv (Interval a) where
  type Point (Interval a) = a

  ivBegin :: Interval a -> Point (Interval a)
ivBegin (Interval (a
b, a
_)) = a
Point (Interval a)
b
  ivEnd :: Interval a -> Point (Interval a)
ivEnd (Interval (a
_, a
e)) = a
Point (Interval a)
e

-- | Implements the interval algebra for intervals represented as left and right endpoints,
-- with points in a totally ordered set, as prescribed in
-- [Allen 1983](https://dl.acm.org/doi/10.1145/182.358434).
instance (Ord a) => Iv (Interval a) where
  ivBefore :: Interval a -> Interval a -> Bool
ivBefore Interval a
x Interval a
y = Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
y
  ivMeets :: Interval a -> Interval a -> Bool
ivMeets Interval a
x Interval a
y = Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
y
  ivOverlaps :: Interval a -> Interval a -> Bool
ivOverlaps Interval a
x Interval a
y = Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
y Bool -> Bool -> Bool
&& Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
y Bool -> Bool -> Bool
&& Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
y
  ivStarts :: Interval a -> Interval a -> Bool
ivStarts Interval a
x Interval a
y = Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
y Bool -> Bool -> Bool
&& Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
y
  ivFinishes :: Interval a -> Interval a -> Bool
ivFinishes Interval a
x Interval a
y = Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
y Bool -> Bool -> Bool
&& Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
y
  ivDuring :: Interval a -> Interval a -> Bool
ivDuring Interval a
x Interval a
y = Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
y Bool -> Bool -> Bool
&& Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
y
  ivEquals :: Interval a -> Interval a -> Bool
ivEquals Interval a
x Interval a
y = Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivBegin Interval a
y Bool -> Bool -> Bool
&& Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> Point (Interval a)
forall iv. PointedIv iv => iv -> Point iv
ivEnd Interval a
y

-- TODO: Consider whether blanket instance for
-- Num a => SizedIv (Interval a) is good.

instance SizedIv (Interval Int) where
  type Moment (Interval Int) = Int
  ivExpandr :: Moment (Interval Int) -> Interval Int -> Interval Int
ivExpandr = Int
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> Int
-> Interval Int
-> Interval Int
forall b a.
Ord b =>
b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandrI (SizedIv (Interval Int) => Moment (Interval Int)
forall iv. SizedIv iv => Moment iv
moment @(Interval Int)) (-) Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
  ivExpandl :: Moment (Interval Int) -> Interval Int -> Interval Int
ivExpandl = Int
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> Int
-> Interval Int
-> Interval Int
forall b a.
Ord b =>
b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandlI (SizedIv (Interval Int) => Moment (Interval Int)
forall iv. SizedIv iv => Moment iv
moment @(Interval Int)) (-) ((Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-))

instance SizedIv (Interval Integer) where
  type Moment (Interval Integer) = Integer
  ivExpandr :: Moment (Interval Integer) -> Interval Integer -> Interval Integer
ivExpandr = Integer
-> (Integer -> Integer -> Integer)
-> (Integer -> Integer -> Integer)
-> Integer
-> Interval Integer
-> Interval Integer
forall b a.
Ord b =>
b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandrI (SizedIv (Interval Integer) => Moment (Interval Integer)
forall iv. SizedIv iv => Moment iv
moment @(Interval Integer)) (-) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
  ivExpandl :: Moment (Interval Integer) -> Interval Integer -> Interval Integer
ivExpandl = Integer
-> (Integer -> Integer -> Integer)
-> (Integer -> Integer -> Integer)
-> Integer
-> Interval Integer
-> Interval Integer
forall b a.
Ord b =>
b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandlI (SizedIv (Interval Integer) => Moment (Interval Integer)
forall iv. SizedIv iv => Moment iv
moment @(Interval Integer)) (-) ((Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-))

instance SizedIv (Interval Double) where
  type Moment (Interval Double) = Double
  ivExpandr :: Moment (Interval Double) -> Interval Double -> Interval Double
ivExpandr = Double
-> (Double -> Double -> Double)
-> (Double -> Double -> Double)
-> Double
-> Interval Double
-> Interval Double
forall b a.
Ord b =>
b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandrI (SizedIv (Interval Double) => Moment (Interval Double)
forall iv. SizedIv iv => Moment iv
moment @(Interval Double)) (-) Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
  ivExpandl :: Moment (Interval Double) -> Interval Double -> Interval Double
ivExpandl = Double
-> (Double -> Double -> Double)
-> (Double -> Double -> Double)
-> Double
-> Interval Double
-> Interval Double
forall b a.
Ord b =>
b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandlI (SizedIv (Interval Double) => Moment (Interval Double)
forall iv. SizedIv iv => Moment iv
moment @(Interval Double)) (-) ((Double -> Double -> Double) -> Double -> Double -> Double
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-))

instance SizedIv (Interval DT.Day) where
  type Moment (Interval DT.Day) = Integer
  duration :: Interval Day -> Moment (Interval Day)
duration (Interval (Day
b, Day
e)) = Day -> Day -> Integer
diffDays Day
e Day
b
  moment :: Moment (Interval Day)
moment = Moment (Interval Day)
1
  ivExpandr :: Moment (Interval Day) -> Interval Day -> Interval Day
ivExpandr = Integer
-> (Day -> Day -> Integer)
-> (Integer -> Day -> Day)
-> Integer
-> Interval Day
-> Interval Day
forall b a.
Ord b =>
b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandrI (SizedIv (Interval Day) => Moment (Interval Day)
forall iv. SizedIv iv => Moment iv
moment @(Interval DT.Day)) Day -> Day -> Integer
diffDays Integer -> Day -> Day
addDays
  ivExpandl :: Moment (Interval Day) -> Interval Day -> Interval Day
ivExpandl = Integer
-> (Day -> Day -> Integer)
-> (Integer -> Day -> Day)
-> Integer
-> Interval Day
-> Interval Day
forall b a.
Ord b =>
b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandlI (SizedIv (Interval Day) => Moment (Interval Day)
forall iv. SizedIv iv => Moment iv
moment @(Interval DT.Day)) Day -> Day -> Integer
diffDays (\Integer
d -> Integer -> Day -> Day
addDays (-Integer
d))

-- | Note this instance changes the @moment@ to 1 'Pico' second, not 1 second
-- as would be the case if the default were used.
instance SizedIv (Interval DT.UTCTime) where
  type Moment (Interval DT.UTCTime) = NominalDiffTime
  moment :: Moment (Interval UTCTime)
moment = Int -> NominalDiffTime
forall a. Enum a => Int -> a
toEnum Int
1
  duration :: Interval UTCTime -> Moment (Interval UTCTime)
duration (Interval (UTCTime
b, UTCTime
e)) = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
e UTCTime
b
  ivExpandr :: Moment (Interval UTCTime) -> Interval UTCTime -> Interval UTCTime
ivExpandr = NominalDiffTime
-> (UTCTime -> UTCTime -> NominalDiffTime)
-> (NominalDiffTime -> UTCTime -> UTCTime)
-> NominalDiffTime
-> Interval UTCTime
-> Interval UTCTime
forall b a.
Ord b =>
b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandrI (SizedIv (Interval UTCTime) => Moment (Interval UTCTime)
forall iv. SizedIv iv => Moment iv
moment @(Interval DT.UTCTime)) UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime NominalDiffTime -> UTCTime -> UTCTime
addUTCTime
  ivExpandl :: Moment (Interval UTCTime) -> Interval UTCTime -> Interval UTCTime
ivExpandl = NominalDiffTime
-> (UTCTime -> UTCTime -> NominalDiffTime)
-> (NominalDiffTime -> UTCTime -> UTCTime)
-> NominalDiffTime
-> Interval UTCTime
-> Interval UTCTime
forall b a.
Ord b =>
b
-> (a -> a -> b) -> (b -> a -> a) -> b -> Interval a -> Interval a
ivExpandlI (SizedIv (Interval UTCTime) => Moment (Interval UTCTime)
forall iv. SizedIv iv => Moment iv
moment @(Interval DT.UTCTime)) UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (\NominalDiffTime
d -> NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
d))