-----------------------------------------------------------------------------
--
-- Module      :  Data.Ranged.Ranges
-- Copyright   :  (c) Paul Johnson 2006
-- License     :  BSD-style
-- Maintainer  :  paul@cogito.org.uk
-- Stability   :  experimental
-- Portability :  portable
--
-----------------------------------------------------------------------------

-- | A range has an upper and lower boundary.
module Data.Ranged.Ranges (
   -- ** Construction
   Range (..),
   emptyRange,
   fullRange,
   -- ** Predicates
   rangeIsEmpty,
   rangeIsFull,
   rangeOverlap,
   rangeEncloses,
   rangeSingletonValue,
   -- ** Membership
   rangeHas,
   rangeListHas,
   -- ** Set Operations
   singletonRange,
   rangeIntersection,
   rangeUnion,
   rangeDifference,
) where

import           Data.Ranged.Boundaries

-- | A Range has upper and lower boundaries.
data Range v = Range {forall v. Range v -> Boundary v
rangeLower, forall v. Range v -> Boundary v
rangeUpper :: Boundary v}

instance (DiscreteOrdered a) => Eq (Range a) where
   Range a
r1 == :: Range a -> Range a -> Bool
== Range a
r2   = (Range a -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range a
r1 Bool -> Bool -> Bool
&& Range a -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range a
r2) Bool -> Bool -> Bool
||
                (Range a -> Boundary a
forall v. Range v -> Boundary v
rangeLower Range a
r1 Boundary a -> Boundary a -> Bool
forall a. Eq a => a -> a -> Bool
== Range a -> Boundary a
forall v. Range v -> Boundary v
rangeLower Range a
r2 Bool -> Bool -> Bool
&&
                 Range a -> Boundary a
forall v. Range v -> Boundary v
rangeUpper Range a
r1 Boundary a -> Boundary a -> Bool
forall a. Eq a => a -> a -> Bool
== Range a -> Boundary a
forall v. Range v -> Boundary v
rangeUpper Range a
r2)


instance (DiscreteOrdered a) => Ord (Range a) where
   compare :: Range a -> Range a -> Ordering
compare Range a
r1 Range a
r2
      | Range a
r1 Range a -> Range a -> Bool
forall a. Eq a => a -> a -> Bool
== Range a
r2       = Ordering
EQ
      | Range a -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range a
r1  = Ordering
LT
      | Range a -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range a
r2  = Ordering
GT
      | Bool
otherwise      = (Boundary a, Boundary a) -> (Boundary a, Boundary a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Range a -> Boundary a
forall v. Range v -> Boundary v
rangeLower Range a
r1, Range a -> Boundary a
forall v. Range v -> Boundary v
rangeUpper Range a
r1)
                                 (Range a -> Boundary a
forall v. Range v -> Boundary v
rangeLower Range a
r2, Range a -> Boundary a
forall v. Range v -> Boundary v
rangeUpper Range a
r2)

instance (Show a, DiscreteOrdered a) => Show (Range a) where
   show :: Range a -> String
show Range a
r
      | Range a -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range a
r     = String
"Empty"
      | Range a -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsFull Range a
r      = String
"All x"
      | Bool
otherwise          =
         case Range a -> Maybe a
forall v. DiscreteOrdered v => Range v -> Maybe v
rangeSingletonValue Range a
r of
            Just a
v  -> String
"x == " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v
            Maybe a
Nothing -> String
lowerBound String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
upperBound
      where
         lowerBound :: String
lowerBound = case Range a -> Boundary a
forall v. Range v -> Boundary v
rangeLower Range a
r of
            Boundary a
BoundaryBelowAll -> String
""
            BoundaryBelow a
v  -> a -> String
forall a. Show a => a -> String
show a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" <= "
            BoundaryAbove a
v  -> a -> String
forall a. Show a => a -> String
show a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" < "
            Boundary a
BoundaryAboveAll -> ShowS
forall a. HasCallStack => String -> a
error String
"show Range: lower bound is BoundaryAboveAll"
         upperBound :: String
upperBound = case Range a -> Boundary a
forall v. Range v -> Boundary v
rangeUpper Range a
r of
            Boundary a
BoundaryBelowAll -> ShowS
forall a. HasCallStack => String -> a
error String
"show Range: upper bound is BoundaryBelowAll"
            BoundaryBelow a
v  -> String
" < " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v
            BoundaryAbove a
v  -> String
" <= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v
            Boundary a
BoundaryAboveAll -> String
""


-- | True if the value is within the range.
rangeHas :: Ord v => Range v -> v -> Bool

rangeHas :: forall v. Ord v => Range v -> v -> Bool
rangeHas (Range Boundary v
b1 Boundary v
b2) v
v =
   (v
v v -> Boundary v -> Bool
forall v. Ord v => v -> Boundary v -> Bool
/>/ Boundary v
b1) Bool -> Bool -> Bool
&& Bool -> Bool
not (v
v v -> Boundary v -> Bool
forall v. Ord v => v -> Boundary v -> Bool
/>/ Boundary v
b2)


-- | True if the value is within one of the ranges.
rangeListHas :: Ord v =>
   [Range v] -> v -> Bool
rangeListHas :: forall v. Ord v => [Range v] -> v -> Bool
rangeListHas [Range v]
ls v
v = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Range v -> Bool) -> [Range v] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\Range v
r -> Range v -> v -> Bool
forall v. Ord v => Range v -> v -> Bool
rangeHas Range v
r v
v) [Range v]
ls


-- | The empty range
emptyRange :: Range v
emptyRange :: forall v. Range v
emptyRange = Boundary v -> Boundary v -> Range v
forall v. Boundary v -> Boundary v -> Range v
Range Boundary v
forall a. Boundary a
BoundaryAboveAll Boundary v
forall a. Boundary a
BoundaryBelowAll


-- | The full range.  All values are within it.
fullRange :: Range v
fullRange :: forall v. Range v
fullRange = Boundary v -> Boundary v -> Range v
forall v. Boundary v -> Boundary v -> Range v
Range Boundary v
forall a. Boundary a
BoundaryBelowAll Boundary v
forall a. Boundary a
BoundaryAboveAll


-- | A range containing a single value
singletonRange :: v -> Range v
singletonRange :: forall v. v -> Range v
singletonRange v
v = Boundary v -> Boundary v -> Range v
forall v. Boundary v -> Boundary v -> Range v
Range (v -> Boundary v
forall a. a -> Boundary a
BoundaryBelow v
v) (v -> Boundary v
forall a. a -> Boundary a
BoundaryAbove v
v)


-- | If the range is a singleton, returns @Just@ the value.  Otherwise returns
-- @Nothing@.
--
-- Known bug: This always returns @Nothing@ for ranges including
-- @BoundaryBelowAll@ or @BoundaryAboveAll@.  For bounded types this can be
-- incorrect.  For instance, the following range only contains one value:
--
-- >    Range (BoundaryBelow maxBound) BoundaryAboveAll
rangeSingletonValue :: DiscreteOrdered v => Range v -> Maybe v
rangeSingletonValue :: forall v. DiscreteOrdered v => Range v -> Maybe v
rangeSingletonValue (Range (BoundaryBelow v
v1) (BoundaryBelow v
v2))
   | v -> v -> Bool
forall a. DiscreteOrdered a => a -> a -> Bool
adjacent v
v1 v
v2  = v -> Maybe v
forall a. a -> Maybe a
Just v
v1
   | Bool
otherwise       = Maybe v
forall a. Maybe a
Nothing
rangeSingletonValue (Range (BoundaryBelow v
v1) (BoundaryAbove v
v2))
   | v
v1 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v2        = v -> Maybe v
forall a. a -> Maybe a
Just v
v1
   | Bool
otherwise       = Maybe v
forall a. Maybe a
Nothing
rangeSingletonValue (Range (BoundaryAbove v
v1) (BoundaryBelow v
v2)) =
   do
      v
v2' <- v -> Maybe v
forall a. DiscreteOrdered a => a -> Maybe a
adjacentBelow v
v2
      v
v2'' <- v -> Maybe v
forall a. DiscreteOrdered a => a -> Maybe a
adjacentBelow v
v2'
      if v
v1 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v2'' then v -> Maybe v
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return v
v2' else Maybe v
forall a. Maybe a
Nothing
rangeSingletonValue (Range (BoundaryAbove v
v1) (BoundaryAbove v
v2))
   | v -> v -> Bool
forall a. DiscreteOrdered a => a -> a -> Bool
adjacent v
v1 v
v2  = v -> Maybe v
forall a. a -> Maybe a
Just v
v2
   | Bool
otherwise       = Maybe v
forall a. Maybe a
Nothing
rangeSingletonValue (Range Boundary v
_ Boundary v
_) = Maybe v
forall a. Maybe a
Nothing

-- | A range is empty unless its upper boundary is greater than its lower
-- boundary.
rangeIsEmpty :: DiscreteOrdered v => Range v -> Bool
rangeIsEmpty :: forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty (Range Boundary v
lower Boundary v
upper) = Boundary v
upper Boundary v -> Boundary v -> Bool
forall a. Ord a => a -> a -> Bool
<= Boundary v
lower


-- | A range is full if it contains every possible value.
rangeIsFull :: DiscreteOrdered v => Range v -> Bool
rangeIsFull :: forall v. DiscreteOrdered v => Range v -> Bool
rangeIsFull = (Range v -> Range v -> Bool
forall a. Eq a => a -> a -> Bool
== Range v
forall v. Range v
fullRange)

-- | Two ranges overlap if their intersection is non-empty.
rangeOverlap :: DiscreteOrdered v => Range v -> Range v -> Bool
rangeOverlap :: forall a. DiscreteOrdered a => Range a -> Range a -> Bool
rangeOverlap Range v
r1 Range v
r2 =
   Bool -> Bool
not (Range v -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range v
r1)
   Bool -> Bool -> Bool
&& Bool -> Bool
not (Range v -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range v
r2)
   Bool -> Bool -> Bool
&& Bool -> Bool
not (Range v -> Boundary v
forall v. Range v -> Boundary v
rangeUpper Range v
r1 Boundary v -> Boundary v -> Bool
forall a. Ord a => a -> a -> Bool
<= Range v -> Boundary v
forall v. Range v -> Boundary v
rangeLower Range v
r2 Bool -> Bool -> Bool
|| Range v -> Boundary v
forall v. Range v -> Boundary v
rangeUpper Range v
r2 Boundary v -> Boundary v -> Bool
forall a. Ord a => a -> a -> Bool
<= Range v -> Boundary v
forall v. Range v -> Boundary v
rangeLower Range v
r1)


-- | The first range encloses the second if every value in the second range is
-- also within the first range.  If the second range is empty then this is
-- always true.
rangeEncloses :: DiscreteOrdered v => Range v -> Range v -> Bool
rangeEncloses :: forall a. DiscreteOrdered a => Range a -> Range a -> Bool
rangeEncloses Range v
r1 Range v
r2 =
   (Range v -> Boundary v
forall v. Range v -> Boundary v
rangeLower Range v
r1 Boundary v -> Boundary v -> Bool
forall a. Ord a => a -> a -> Bool
<= Range v -> Boundary v
forall v. Range v -> Boundary v
rangeLower Range v
r2 Bool -> Bool -> Bool
&& Range v -> Boundary v
forall v. Range v -> Boundary v
rangeUpper Range v
r2 Boundary v -> Boundary v -> Bool
forall a. Ord a => a -> a -> Bool
<= Range v -> Boundary v
forall v. Range v -> Boundary v
rangeUpper Range v
r1)
   Bool -> Bool -> Bool
|| Range v -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range v
r2


-- | Intersection of two ranges, if any.
rangeIntersection :: DiscreteOrdered v => Range v -> Range v -> Range v
rangeIntersection :: forall a. DiscreteOrdered a => Range a -> Range a -> Range a
rangeIntersection r1 :: Range v
r1@(Range Boundary v
lower1 Boundary v
upper1) r2 :: Range v
r2@(Range Boundary v
lower2 Boundary v
upper2)
    | Range v -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range v
r1 Bool -> Bool -> Bool
|| Range v -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range v
r2  = Range v
forall v. Range v
emptyRange
    | Bool
otherwise  = Boundary v -> Boundary v -> Range v
forall v. Boundary v -> Boundary v -> Range v
Range (Boundary v -> Boundary v -> Boundary v
forall a. Ord a => a -> a -> a
max Boundary v
lower1 Boundary v
lower2) (Boundary v -> Boundary v -> Boundary v
forall a. Ord a => a -> a -> a
min Boundary v
upper1 Boundary v
upper2)


-- | Union of two ranges.  Returns one or two results.
--
-- If there are two results then they are guaranteed to have a non-empty
-- gap in between, but may not be in ascending order.
rangeUnion :: DiscreteOrdered v => Range v -> Range v -> [Range v]
rangeUnion :: forall v. DiscreteOrdered v => Range v -> Range v -> [Range v]
rangeUnion r1 :: Range v
r1@(Range Boundary v
lower1 Boundary v
upper1) r2 :: Range v
r2@(Range Boundary v
lower2 Boundary v
upper2)
   | Range v -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range v
r1  = [Range v
r2]
   | Range v -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty Range v
r2  = [Range v
r1]
   | Bool
otherwise =
       if Bool
touching then [Boundary v -> Boundary v -> Range v
forall v. Boundary v -> Boundary v -> Range v
Range Boundary v
lower Boundary v
upper] else [Range v
r1, Range v
r2]
   where
     touching :: Bool
touching = (Boundary v -> Boundary v -> Boundary v
forall a. Ord a => a -> a -> a
max Boundary v
lower1 Boundary v
lower2) Boundary v -> Boundary v -> Bool
forall a. Ord a => a -> a -> Bool
<= (Boundary v -> Boundary v -> Boundary v
forall a. Ord a => a -> a -> a
min Boundary v
upper1 Boundary v
upper2)
     lower :: Boundary v
lower = Boundary v -> Boundary v -> Boundary v
forall a. Ord a => a -> a -> a
min Boundary v
lower1 Boundary v
lower2
     upper :: Boundary v
upper = Boundary v -> Boundary v -> Boundary v
forall a. Ord a => a -> a -> a
max Boundary v
upper1 Boundary v
upper2


-- | @range1@ minus @range2@.  Returns zero, one or two results.  Multiple
-- results are guaranteed to have non-empty gaps in between, but may not be in
-- ascending order.
rangeDifference :: DiscreteOrdered v => Range v -> Range v -> [Range v]

rangeDifference :: forall v. DiscreteOrdered v => Range v -> Range v -> [Range v]
rangeDifference r1 :: Range v
r1@(Range Boundary v
lower1 Boundary v
upper1) (Range Boundary v
lower2 Boundary v
upper2) =
   -- There are six possibilities
   --    1: r2 completely less than r1
   --    2: r2 overlaps bottom of r1
   --    3: r2 encloses r1
   --    4: r1 encloses r2
   --    5: r2 overlaps top of r1
   --    6: r2 completely greater than r1
   if Bool
intersects
      then -- Cases 2,3,4,5
         (Range v -> Bool) -> [Range v] -> [Range v]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Range v -> Bool) -> Range v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range v -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty) [Boundary v -> Boundary v -> Range v
forall v. Boundary v -> Boundary v -> Range v
Range Boundary v
lower1 Boundary v
lower2, Boundary v -> Boundary v -> Range v
forall v. Boundary v -> Boundary v -> Range v
Range Boundary v
upper2 Boundary v
upper1]
      else -- Cases 1, 6
         [Range v
r1]
   where
      intersects :: Bool
intersects = (Boundary v -> Boundary v -> Boundary v
forall a. Ord a => a -> a -> a
max Boundary v
lower1 Boundary v
lower2) Boundary v -> Boundary v -> Bool
forall a. Ord a => a -> a -> Bool
< (Boundary v -> Boundary v -> Boundary v
forall a. Ord a => a -> a -> a
min Boundary v
upper1 Boundary v
upper2)