-----------------------------------------------------------------------------
--
-- 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,
   -- ** QuickCheck properties
   prop_unionRange,
   prop_unionRangeLength,
   prop_intersectionRange,
   prop_differenceRange,
   prop_intersectionOverlap,
   prop_enclosureUnion,
   prop_singletonRangeHas,
   prop_singletonRangeHasOnly,
   prop_singletonRangeConverse,
   prop_emptyNonSingleton,
   prop_fullNonSingleton,
   prop_nonSingleton,
   prop_intSingleton
) where

import Control.Monad
import Data.Ranged.Boundaries
import Data.Maybe
import Test.QuickCheck

-- | A Range has upper and lower boundaries.
data Range v = Range {Range v -> Boundary v
rangeLower, 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 :: 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 :: [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 :: DiscreteOrdered v => Range v
emptyRange :: 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 :: DiscreteOrdered v => Range v
fullRange :: 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 :: DiscreteOrdered v => v -> Range v
singletonRange :: 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 :: 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 (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 :: 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 :: Range v -> Bool
rangeIsFull = (Range v -> Range v -> Bool
forall a. Eq a => a -> a -> Bool
== Range v
forall v. DiscreteOrdered v => Range v
fullRange)

-- | Two ranges overlap if their intersection is non-empty.
rangeOverlap :: DiscreteOrdered v => Range v -> Range v -> Bool
rangeOverlap :: Range v -> Range v -> 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 :: Range v -> Range v -> 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 :: Range v -> Range v -> Range v
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. DiscreteOrdered 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 :: 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 :: 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)


-- QuickCheck generators

instance (Arbitrary v,  DiscreteOrdered v, Show v) =>
   Arbitrary (Range v) where

   arbitrary :: Gen (Range v)
arbitrary = [(Int, Gen (Range v))] -> Gen (Range v)
forall a. [(Int, Gen a)] -> Gen a
frequency [
      (Int
17, do  -- Ordinary range
         Boundary v
b1 <- Gen (Boundary v)
forall a. Arbitrary a => Gen a
arbitrary
         Boundary v
b2 <- Gen (Boundary v)
forall a. Arbitrary a => Gen a
arbitrary
         if Boundary v
b1 Boundary v -> Boundary v -> Bool
forall a. Ord a => a -> a -> Bool
< Boundary v
b2
            then Range v -> Gen (Range v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Range v -> Gen (Range v)) -> Range v -> Gen (Range v)
forall a b. (a -> b) -> a -> b
$ Boundary v -> Boundary v -> Range v
forall v. Boundary v -> Boundary v -> Range v
Range Boundary v
b1 Boundary v
b2
            else Range v -> Gen (Range v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Range v -> Gen (Range v)) -> Range v -> Gen (Range v)
forall a b. (a -> b) -> a -> b
$ Boundary v -> Boundary v -> Range v
forall v. Boundary v -> Boundary v -> Range v
Range Boundary v
b2 Boundary v
b1
      ),
      (Int
1, do  -- Singleton range
         v
v <- Gen v
forall a. Arbitrary a => Gen a
arbitrary
         Range v -> Gen (Range v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Range v -> Gen (Range v)) -> Range v -> Gen (Range v)
forall a b. (a -> b) -> a -> b
$ v -> Range v
forall v. DiscreteOrdered v => v -> Range v
singletonRange v
v
      ),
      (Int
1, Range v -> Gen (Range v)
forall (m :: * -> *) a. Monad m => a -> m a
return Range v
forall v. DiscreteOrdered v => Range v
emptyRange),
      (Int
1, Range v -> Gen (Range v)
forall (m :: * -> *) a. Monad m => a -> m a
return Range v
forall v. DiscreteOrdered v => Range v
fullRange)
      ]

instance (CoArbitrary v, DiscreteOrdered v, Show v) =>
   CoArbitrary (Range v) where

   coarbitrary :: Range v -> Gen b -> Gen b
coarbitrary (Range Boundary v
lower Boundary v
upper) =
      Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
0 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Boundary v -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Boundary v
lower (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Boundary v -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Boundary v
upper



-- QuickCheck Properties

-- | The union of two ranges has a value iff either range has it.
--
-- > prop_unionRange r1 r2 n =
-- >    (r1 `rangeHas` n || r2 `rangeHas` n)
-- >    == (r1 `rangeUnion` r2) `rangeListHas` n
prop_unionRange :: (DiscreteOrdered a) => Range a -> Range a -> a -> Bool
prop_unionRange :: Range a -> Range a -> a -> Bool
prop_unionRange Range a
r1 Range a
r2 a
n =
   (Range a
r1 Range a -> a -> Bool
forall v. Ord v => Range v -> v -> Bool
`rangeHas` a
n Bool -> Bool -> Bool
|| Range a
r2 Range a -> a -> Bool
forall v. Ord v => Range v -> v -> Bool
`rangeHas` a
n)
   Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (Range a
r1 Range a -> Range a -> [Range a]
forall v. DiscreteOrdered v => Range v -> Range v -> [Range v]
`rangeUnion` Range a
r2) [Range a] -> a -> Bool
forall v. Ord v => [Range v] -> v -> Bool
`rangeListHas` a
n

-- | The union of two ranges always contains one or two ranges.
--
-- > prop_unionRangeLength r1 r2 = (n == 1) || (n == 2)
-- >    where n = length $ rangeUnion r1 r2
prop_unionRangeLength :: (DiscreteOrdered a) => Range a -> Range a -> Bool
prop_unionRangeLength :: Range a -> Range a -> Bool
prop_unionRangeLength Range a
r1 Range a
r2 = (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) Bool -> Bool -> Bool
|| (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2)
   where n :: Int
n = [Range a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Range a] -> Int) -> [Range a] -> Int
forall a b. (a -> b) -> a -> b
$ Range a -> Range a -> [Range a]
forall v. DiscreteOrdered v => Range v -> Range v -> [Range v]
rangeUnion Range a
r1 Range a
r2

-- | The intersection of two ranges has a value iff both ranges have it.
--
-- > prop_intersectionRange r1 r2 n =
-- >    (r1 `rangeHas` n && r2 `rangeHas` n)
-- >    == (r1 `rangeIntersection` r2) `rangeHas` n
prop_intersectionRange :: (DiscreteOrdered a) => Range a -> Range a -> a -> Bool
prop_intersectionRange :: Range a -> Range a -> a -> Bool
prop_intersectionRange Range a
r1 Range a
r2 a
n =
   (Range a
r1 Range a -> a -> Bool
forall v. Ord v => Range v -> v -> Bool
`rangeHas` a
n Bool -> Bool -> Bool
&& Range a
r2 Range a -> a -> Bool
forall v. Ord v => Range v -> v -> Bool
`rangeHas` a
n)
   Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (Range a
r1 Range a -> Range a -> Range a
forall a. DiscreteOrdered a => Range a -> Range a -> Range a
`rangeIntersection` Range a
r2) Range a -> a -> Bool
forall v. Ord v => Range v -> v -> Bool
`rangeHas` a
n

-- | The difference of two ranges has a value iff the first range has it and
-- the second does not.
--
-- > prop_differenceRange r1 r2 n =
-- >    (r1 `rangeHas` n && not (r2 `rangeHas` n))
-- >    == (r1 `rangeDifference` r2) `rangeListHas` n
prop_differenceRange :: (DiscreteOrdered a) => Range a -> Range a -> a -> Bool
prop_differenceRange :: Range a -> Range a -> a -> Bool
prop_differenceRange Range a
r1 Range a
r2 a
n =
   (Range a
r1 Range a -> a -> Bool
forall v. Ord v => Range v -> v -> Bool
`rangeHas` a
n Bool -> Bool -> Bool
&& Bool -> Bool
not (Range a
r2 Range a -> a -> Bool
forall v. Ord v => Range v -> v -> Bool
`rangeHas` a
n))
   Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (Range a
r1 Range a -> Range a -> [Range a]
forall v. DiscreteOrdered v => Range v -> Range v -> [Range v]
`rangeDifference` Range a
r2) [Range a] -> a -> Bool
forall v. Ord v => [Range v] -> v -> Bool
`rangeListHas` a
n

-- | Iff two ranges overlap then their intersection is non-empty.
--
-- > prop_intersectionOverlap r1 r2 =
-- >     (rangeIsEmpty $ rangeIntersection r1 r2) == (rangeOverlap r1 r2)
prop_intersectionOverlap :: (DiscreteOrdered a) => Range a -> Range a -> Bool
prop_intersectionOverlap :: Range a -> Range a -> Bool
prop_intersectionOverlap Range a
r1 Range a
r2 =
    (Range a -> Bool
forall v. DiscreteOrdered v => Range v -> Bool
rangeIsEmpty (Range a -> Bool) -> Range a -> Bool
forall a b. (a -> b) -> a -> b
$ Range a -> Range a -> Range a
forall a. DiscreteOrdered a => Range a -> Range a -> Range a
rangeIntersection Range a
r1 Range a
r2) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Bool
not (Range a -> Range a -> Bool
forall a. DiscreteOrdered a => Range a -> Range a -> Bool
rangeOverlap Range a
r1 Range a
r2)

-- | Range enclosure makes union an identity function.
--
-- > prop_enclosureUnion r1 r2 =
-- >    rangeEncloses r1 r2 == (rangeUnion r1 r2 == [r1])
prop_enclosureUnion :: (DiscreteOrdered a) => Range a -> Range a -> Bool
prop_enclosureUnion :: Range a -> Range a -> Bool
prop_enclosureUnion Range a
r1 Range a
r2 = Range a -> Range a -> Bool
forall a. DiscreteOrdered a => Range a -> Range a -> Bool
rangeEncloses Range a
r1 Range a
r2 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (Range a -> Range a -> [Range a]
forall v. DiscreteOrdered v => Range v -> Range v -> [Range v]
rangeUnion Range a
r1 Range a
r2 [Range a] -> [Range a] -> Bool
forall a. Eq a => a -> a -> Bool
== [Range a
r1])

-- | Range Singleton has its member.
--
-- > prop_singletonRangeHas v = singletonRange v `rangeHas` v
prop_singletonRangeHas :: (DiscreteOrdered a) => a -> Bool
prop_singletonRangeHas :: a -> Bool
prop_singletonRangeHas a
v = a -> Range a
forall v. DiscreteOrdered v => v -> Range v
singletonRange a
v Range a -> a -> Bool
forall v. Ord v => Range v -> v -> Bool
`rangeHas` a
v

-- | Range Singleton has only its member.
--
-- > prop_singletonHasOnly v1 v2 =
-- >    (v1 == v2) == (singletonRange v1 `rangeHas` v2)
prop_singletonRangeHasOnly :: (DiscreteOrdered a) => a -> a -> Bool
prop_singletonRangeHasOnly :: a -> a -> Bool
prop_singletonRangeHasOnly a
v1 a
v2 =
   (a
v1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v2) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (a -> Range a
forall v. DiscreteOrdered v => v -> Range v
singletonRange a
v1 Range a -> a -> Bool
forall v. Ord v => Range v -> v -> Bool
`rangeHas` a
v2)

-- | A singleton range can have its value extracted.
--
-- > prop_singletonRangeConverse v =
-- >    rangeSingletonValue (singletonRange v) == Just v
prop_singletonRangeConverse:: (DiscreteOrdered a) => a -> Bool
prop_singletonRangeConverse :: a -> Bool
prop_singletonRangeConverse a
v =
   Range a -> Maybe a
forall v. DiscreteOrdered v => Range v -> Maybe v
rangeSingletonValue (a -> Range a
forall v. DiscreteOrdered v => v -> Range v
singletonRange a
v) Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a. a -> Maybe a
Just a
v

-- | The empty range is not a singleton.
--
-- > prop_emptyNonSingleton = rangeSingletonValue emptyRange == Nothing
prop_emptyNonSingleton :: Bool
prop_emptyNonSingleton :: Bool
prop_emptyNonSingleton =
    Range Int -> Maybe Int
forall v. DiscreteOrdered v => Range v -> Maybe v
rangeSingletonValue (Range Int
forall v. DiscreteOrdered v => Range v
emptyRange :: Range Int) Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
forall a. Maybe a
Nothing

-- | The full range is not a singleton.
--
-- > prop_fullNonSingleton = rangeSingletonValue fullRange == Nothing
prop_fullNonSingleton :: Bool
prop_fullNonSingleton :: Bool
prop_fullNonSingleton =
    Range Int -> Maybe Int
forall v. DiscreteOrdered v => Range v -> Maybe v
rangeSingletonValue (Range Int
forall v. DiscreteOrdered v => Range v
fullRange :: Range Int) Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
forall a. Maybe a
Nothing

-- | For real x and y, @x < y@ implies that any range between them is a
-- non-singleton.
prop_nonSingleton :: Double -> Double -> Property
prop_nonSingleton :: Double -> Double -> Property
prop_nonSingleton Double
x Double
y = (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
y) Bool -> Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Double] -> Bool) -> [Double] -> Bool
forall a b. (a -> b) -> a -> b
$ (Range Double -> Maybe Double) -> [Range Double] -> [Double]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Range Double -> Maybe Double
forall v. DiscreteOrdered v => Range v -> Maybe v
rangeSingletonValue [Range Double]
rs
   where rs :: [Range Double]
rs = [
          Boundary Double -> Boundary Double -> Range Double
forall v. Boundary v -> Boundary v -> Range v
Range (Double -> Boundary Double
forall a. a -> Boundary a
BoundaryBelow Double
x) (Double -> Boundary Double
forall a. a -> Boundary a
BoundaryBelow Double
y),
          Boundary Double -> Boundary Double -> Range Double
forall v. Boundary v -> Boundary v -> Range v
Range (Double -> Boundary Double
forall a. a -> Boundary a
BoundaryAbove Double
x) (Double -> Boundary Double
forall a. a -> Boundary a
BoundaryBelow Double
y),
          Boundary Double -> Boundary Double -> Range Double
forall v. Boundary v -> Boundary v -> Range v
Range (Double -> Boundary Double
forall a. a -> Boundary a
BoundaryBelow Double
x) (Double -> Boundary Double
forall a. a -> Boundary a
BoundaryAbove Double
y),
          Boundary Double -> Boundary Double -> Range Double
forall v. Boundary v -> Boundary v -> Range v
Range (Double -> Boundary Double
forall a. a -> Boundary a
BoundaryAbove Double
x) (Double -> Boundary Double
forall a. a -> Boundary a
BoundaryAbove Double
y)]


-- | For all integers x and y, any range formed from boundaries on either side
-- of x and y is a singleton iff it contains exactly one integer.
prop_intSingleton :: Integer -> Integer -> Property
prop_intSingleton :: Integer -> Integer -> Property
prop_intSingleton Integer
x Integer
y = Gen (Range Integer) -> (Range Integer -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Integer -> Integer -> Gen (Range Integer)
forall v. v -> v -> Gen (Range v)
rangeAround Integer
x Integer
y) ((Range Integer -> Bool) -> Property)
-> (Range Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \Range Integer
r ->
                        case (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Range Integer -> Integer -> Bool
forall v. Ord v => Range v -> v -> Bool
rangeHas Range Integer
r) [Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1 .. Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1] of
                          [Integer
v]  -> Range Integer -> Maybe Integer
forall v. DiscreteOrdered v => Range v -> Maybe v
rangeSingletonValue Range Integer
r Maybe Integer -> Maybe Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
v
                          [Integer]
_    -> Range Integer -> Maybe Integer
forall v. DiscreteOrdered v => Range v -> Maybe v
rangeSingletonValue Range Integer
r Maybe Integer -> Maybe Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Integer
forall a. Maybe a
Nothing
    where
      rangeAround :: v -> v -> Gen (Range v)
rangeAround v
v1 v
v2 = (Boundary v -> Boundary v -> Range v)
-> Gen (Boundary v -> Boundary v -> Range v)
forall (m :: * -> *) a. Monad m => a -> m a
return Boundary v -> Boundary v -> Range v
forall v. Boundary v -> Boundary v -> Range v
Range Gen (Boundary v -> Boundary v -> Range v)
-> Gen (Boundary v) -> Gen (Boundary v -> Range v)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` v -> Gen (Boundary v)
forall a. a -> Gen (Boundary a)
genBound v
v1 Gen (Boundary v -> Range v) -> Gen (Boundary v) -> Gen (Range v)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` v -> Gen (Boundary v)
forall a. a -> Gen (Boundary a)
genBound v
v2
      genBound :: a -> Gen (Boundary a)
genBound a
v = [Boundary a] -> Gen (Boundary a)
forall a. [a] -> Gen a
elements [a -> Boundary a
forall a. a -> Boundary a
BoundaryAbove a
v, a -> Boundary a
forall a. a -> Boundary a
BoundaryBelow a
v]