-- |
-- Module      :  Data.IntervalMap.Interval
-- Copyright   :  (c) Christoph Breitkopf 2011
-- License     :  BSD-style
-- Maintainer  :  chbreitkopf@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- A conservative implementation of Intervals, mostly for use as keys in
-- a 'Data.IntervalMap'.
--
-- This should really be a typeclass, so you could have a tuple be an instance
-- of Interval, but that is currently not possible in standard Haskell.
--
-- The contructor names of the half-open intervals seem somewhat clumsy,
-- and I'm open to suggestions for better names.
--
module Data.IntervalMap.Interval (
    -- * Interval type
    Interval(..),
    -- * Query
    lowerBound, upperBound, leftClosed, rightClosed, isEmpty,
    -- * Interval operations
    overlaps, subsumes, before, after,
    compareByUpper, combine,
    -- * Point operations
    below, inside, above
  ) where

import Control.DeepSeq (NFData(rnf))

-- | Intervals with endpoints of type @a@.
--
-- 'Read' and 'Show' use mathematical notation with square brackets for closed
-- and parens for open intervals.
-- This is better for human readability, but is not a valid Haskell expression.
-- Closed intervals look like a list, open intervals look like a tuple,
-- and half-open intervals look like mismatched parens.
data Interval a = IntervalCO !a !a      -- ^ Including lower bound, excluding upper
                | ClosedInterval !a !a  -- ^ Closed at both ends
                | OpenInterval !a !a    -- ^ Open at both ends
                | IntervalOC !a !a      -- ^ Excluding lower bound, including upper
                  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
$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
/= :: Interval a -> Interval a -> Bool
Eq)

instance Show a => Show (Interval a) where
  showsPrec :: Int -> Interval a -> ShowS
showsPrec Int
_ (IntervalCO     a
a a
b) = Char -> ShowS
showChar Char
'[' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
  showsPrec Int
_ (ClosedInterval a
a a
b) = Char -> ShowS
showChar Char
'[' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']'
  showsPrec Int
_ (OpenInterval   a
a a
b) = Char -> ShowS
showChar Char
'(' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
  showsPrec Int
_ (IntervalOC     a
a a
b) = Char -> ShowS
showChar Char
'(' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']'

instance Read a => Read (Interval a) where
  readsPrec :: Int -> ReadS (Interval a)
readsPrec Int
_ = Bool -> ReadS (Interval a) -> ReadS (Interval a)
forall a. Bool -> ReadS a -> ReadS a
readParen Bool
False
                  (\String
r -> [(a -> a -> Interval a
forall a. a -> a -> Interval a
ClosedInterval a
a a
b, String
w) | (String
"[", String
s) <- ReadS String
lex String
r,
                                                    (a
a, String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
s,
                                                    (String
",", String
u) <- ReadS String
lex String
t,
                                                    (a
b, String
v) <- ReadS a
forall a. Read a => ReadS a
reads String
u,
                                                    (String
"]", String
w) <- ReadS String
lex String
v]
                         [(Interval a, String)]
-> [(Interval a, String)] -> [(Interval a, String)]
forall a. [a] -> [a] -> [a]
++
                         [(a -> a -> Interval a
forall a. a -> a -> Interval a
OpenInterval   a
a a
b, String
w) | (String
"(", String
s) <- ReadS String
lex String
r,
                                                    (a
a, String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
s,
                                                    (String
",", String
u) <- ReadS String
lex String
t,
                                                    (a
b, String
v) <- ReadS a
forall a. Read a => ReadS a
reads String
u,
                                                    (String
")", String
w) <- ReadS String
lex String
v]
                         [(Interval a, String)]
-> [(Interval a, String)] -> [(Interval a, String)]
forall a. [a] -> [a] -> [a]
++
                         [(a -> a -> Interval a
forall a. a -> a -> Interval a
IntervalCO     a
a a
b, String
w) | (String
"[", String
s) <- ReadS String
lex String
r,
                                                    (a
a, String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
s,
                                                    (String
",", String
u) <- ReadS String
lex String
t,
                                                    (a
b, String
v) <- ReadS a
forall a. Read a => ReadS a
reads String
u,
                                                    (String
")", String
w) <- ReadS String
lex String
v]
                         [(Interval a, String)]
-> [(Interval a, String)] -> [(Interval a, String)]
forall a. [a] -> [a] -> [a]
++
                         [(a -> a -> Interval a
forall a. a -> a -> Interval a
IntervalOC     a
a a
b, String
w) | (String
"(", String
s) <- ReadS String
lex String
r,
                                                    (a
a, String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
s,
                                                    (String
",", String
u) <- ReadS String
lex String
t,
                                                    (a
b, String
v) <- ReadS a
forall a. Read a => ReadS a
reads String
u,
                                                    (String
"]", String
w) <- ReadS String
lex String
v]
                      )


-- compare only the lower bound
compareL :: Ord a => Interval a -> Interval a -> Ordering
compareL :: forall a. Ord a => Interval a -> Interval a -> Ordering
compareL (IntervalCO     a
a a
_) (IntervalCO     a
b a
_)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareL (IntervalCO     a
a a
_) (ClosedInterval a
b a
_)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareL (IntervalCO     a
a a
_) (OpenInterval   a
b a
_)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b then Ordering
LT else Ordering
GT
compareL (IntervalCO     a
a a
_) (IntervalOC     a
b a
_)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b then Ordering
LT else Ordering
GT
compareL (ClosedInterval a
a a
_) (IntervalCO     a
b a
_)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareL (ClosedInterval a
a a
_) (ClosedInterval a
b a
_)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareL (ClosedInterval a
a a
_) (OpenInterval   a
b a
_)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b then Ordering
LT else Ordering
GT
compareL (ClosedInterval a
a a
_) (IntervalOC     a
b a
_)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b then Ordering
LT else Ordering
GT
compareL (OpenInterval   a
a a
_) (IntervalCO     a
b a
_)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then Ordering
LT else Ordering
GT
compareL (OpenInterval   a
a a
_) (ClosedInterval a
b a
_)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then Ordering
LT else Ordering
GT
compareL (OpenInterval   a
a a
_) (OpenInterval   a
b a
_)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareL (OpenInterval   a
a a
_) (IntervalOC     a
b a
_)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareL (IntervalOC     a
a a
_) (IntervalCO     a
b a
_)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then Ordering
LT else Ordering
GT
compareL (IntervalOC     a
a a
_) (ClosedInterval a
b a
_)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then Ordering
LT else Ordering
GT
compareL (IntervalOC     a
a a
_) (OpenInterval   a
b a
_)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareL (IntervalOC     a
a a
_) (IntervalOC     a
b a
_)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b

-- compare only the upper bound
compareU :: Ord a => Interval a -> Interval a -> Ordering
compareU :: forall a. Ord a => Interval a -> Interval a -> Ordering
compareU (IntervalCO     a
_ a
a) (IntervalCO     a
_ a
b)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareU (IntervalCO     a
_ a
a) (ClosedInterval a
_ a
b)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b then Ordering
LT else Ordering
GT
compareU (IntervalCO     a
_ a
a) (OpenInterval   a
_ a
b)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareU (IntervalCO     a
_ a
a) (IntervalOC     a
_ a
b)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b then Ordering
LT else Ordering
GT
compareU (ClosedInterval a
_ a
a) (IntervalCO     a
_ a
b)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then Ordering
LT else Ordering
GT
compareU (ClosedInterval a
_ a
a) (ClosedInterval a
_ a
b)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareU (ClosedInterval a
_ a
a) (OpenInterval   a
_ a
b)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then Ordering
LT else Ordering
GT
compareU (ClosedInterval a
_ a
a) (IntervalOC     a
_ a
b)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareU (OpenInterval   a
_ a
a) (IntervalCO     a
_ a
b)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareU (OpenInterval   a
_ a
a) (ClosedInterval a
_ a
b)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b then Ordering
LT else Ordering
GT
compareU (OpenInterval   a
_ a
a) (OpenInterval   a
_ a
b)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareU (OpenInterval   a
_ a
a) (IntervalOC     a
_ a
b)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b then Ordering
LT else Ordering
GT
compareU (IntervalOC     a
_ a
a) (IntervalCO     a
_ a
b)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then Ordering
LT else Ordering
GT
compareU (IntervalOC     a
_ a
a) (ClosedInterval a
_ a
b)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
compareU (IntervalOC     a
_ a
a) (OpenInterval   a
_ a
b)  = if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then Ordering
LT else Ordering
GT
compareU (IntervalOC     a
_ a
a) (IntervalOC     a
_ a
b)  = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b

instance Ord a => Ord (Interval a) where
  compare :: Interval a -> Interval a -> Ordering
compare Interval a
a Interval a
b = case Interval a -> Interval a -> Ordering
forall a. Ord a => Interval a -> Interval a -> Ordering
compareL Interval a
a Interval a
b of
                  Ordering
EQ -> Interval a -> Interval a -> Ordering
forall a. Ord a => Interval a -> Interval a -> Ordering
compareU Interval a
a Interval a
b
                  Ordering
r  -> Ordering
r

instance Functor Interval where
  fmap :: forall a b. (a -> b) -> Interval a -> Interval b
fmap a -> b
f (IntervalCO     a
a a
b) = b -> b -> Interval b
forall a. a -> a -> Interval a
IntervalCO     (a -> b
f a
a) (a -> b
f a
b)
  fmap a -> b
f (ClosedInterval a
a a
b) = b -> b -> Interval b
forall a. a -> a -> Interval a
ClosedInterval (a -> b
f a
a) (a -> b
f a
b)
  fmap a -> b
f (OpenInterval   a
a a
b) = b -> b -> Interval b
forall a. a -> a -> Interval a
OpenInterval   (a -> b
f a
a) (a -> b
f a
b)
  fmap a -> b
f (IntervalOC     a
a a
b) = b -> b -> Interval b
forall a. a -> a -> Interval a
IntervalOC     (a -> b
f a
a) (a -> b
f a
b)

instance NFData a => NFData (Interval a) where
  rnf :: Interval a -> ()
rnf (IntervalCO     a
a a
b) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b
  rnf (ClosedInterval a
a a
b) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b
  rnf (OpenInterval   a
a a
b) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b
  rnf (IntervalOC     a
a a
b) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b

-- | Like 'compare', but considering the upper bound first.
compareByUpper :: Ord a => Interval a -> Interval a -> Ordering
compareByUpper :: forall a. Ord a => Interval a -> Interval a -> Ordering
compareByUpper Interval a
a Interval a
b = case Interval a -> Interval a -> Ordering
forall a. Ord a => Interval a -> Interval a -> Ordering
compareU Interval a
a Interval a
b of
                       Ordering
EQ -> Interval a -> Interval a -> Ordering
forall a. Ord a => Interval a -> Interval a -> Ordering
compareL Interval a
a Interval a
b
                       Ordering
r  -> Ordering
r

-- | Get the lower bound.
lowerBound :: Interval a -> a
lowerBound :: forall a. Interval a -> a
lowerBound (ClosedInterval a
lo a
_) = a
lo
lowerBound (OpenInterval a
lo a
_) = a
lo
lowerBound (IntervalCO a
lo a
_) = a
lo
lowerBound (IntervalOC a
lo a
_) = a
lo

-- | Get the upper bound.
upperBound :: Interval a -> a
upperBound :: forall a. Interval a -> a
upperBound (ClosedInterval a
_ a
hi) = a
hi
upperBound (OpenInterval a
_ a
hi) = a
hi
upperBound (IntervalCO a
_ a
hi) = a
hi
upperBound (IntervalOC a
_ a
hi) = a
hi


-- | Is the interval empty?
isEmpty :: (Ord a) => Interval a -> Bool
isEmpty :: forall a. Ord a => Interval a -> Bool
isEmpty (ClosedInterval a
a a
b) = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
b
isEmpty Interval a
iv = Interval a -> a
forall a. Interval a -> a
lowerBound Interval a
iv a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= Interval a -> a
forall a. Interval a -> a
upperBound Interval a
iv

-- | Does the interval include its lower bound?
leftClosed :: Interval a -> Bool
leftClosed :: forall a. Interval a -> Bool
leftClosed (ClosedInterval a
_ a
_) = Bool
True
leftClosed (IntervalCO a
_ a
_) = Bool
True
leftClosed Interval a
_ = Bool
False

-- | Does the interval include its upper bound?
rightClosed :: Interval a -> Bool
rightClosed :: forall a. Interval a -> Bool
rightClosed (ClosedInterval a
_ a
_) = Bool
True
rightClosed (IntervalOC a
_ a
_) = Bool
True
rightClosed Interval a
_ = Bool
False


-- | Do the two intervals overlap?
overlaps :: (Ord a) => Interval a -> Interval a -> Bool

overlaps :: forall a. Ord a => Interval a -> Interval a -> Bool
overlaps a :: Interval a
a@(ClosedInterval a
lo1 a
hi1) b :: Interval a
b@(ClosedInterval a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(ClosedInterval a
lo1 a
hi1) b :: Interval a
b@(OpenInterval   a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(ClosedInterval a
lo1 a
hi1) b :: Interval a
b@(IntervalCO     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(ClosedInterval a
lo1 a
hi1) b :: Interval a
b@(IntervalOC     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b

overlaps a :: Interval a
a@(OpenInterval   a
lo1 a
hi1) b :: Interval a
b@(ClosedInterval a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(OpenInterval   a
lo1 a
hi1) b :: Interval a
b@(OpenInterval   a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(OpenInterval   a
lo1 a
hi1) b :: Interval a
b@(IntervalCO     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(OpenInterval   a
lo1 a
hi1) b :: Interval a
b@(IntervalOC     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b

overlaps a :: Interval a
a@(IntervalCO     a
lo1 a
hi1) b :: Interval a
b@(ClosedInterval a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(IntervalCO     a
lo1 a
hi1) b :: Interval a
b@(OpenInterval   a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(IntervalCO     a
lo1 a
hi1) b :: Interval a
b@(IntervalCO     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(IntervalCO     a
lo1 a
hi1) b :: Interval a
b@(IntervalOC     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b

overlaps a :: Interval a
a@(IntervalOC     a
lo1 a
hi1) b :: Interval a
b@(ClosedInterval a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(IntervalOC     a
lo1 a
hi1) b :: Interval a
b@(OpenInterval   a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(IntervalOC     a
lo1 a
hi1) b :: Interval a
b@(IntervalCO     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b
overlaps a :: Interval a
a@(IntervalOC     a
lo1 a
hi1) b :: Interval a
b@(IntervalOC     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
lo2 Bool -> Bool -> Bool
&& Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b

bothNonEmpty :: (Ord a) => Interval a -> Interval a -> Bool
bothNonEmpty :: forall a. Ord a => Interval a -> Interval a -> Bool
bothNonEmpty Interval a
a Interval a
b = Bool -> Bool
not (Interval a -> Bool
forall a. Ord a => Interval a -> Bool
isEmpty Interval a
a Bool -> Bool -> Bool
|| Interval a -> Bool
forall a. Ord a => Interval a -> Bool
isEmpty Interval a
b)


-- | Does the first interval completely contain the second?
subsumes :: (Ord a) => Interval a -> Interval a -> Bool

subsumes :: forall a. Ord a => Interval a -> Interval a -> Bool
subsumes (ClosedInterval a
lo1 a
hi1) (ClosedInterval a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2
subsumes (ClosedInterval a
lo1 a
hi1) (OpenInterval   a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2
subsumes (ClosedInterval a
lo1 a
hi1) (IntervalCO     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2
subsumes (ClosedInterval a
lo1 a
hi1) (IntervalOC     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2

subsumes (OpenInterval   a
lo1 a
hi1) (ClosedInterval a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
hi2
subsumes (OpenInterval   a
lo1 a
hi1) (OpenInterval   a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2
subsumes (OpenInterval   a
lo1 a
hi1) (IntervalCO     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2
subsumes (OpenInterval   a
lo1 a
hi1) (IntervalOC     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
hi2

subsumes (IntervalCO     a
lo1 a
hi1) (ClosedInterval a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
hi2
subsumes (IntervalCO     a
lo1 a
hi1) (OpenInterval   a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2
subsumes (IntervalCO     a
lo1 a
hi1) (IntervalCO     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2
subsumes (IntervalCO     a
lo1 a
hi1) (IntervalOC     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
hi2

subsumes (IntervalOC     a
lo1 a
hi1) (ClosedInterval a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2
subsumes (IntervalOC     a
lo1 a
hi1) (OpenInterval   a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2
subsumes (IntervalOC     a
lo1 a
hi1) (IntervalCO     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2
subsumes (IntervalOC     a
lo1 a
hi1) (IntervalOC     a
lo2 a
hi2) =  a
lo1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
lo2 Bool -> Bool -> Bool
&& a
hi1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
hi2

-- | Interval strictly before another?
-- True if the upper bound of the first interval is below the lower bound of the second.
before :: Ord a => Interval a -> Interval a -> Bool
IntervalCO a
_ a
l     before :: forall a. Ord a => Interval a -> Interval a -> Bool
`before` Interval a
r =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Interval a -> a
forall a. Interval a -> a
lowerBound Interval a
r
ClosedInterval a
_ a
l `before` IntervalCO a
r a
_      =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
r
ClosedInterval a
_ a
l `before` ClosedInterval a
r a
_  =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
r
ClosedInterval a
_ a
l `before` OpenInterval a
r a
_    =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
r
ClosedInterval a
_ a
l `before` IntervalOC a
r a
_      =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
r
OpenInterval a
_ a
l   `before` Interval a
r =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Interval a -> a
forall a. Interval a -> a
lowerBound Interval a
r
IntervalOC a
_ a
l     `before` IntervalCO a
r a
_      =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
r
IntervalOC a
_ a
l     `before` ClosedInterval a
r a
_  =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
r
IntervalOC a
_ a
l     `before` OpenInterval a
r a
_    =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
r
IntervalOC a
_ a
l     `before` IntervalOC a
r a
_      =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
r
                                   
-- | Interval strictly after another?
-- Same as 'flip before'.
after :: Ord a => Interval a -> Interval a -> Bool
Interval a
r after :: forall a. Ord a => Interval a -> Interval a -> Bool
`after` Interval a
l = Interval a
l Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
`before` Interval a
r


-- | Does the interval contain a given point?
inside :: (Ord a) => a -> Interval a -> Bool
a
p inside :: forall a. Ord a => a -> Interval a -> Bool
`inside` (IntervalCO     a
lo a
hi) =  a
lo a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
p Bool -> Bool -> Bool
&& a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi
a
p `inside` (ClosedInterval a
lo a
hi) =  a
lo a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
p Bool -> Bool -> Bool
&& a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
hi
a
p `inside` (OpenInterval   a
lo a
hi) =  a
lo a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
p Bool -> Bool -> Bool
&& a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
hi
a
p `inside` (IntervalOC     a
lo a
hi) =  a
lo a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
p Bool -> Bool -> Bool
&& a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
hi

-- | Is a point strictly less than lower bound?
below :: (Ord a) => a -> Interval a -> Bool
a
p below :: forall a. Ord a => a -> Interval a -> Bool
`below` (IntervalCO     a
l a
_)  =  a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
l
a
p `below` (ClosedInterval a
l a
_)  =  a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  a
l
a
p `below` (OpenInterval   a
l a
_)  =  a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
l
a
p `below` (IntervalOC     a
l a
_)  =  a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
l

-- | Is a point strictly greater than upper bound?
above :: (Ord a) => a -> Interval a -> Bool
a
p above :: forall a. Ord a => a -> Interval a -> Bool
`above` (IntervalCO     a
_ a
u)  =  a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
u
a
p `above` (ClosedInterval a
_ a
u)  =  a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
u
a
p `above` (OpenInterval   a
_ a
u)  =  a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
u
a
p `above` (IntervalOC     a
_ a
u)  =  a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>  a
u

-- | If the intervals overlap combine them into one.
combine :: (Ord a) => Interval a -> Interval a -> Maybe (Interval a)
combine :: forall a. Ord a => Interval a -> Interval a -> Maybe (Interval a)
combine Interval a
a Interval a
b | Interval a
a Interval a -> Interval a -> Bool
forall a. Ord a => Interval a -> Interval a -> Bool
`overlaps` Interval a
b = let v :: Interval a
v = Interval a -> Interval a -> Interval a
forall a. Ord a => Interval a -> Interval a -> Interval a
combineOverlapping Interval a
a Interval a
b in Interval a
v Interval a -> Maybe (Interval a) -> Maybe (Interval a)
forall a b. a -> b -> b
`seq` Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just Interval a
v
            | Bool
otherwise      = Maybe (Interval a)
forall a. Maybe a
Nothing

combineOverlapping :: (Ord a) => Interval a -> Interval a -> Interval a
combineOverlapping :: forall a. Ord a => Interval a -> Interval a -> Interval a
combineOverlapping Interval a
a Interval a
b = case (Interval a -> Interval a -> Ordering
forall a. Ord a => Interval a -> Interval a -> Ordering
compareL Interval a
a Interval a
b, Interval a -> Interval a -> Ordering
forall a. Ord a => Interval a -> Interval a -> Ordering
compareU Interval a
a Interval a
b) of
                           (Ordering
LT, Ordering
LT) -> Interval a -> Interval a -> Interval a
forall {a}. Interval a -> Interval a -> Interval a
construct Interval a
a Interval a
b
                           (Ordering
LT, Ordering
_ ) -> Interval a
a
                           (Ordering
EQ, Ordering
LT) -> Interval a
b
                           (Ordering
EQ, Ordering
_ ) -> Interval a
a
                           (Ordering
GT, Ordering
GT) -> Interval a -> Interval a -> Interval a
forall {a}. Interval a -> Interval a -> Interval a
construct Interval a
b Interval a
a
                           (Ordering
GT, Ordering
_ ) -> Interval a
b
    where
      construct :: Interval a -> Interval a -> Interval a
construct Interval a
lowerBoundInterval Interval a
upperBoundInterval =
         let newLowerBound :: a
newLowerBound = Interval a -> a
forall a. Interval a -> a
lowerBound Interval a
lowerBoundInterval
             newUpperBound :: a
newUpperBound = Interval a -> a
forall a. Interval a -> a
upperBound Interval a
upperBoundInterval
         in
             if Interval a -> Bool
forall a. Interval a -> Bool
leftClosed Interval a
lowerBoundInterval
                 then if Interval a -> Bool
forall a. Interval a -> Bool
rightClosed Interval a
upperBoundInterval
                        then a -> a -> Interval a
forall a. a -> a -> Interval a
ClosedInterval a
newLowerBound a
newUpperBound
                        else a -> a -> Interval a
forall a. a -> a -> Interval a
IntervalCO     a
newLowerBound a
newUpperBound
                 else if Interval a -> Bool
forall a. Interval a -> Bool
rightClosed Interval a
upperBoundInterval
                        then a -> a -> Interval a
forall a. a -> a -> Interval a
IntervalOC     a
newLowerBound a
newUpperBound
                        else a -> a -> Interval a
forall a. a -> a -> Interval a
OpenInterval   a
newLowerBound a
newUpperBound