-- |
-- Module : Data.IntervalMap.Generic.Interval
-- Copyright : (c) Christoph Breitkopf 2014
-- License : BSD-style
-- Maintainer : chbreitkopf@gmail.com
-- Stability : experimental
-- Portability : non-portable (MPTC with FD)
--
-- Type class for IntervalMap keys.
--
-- As there is no sensible default, no instances for prelude types
-- are provided (E.g. you might want to have tuples as closed
-- intervals in one case, and open in another).
--
-- Empty intervals, i.e. intervals where 'lowerBound >= upperBound' should be avoided
-- if possible. If you must use empty intervals, you need to provide implementations
-- for all operations, as the default implementations do not necessarily work correctly.
-- for example, the default implementation of 'inside' returns 'True' if the point
-- is equal to the lowerBound of a left-closed interval even if it is larger than
-- the upper bound.
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.IntervalMap.Generic.Interval (
-- * Interval type
Interval(..),
-- * helper functions for declaring Eq and Ord instances
genericEquals, genericCompare
) where
import qualified Data.IntervalMap.Interval as I
-- | Intervals with endpoints of type @e@.
-- A minimal instance declaration for a closed interval needs only
-- to define 'lowerBound' and 'upperBound'.
class Ord e => Interval i e | i -> e where
-- | lower bound
lowerBound :: i -> e
-- | upper bound
upperBound :: i -> e
-- | Does the interval include its lower bound?
-- Default is True for all values, i.e. closed intervals.
leftClosed :: i -> Bool
leftClosed _ = True
-- | Does the interval include its upper bound bound?
-- Default is True for all values, i.e. closed intervals.
rightClosed :: i -> Bool
rightClosed _ = True
-- | Interval strictly before another?
-- True if the upper bound of the first interval is below the lower bound of the second.
before :: i -> i -> Bool
a `before` b = upperBound a < lowerBound b
|| (upperBound a == lowerBound b && not (rightClosed a && leftClosed b))
-- | Interval strictly after another?
-- Same as 'flip before'.
after :: i -> i -> Bool
a `after` b = b `before` a
-- | Does the first interval completely contain the second?
subsumes :: i -> i -> Bool
a `subsumes` b = (lowerBound a < lowerBound b || (lowerBound a == lowerBound b && (leftClosed a || not (leftClosed b))))
&&
(upperBound a > upperBound b || (upperBound a == upperBound b && (rightClosed a || not (rightClosed b))))
-- | Do the two intervals overlap?
overlaps :: i -> i -> Bool
a `overlaps` b = (lowerBound a < upperBound b || (lowerBound a == upperBound b && leftClosed a && rightClosed b))
&&
(upperBound a > lowerBound b || (upperBound a == lowerBound b && rightClosed a && leftClosed b))
-- | Is a point strictly less than lower bound?
below :: e -> i -> Bool
p `below` i = case compare p (lowerBound i) of
LT -> True
EQ -> not (leftClosed i)
GT -> False
-- | Is a point strictly greater than upper bound?
above :: e -> i -> Bool
p `above` i = case compare p (upperBound i) of
LT -> False
EQ -> not (rightClosed i)
GT -> True
-- | Does the interval contain a given point?
inside :: e -> i -> Bool
p `inside` i = not ((p `above` i) || (p `below` i))
-- | Is the interval empty?
isEmpty :: i -> Bool
isEmpty i | leftClosed i && rightClosed i = lowerBound i > upperBound i
| otherwise = lowerBound i >= upperBound i
compareUpperBounds :: i -> i -> Ordering
compareUpperBounds a b = case compare (upperBound a) (upperBound b) of
LT -> LT
GT -> GT
EQ -> case (rightClosed a, rightClosed b) of
(False, True) -> LT
(True, False) -> GT
_ -> EQ
{-
-- sample instance for tuples:
instance Ord e => Interval (e,e) e where
lowerBound (a,_) = a
upperBound (_,b) = b
-}
genericEquals :: (Interval i e) => i -> i -> Bool
genericEquals a b = lowerBound a == lowerBound b && upperBound a == upperBound b
&& leftClosed a == leftClosed b
&& rightClosed a == rightClosed b
genericCompare :: (Interval i e) => i -> i -> Ordering
genericCompare a b = case compareL a b of
LT -> LT
GT -> GT
EQ -> compareU a b
compareL :: (Interval i e) => i -> i -> Ordering
compareL a b = case compare (lowerBound a) (lowerBound b) of
LT -> LT
GT -> GT
EQ -> case (leftClosed a, leftClosed b) of
(True, False) -> LT
(False, True) -> GT
_ -> EQ
compareU :: (Interval i e) => i -> i -> Ordering
compareU a b = case compare (upperBound a) (upperBound b) of
LT -> LT
GT -> GT
EQ -> case (rightClosed a, rightClosed b) of
(True, False) -> GT
(False, True) -> LT
_ -> EQ
instance Ord a => Interval (I.Interval a) a where
lowerBound = I.lowerBound
upperBound = I.upperBound
leftClosed = I.leftClosed
rightClosed = I.rightClosed
overlaps = I.overlaps
subsumes = I.subsumes
before = I.before
after = I.after
above = I.above
below = I.below
inside = I.inside
isEmpty = I.isEmpty
compareUpperBounds = I.compareByUpper