-- |
-- 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' for a point that
-- is equal to the lowerBound of a left-closed interval even if it is larger than
-- the upper bound.

{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
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  i
_ = Bool
True

  -- | Does the interval include its upper bound bound?
  -- Default is True for all values, i.e. closed intervals.
  rightClosed :: i -> Bool
  rightClosed i
_ = Bool
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
  i
a `before` i
b = i -> e
forall i e. Interval i e => i -> e
upperBound i
a e -> e -> Bool
forall a. Ord a => a -> a -> Bool
< i -> e
forall i e. Interval i e => i -> e
lowerBound i
b
                 Bool -> Bool -> Bool
|| (i -> e
forall i e. Interval i e => i -> e
upperBound i
a e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== i -> e
forall i e. Interval i e => i -> e
lowerBound i
b Bool -> Bool -> Bool
&& Bool -> Bool
not (i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
a Bool -> Bool -> Bool
&& i -> Bool
forall i e. Interval i e => i -> Bool
leftClosed i
b))

  -- | Interval strictly after another?
  -- Same as 'flip before'.
  after :: i -> i -> Bool
  i
a `after` i
b  = i
b i -> i -> Bool
forall i e. Interval i e => i -> i -> Bool
`before` i
a

  -- | Does the first interval completely contain the second?
  subsumes :: i -> i -> Bool
  i
a `subsumes` i
b = (i -> e
forall i e. Interval i e => i -> e
lowerBound i
a e -> e -> Bool
forall a. Ord a => a -> a -> Bool
< i -> e
forall i e. Interval i e => i -> e
lowerBound i
b Bool -> Bool -> Bool
|| (i -> e
forall i e. Interval i e => i -> e
lowerBound i
a e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== i -> e
forall i e. Interval i e => i -> e
lowerBound i
b Bool -> Bool -> Bool
&& (i -> Bool
forall i e. Interval i e => i -> Bool
leftClosed i
a Bool -> Bool -> Bool
|| Bool -> Bool
not (i -> Bool
forall i e. Interval i e => i -> Bool
leftClosed i
b))))
                   Bool -> Bool -> Bool
&&
                   (i -> e
forall i e. Interval i e => i -> e
upperBound i
a e -> e -> Bool
forall a. Ord a => a -> a -> Bool
> i -> e
forall i e. Interval i e => i -> e
upperBound i
b Bool -> Bool -> Bool
|| (i -> e
forall i e. Interval i e => i -> e
upperBound i
a e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== i -> e
forall i e. Interval i e => i -> e
upperBound i
b Bool -> Bool -> Bool
&& (i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
a Bool -> Bool -> Bool
|| Bool -> Bool
not (i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
b))))

  -- | Do the two intervals overlap?
  overlaps :: i -> i -> Bool
  i
a `overlaps` i
b = (i -> e
forall i e. Interval i e => i -> e
lowerBound i
a e -> e -> Bool
forall a. Ord a => a -> a -> Bool
< i -> e
forall i e. Interval i e => i -> e
upperBound i
b Bool -> Bool -> Bool
|| (i -> e
forall i e. Interval i e => i -> e
lowerBound i
a e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== i -> e
forall i e. Interval i e => i -> e
upperBound i
b Bool -> Bool -> Bool
&& i -> Bool
forall i e. Interval i e => i -> Bool
leftClosed i
a Bool -> Bool -> Bool
&& i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
b))
                   Bool -> Bool -> Bool
&&
                   (i -> e
forall i e. Interval i e => i -> e
upperBound i
a e -> e -> Bool
forall a. Ord a => a -> a -> Bool
> i -> e
forall i e. Interval i e => i -> e
lowerBound i
b Bool -> Bool -> Bool
|| (i -> e
forall i e. Interval i e => i -> e
upperBound i
a e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== i -> e
forall i e. Interval i e => i -> e
lowerBound i
b Bool -> Bool -> Bool
&& i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
a Bool -> Bool -> Bool
&& i -> Bool
forall i e. Interval i e => i -> Bool
leftClosed i
b))

  -- | Is a point strictly less than lower bound?
  below :: e -> i -> Bool
  e
p `below` i
i = case e -> e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare e
p (i -> e
forall i e. Interval i e => i -> e
lowerBound i
i) of
                  Ordering
LT -> Bool
True
                  Ordering
EQ -> Bool -> Bool
not (i -> Bool
forall i e. Interval i e => i -> Bool
leftClosed i
i)
                  Ordering
GT -> Bool
False

  -- | Is a point strictly greater than upper bound?
  above :: e -> i -> Bool
  e
p `above` i
i = case e -> e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare e
p (i -> e
forall i e. Interval i e => i -> e
upperBound i
i) of
                  Ordering
LT -> Bool
False
                  Ordering
EQ -> Bool -> Bool
not (i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
i)
                  Ordering
GT -> Bool
True

  -- | Does the interval contain a given point?
  inside :: e -> i -> Bool
  e
p `inside` i
i = Bool -> Bool
not ((e
p e -> i -> Bool
forall i e. Interval i e => e -> i -> Bool
`above` i
i) Bool -> Bool -> Bool
|| (e
p e -> i -> Bool
forall i e. Interval i e => e -> i -> Bool
`below` i
i)) 

  -- | Is the interval empty?
  isEmpty :: i -> Bool
  isEmpty i
i | i -> Bool
forall i e. Interval i e => i -> Bool
leftClosed i
i Bool -> Bool -> Bool
&& i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
i = i -> e
forall i e. Interval i e => i -> e
lowerBound i
i e -> e -> Bool
forall a. Ord a => a -> a -> Bool
>  i -> e
forall i e. Interval i e => i -> e
upperBound i
i
            | Bool
otherwise                     = i -> e
forall i e. Interval i e => i -> e
lowerBound i
i e -> e -> Bool
forall a. Ord a => a -> a -> Bool
>= i -> e
forall i e. Interval i e => i -> e
upperBound i
i

  compareUpperBounds :: i -> i -> Ordering
  compareUpperBounds i
a i
b = case e -> e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (i -> e
forall i e. Interval i e => i -> e
upperBound i
a) (i -> e
forall i e. Interval i e => i -> e
upperBound i
b) of
                             Ordering
LT -> Ordering
LT
                             Ordering
GT -> Ordering
GT
                             Ordering
EQ -> case (i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
a, i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
b) of
                                     (Bool
False, Bool
True) -> Ordering
LT
                                     (Bool
True, Bool
False) -> Ordering
GT
                                     (Bool, Bool)
_             -> Ordering
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 :: forall i e. Interval i e => i -> i -> Bool
genericEquals i
a i
b = i -> e
forall i e. Interval i e => i -> e
lowerBound i
a e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== i -> e
forall i e. Interval i e => i -> e
lowerBound i
b Bool -> Bool -> Bool
&& i -> e
forall i e. Interval i e => i -> e
upperBound i
a e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== i -> e
forall i e. Interval i e => i -> e
upperBound i
b
                    Bool -> Bool -> Bool
&& i -> Bool
forall i e. Interval i e => i -> Bool
leftClosed i
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== i -> Bool
forall i e. Interval i e => i -> Bool
leftClosed i
b
                    Bool -> Bool -> Bool
&& i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
b

genericCompare :: (Interval i e) => i -> i -> Ordering
genericCompare :: forall i e. Interval i e => i -> i -> Ordering
genericCompare i
a i
b = case i -> i -> Ordering
forall i e. Interval i e => i -> i -> Ordering
compareL i
a i
b of
                       Ordering
LT -> Ordering
LT
                       Ordering
GT -> Ordering
GT
                       Ordering
EQ -> i -> i -> Ordering
forall i e. Interval i e => i -> i -> Ordering
compareU i
a i
b

compareL :: (Interval i e) => i -> i -> Ordering
compareL :: forall i e. Interval i e => i -> i -> Ordering
compareL i
a i
b = case e -> e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (i -> e
forall i e. Interval i e => i -> e
lowerBound i
a) (i -> e
forall i e. Interval i e => i -> e
lowerBound i
b) of
                 Ordering
LT -> Ordering
LT
                 Ordering
GT -> Ordering
GT
                 Ordering
EQ -> case (i -> Bool
forall i e. Interval i e => i -> Bool
leftClosed i
a, i -> Bool
forall i e. Interval i e => i -> Bool
leftClosed i
b) of
                         (Bool
True, Bool
False) -> Ordering
LT
                         (Bool
False, Bool
True) -> Ordering
GT
                         (Bool, Bool)
_ -> Ordering
EQ

compareU :: (Interval i e) => i -> i -> Ordering
compareU :: forall i e. Interval i e => i -> i -> Ordering
compareU i
a i
b = case e -> e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (i -> e
forall i e. Interval i e => i -> e
upperBound i
a) (i -> e
forall i e. Interval i e => i -> e
upperBound i
b) of
                 Ordering
LT -> Ordering
LT
                 Ordering
GT -> Ordering
GT
                 Ordering
EQ -> case (i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
a, i -> Bool
forall i e. Interval i e => i -> Bool
rightClosed i
b) of
                         (Bool
True, Bool
False) -> Ordering
GT
                         (Bool
False, Bool
True) -> Ordering
LT
                         (Bool, Bool)
_ -> Ordering
EQ

instance Ord a => Interval (I.Interval a) a where
    lowerBound :: Interval a -> a
lowerBound  = Interval a -> a
forall a. Interval a -> a
I.lowerBound
    upperBound :: Interval a -> a
upperBound  = Interval a -> a
forall a. Interval a -> a
I.upperBound
    leftClosed :: Interval a -> Bool
leftClosed  = Interval a -> Bool
forall a. Interval a -> Bool
I.leftClosed
    rightClosed :: Interval a -> Bool
rightClosed = Interval a -> Bool
forall a. Interval a -> Bool
I.rightClosed
    overlaps :: Interval a -> Interval a -> Bool
overlaps    = Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
I.overlaps
    subsumes :: Interval a -> Interval a -> Bool
subsumes    = Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
I.subsumes
    before :: Interval a -> Interval a -> Bool
before      = Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
I.before
    after :: Interval a -> Interval a -> Bool
after       = Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
I.after
    above :: a -> Interval a -> Bool
above       = a -> Interval a -> Bool
forall a. Ord a => a -> Interval a -> Bool
I.above
    below :: a -> Interval a -> Bool
below       = a -> Interval a -> Bool
forall a. Ord a => a -> Interval a -> Bool
I.below
    inside :: a -> Interval a -> Bool
inside      = a -> Interval a -> Bool
forall a. Ord a => a -> Interval a -> Bool
I.inside
    isEmpty :: Interval a -> Bool
isEmpty     = Interval a -> Bool
forall a. Ord a => Interval a -> Bool
I.isEmpty
    compareUpperBounds :: Interval a -> Interval a -> Ordering
compareUpperBounds = Interval a -> Interval a -> Ordering
forall a. Ord a => Interval a -> Interval a -> Ordering
I.compareByUpper