{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE DeriveAnyClass  #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Range
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Data type for representing Generic Ranges (Intervals) and functions that
-- work with them.
--
--------------------------------------------------------------------------------
module Data.Range( EndPoint(..)
                 , isOpen, isClosed
                 , unEndPoint
                 , Range(.., OpenRange, ClosedRange, Range')
                 , prettyShow
                 , lower, upper
                 , inRange, width, clipLower, clipUpper, midPoint, clampTo
                 , isValid, covers

                 , shiftLeft, shiftRight
                 ) where

import Control.DeepSeq
import Control.Lens
import Control.Applicative
import Data.Intersection
import Data.Vinyl.CoRec
import GHC.Generics (Generic)
import Test.QuickCheck
import Data.Functor.Classes
import Text.Read

--------------------------------------------------------------------------------
-- * Representing Endpoints of a Range

-- | Endpoints of a range may either be open or closed.
data EndPoint a = Open   !a
                | Closed !a
                deriving (EndPoint a -> EndPoint a -> Bool
(EndPoint a -> EndPoint a -> Bool)
-> (EndPoint a -> EndPoint a -> Bool) -> Eq (EndPoint a)
forall a. Eq a => EndPoint a -> EndPoint a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndPoint a -> EndPoint a -> Bool
$c/= :: forall a. Eq a => EndPoint a -> EndPoint a -> Bool
== :: EndPoint a -> EndPoint a -> Bool
$c== :: forall a. Eq a => EndPoint a -> EndPoint a -> Bool
Eq,a -> EndPoint b -> EndPoint a
(a -> b) -> EndPoint a -> EndPoint b
(forall a b. (a -> b) -> EndPoint a -> EndPoint b)
-> (forall a b. a -> EndPoint b -> EndPoint a) -> Functor EndPoint
forall a b. a -> EndPoint b -> EndPoint a
forall a b. (a -> b) -> EndPoint a -> EndPoint b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EndPoint b -> EndPoint a
$c<$ :: forall a b. a -> EndPoint b -> EndPoint a
fmap :: (a -> b) -> EndPoint a -> EndPoint b
$cfmap :: forall a b. (a -> b) -> EndPoint a -> EndPoint b
Functor,EndPoint a -> Bool
(a -> m) -> EndPoint a -> m
(a -> b -> b) -> b -> EndPoint a -> b
(forall m. Monoid m => EndPoint m -> m)
-> (forall m a. Monoid m => (a -> m) -> EndPoint a -> m)
-> (forall m a. Monoid m => (a -> m) -> EndPoint a -> m)
-> (forall a b. (a -> b -> b) -> b -> EndPoint a -> b)
-> (forall a b. (a -> b -> b) -> b -> EndPoint a -> b)
-> (forall b a. (b -> a -> b) -> b -> EndPoint a -> b)
-> (forall b a. (b -> a -> b) -> b -> EndPoint a -> b)
-> (forall a. (a -> a -> a) -> EndPoint a -> a)
-> (forall a. (a -> a -> a) -> EndPoint a -> a)
-> (forall a. EndPoint a -> [a])
-> (forall a. EndPoint a -> Bool)
-> (forall a. EndPoint a -> Int)
-> (forall a. Eq a => a -> EndPoint a -> Bool)
-> (forall a. Ord a => EndPoint a -> a)
-> (forall a. Ord a => EndPoint a -> a)
-> (forall a. Num a => EndPoint a -> a)
-> (forall a. Num a => EndPoint a -> a)
-> Foldable EndPoint
forall a. Eq a => a -> EndPoint a -> Bool
forall a. Num a => EndPoint a -> a
forall a. Ord a => EndPoint a -> a
forall m. Monoid m => EndPoint m -> m
forall a. EndPoint a -> Bool
forall a. EndPoint a -> Int
forall a. EndPoint a -> [a]
forall a. (a -> a -> a) -> EndPoint a -> a
forall m a. Monoid m => (a -> m) -> EndPoint a -> m
forall b a. (b -> a -> b) -> b -> EndPoint a -> b
forall a b. (a -> b -> b) -> b -> EndPoint a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: EndPoint a -> a
$cproduct :: forall a. Num a => EndPoint a -> a
sum :: EndPoint a -> a
$csum :: forall a. Num a => EndPoint a -> a
minimum :: EndPoint a -> a
$cminimum :: forall a. Ord a => EndPoint a -> a
maximum :: EndPoint a -> a
$cmaximum :: forall a. Ord a => EndPoint a -> a
elem :: a -> EndPoint a -> Bool
$celem :: forall a. Eq a => a -> EndPoint a -> Bool
length :: EndPoint a -> Int
$clength :: forall a. EndPoint a -> Int
null :: EndPoint a -> Bool
$cnull :: forall a. EndPoint a -> Bool
toList :: EndPoint a -> [a]
$ctoList :: forall a. EndPoint a -> [a]
foldl1 :: (a -> a -> a) -> EndPoint a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> EndPoint a -> a
foldr1 :: (a -> a -> a) -> EndPoint a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> EndPoint a -> a
foldl' :: (b -> a -> b) -> b -> EndPoint a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> EndPoint a -> b
foldl :: (b -> a -> b) -> b -> EndPoint a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> EndPoint a -> b
foldr' :: (a -> b -> b) -> b -> EndPoint a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> EndPoint a -> b
foldr :: (a -> b -> b) -> b -> EndPoint a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> EndPoint a -> b
foldMap' :: (a -> m) -> EndPoint a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> EndPoint a -> m
foldMap :: (a -> m) -> EndPoint a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> EndPoint a -> m
fold :: EndPoint m -> m
$cfold :: forall m. Monoid m => EndPoint m -> m
Foldable,Functor EndPoint
Foldable EndPoint
Functor EndPoint
-> Foldable EndPoint
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> EndPoint a -> f (EndPoint b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    EndPoint (f a) -> f (EndPoint a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> EndPoint a -> m (EndPoint b))
-> (forall (m :: * -> *) a.
    Monad m =>
    EndPoint (m a) -> m (EndPoint a))
-> Traversable EndPoint
(a -> f b) -> EndPoint a -> f (EndPoint b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => EndPoint (m a) -> m (EndPoint a)
forall (f :: * -> *) a.
Applicative f =>
EndPoint (f a) -> f (EndPoint a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EndPoint a -> m (EndPoint b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EndPoint a -> f (EndPoint b)
sequence :: EndPoint (m a) -> m (EndPoint a)
$csequence :: forall (m :: * -> *) a. Monad m => EndPoint (m a) -> m (EndPoint a)
mapM :: (a -> m b) -> EndPoint a -> m (EndPoint b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EndPoint a -> m (EndPoint b)
sequenceA :: EndPoint (f a) -> f (EndPoint a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
EndPoint (f a) -> f (EndPoint a)
traverse :: (a -> f b) -> EndPoint a -> f (EndPoint b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EndPoint a -> f (EndPoint b)
$cp2Traversable :: Foldable EndPoint
$cp1Traversable :: Functor EndPoint
Traversable,(forall x. EndPoint a -> Rep (EndPoint a) x)
-> (forall x. Rep (EndPoint a) x -> EndPoint a)
-> Generic (EndPoint a)
forall x. Rep (EndPoint a) x -> EndPoint a
forall x. EndPoint a -> Rep (EndPoint a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (EndPoint a) x -> EndPoint a
forall a x. EndPoint a -> Rep (EndPoint a) x
$cto :: forall a x. Rep (EndPoint a) x -> EndPoint a
$cfrom :: forall a x. EndPoint a -> Rep (EndPoint a) x
Generic,EndPoint a -> ()
(EndPoint a -> ()) -> NFData (EndPoint a)
forall a. NFData a => EndPoint a -> ()
forall a. (a -> ()) -> NFData a
rnf :: EndPoint a -> ()
$crnf :: forall a. NFData a => EndPoint a -> ()
NFData)

instance (Show a) => Show (EndPoint a) where
  showsPrec :: Int -> EndPoint a -> ShowS
showsPrec = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> EndPoint a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance Show1 EndPoint where
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> EndPoint a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_sl Int
d (Open a
a)   = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
"Open" Int
d a
a
  liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_sl Int
d (Closed a
a) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
"Closed" Int
d a
a

instance (Read a) => Read (EndPoint a) where
  readPrec :: ReadPrec (EndPoint a)
readPrec     = ReadPrec a -> ReadPrec [a] -> ReadPrec (EndPoint a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
forall a. Read a => ReadPrec [a]
readListPrec
  readListPrec :: ReadPrec [EndPoint a]
readListPrec = ReadPrec [EndPoint a]
forall a. Read a => ReadPrec [a]
readListPrecDefault

instance Read1 EndPoint where
  liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (EndPoint a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
_rl = ReadPrec (EndPoint a) -> ReadPrec (EndPoint a)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (EndPoint a) -> ReadPrec (EndPoint a))
-> ReadPrec (EndPoint a) -> ReadPrec (EndPoint a)
forall a b. (a -> b) -> a -> b
$
      ReadPrec a -> String -> (a -> EndPoint a) -> ReadPrec (EndPoint a)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec a
rp String
"Open" a -> EndPoint a
forall a. a -> EndPoint a
Open ReadPrec (EndPoint a)
-> ReadPrec (EndPoint a) -> ReadPrec (EndPoint a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      ReadPrec a -> String -> (a -> EndPoint a) -> ReadPrec (EndPoint a)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith ReadPrec a
rp String
"Closed" a -> EndPoint a
forall a. a -> EndPoint a
Closed
  liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [EndPoint a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [EndPoint a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault


instance Ord a => Ord (EndPoint a) where
  -- | order on the actual value, and Open before Closed
  EndPoint a
a compare :: EndPoint a -> EndPoint a -> Ordering
`compare` EndPoint a
b = EndPoint a -> (a, Bool)
forall a. EndPoint a -> (a, Bool)
f EndPoint a
a (a, Bool) -> (a, Bool) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` EndPoint a -> (a, Bool)
forall a. EndPoint a -> (a, Bool)
f EndPoint a
b
    where
      f :: EndPoint a -> (a, Bool)
f (Open a
x)   = (a
x,Bool
False)
      f (Closed a
x) = (a
x,Bool
True)

instance Arbitrary r => Arbitrary (EndPoint r) where
  arbitrary :: Gen (EndPoint r)
arbitrary = [(Int, Gen (EndPoint r))] -> Gen (EndPoint r)
forall a. [(Int, Gen a)] -> Gen a
frequency [ (Int
1, r -> EndPoint r
forall a. a -> EndPoint a
Open   (r -> EndPoint r) -> Gen r -> Gen (EndPoint r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen r
forall a. Arbitrary a => Gen a
arbitrary)
                        , (Int
9, r -> EndPoint r
forall a. a -> EndPoint a
Closed (r -> EndPoint r) -> Gen r -> Gen (EndPoint r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen r
forall a. Arbitrary a => Gen a
arbitrary)
                        ]

_unEndPoint            :: EndPoint a -> a
_unEndPoint :: EndPoint a -> a
_unEndPoint (Open a
a)   = a
a
_unEndPoint (Closed a
a) = a
a

-- | Access lens for EndPoint value regardless of whether it is open or closed.
--
-- >>> Open 5 ^. unEndPoint
-- 5
-- >>> Closed 10 ^. unEndPoint
-- 10
-- >>> Open 4 & unEndPoint .~ 0
-- Open 0
unEndPoint :: Lens (EndPoint a) (EndPoint b) a b
unEndPoint :: (a -> f b) -> EndPoint a -> f (EndPoint b)
unEndPoint = (EndPoint a -> a)
-> (EndPoint a -> b -> EndPoint b)
-> Lens (EndPoint a) (EndPoint b) a b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EndPoint a -> a
forall a. EndPoint a -> a
_unEndPoint EndPoint a -> b -> EndPoint b
forall a a. EndPoint a -> a -> EndPoint a
f
  where
    f :: EndPoint a -> a -> EndPoint a
f (Open a
_) a
a   = a -> EndPoint a
forall a. a -> EndPoint a
Open a
a
    f (Closed a
_) a
a = a -> EndPoint a
forall a. a -> EndPoint a
Closed a
a
{-# INLINE unEndPoint #-}

-- | True iff EndPoint is open.
isOpen          :: EndPoint a -> Bool
isOpen :: EndPoint a -> Bool
isOpen Open{} = Bool
True
isOpen EndPoint a
_      = Bool
False

-- | True iff EndPoint is closed.
isClosed :: EndPoint a -> Bool
isClosed :: EndPoint a -> Bool
isClosed = Bool -> Bool
not (Bool -> Bool) -> (EndPoint a -> Bool) -> EndPoint a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndPoint a -> Bool
forall a. EndPoint a -> Bool
isOpen


--------------------------------------------------------------------------------
-- * The Range Data type

-- | Data type for representing ranges.
data Range a = Range { Range a -> EndPoint a
_lower :: !(EndPoint a)
                     , Range a -> EndPoint a
_upper :: !(EndPoint a)
                     }
               deriving (Range a -> Range a -> Bool
(Range a -> Range a -> Bool)
-> (Range a -> Range a -> Bool) -> Eq (Range a)
forall a. Eq a => Range a -> Range a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range a -> Range a -> Bool
$c/= :: forall a. Eq a => Range a -> Range a -> Bool
== :: Range a -> Range a -> Bool
$c== :: forall a. Eq a => Range a -> Range a -> Bool
Eq,a -> Range b -> Range a
(a -> b) -> Range a -> Range b
(forall a b. (a -> b) -> Range a -> Range b)
-> (forall a b. a -> Range b -> Range a) -> Functor Range
forall a b. a -> Range b -> Range a
forall a b. (a -> b) -> Range a -> Range b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Range b -> Range a
$c<$ :: forall a b. a -> Range b -> Range a
fmap :: (a -> b) -> Range a -> Range b
$cfmap :: forall a b. (a -> b) -> Range a -> Range b
Functor,Range a -> Bool
(a -> m) -> Range a -> m
(a -> b -> b) -> b -> Range a -> b
(forall m. Monoid m => Range m -> m)
-> (forall m a. Monoid m => (a -> m) -> Range a -> m)
-> (forall m a. Monoid m => (a -> m) -> Range a -> m)
-> (forall a b. (a -> b -> b) -> b -> Range a -> b)
-> (forall a b. (a -> b -> b) -> b -> Range a -> b)
-> (forall b a. (b -> a -> b) -> b -> Range a -> b)
-> (forall b a. (b -> a -> b) -> b -> Range a -> b)
-> (forall a. (a -> a -> a) -> Range a -> a)
-> (forall a. (a -> a -> a) -> Range a -> a)
-> (forall a. Range a -> [a])
-> (forall a. Range a -> Bool)
-> (forall a. Range a -> Int)
-> (forall a. Eq a => a -> Range a -> Bool)
-> (forall a. Ord a => Range a -> a)
-> (forall a. Ord a => Range a -> a)
-> (forall a. Num a => Range a -> a)
-> (forall a. Num a => Range a -> a)
-> Foldable Range
forall a. Eq a => a -> Range a -> Bool
forall a. Num a => Range a -> a
forall a. Ord a => Range a -> a
forall m. Monoid m => Range m -> m
forall a. Range a -> Bool
forall a. Range a -> Int
forall a. Range a -> [a]
forall a. (a -> a -> a) -> Range a -> a
forall m a. Monoid m => (a -> m) -> Range a -> m
forall b a. (b -> a -> b) -> b -> Range a -> b
forall a b. (a -> b -> b) -> b -> Range a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Range a -> a
$cproduct :: forall a. Num a => Range a -> a
sum :: Range a -> a
$csum :: forall a. Num a => Range a -> a
minimum :: Range a -> a
$cminimum :: forall a. Ord a => Range a -> a
maximum :: Range a -> a
$cmaximum :: forall a. Ord a => Range a -> a
elem :: a -> Range a -> Bool
$celem :: forall a. Eq a => a -> Range a -> Bool
length :: Range a -> Int
$clength :: forall a. Range a -> Int
null :: Range a -> Bool
$cnull :: forall a. Range a -> Bool
toList :: Range a -> [a]
$ctoList :: forall a. Range a -> [a]
foldl1 :: (a -> a -> a) -> Range a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Range a -> a
foldr1 :: (a -> a -> a) -> Range a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Range a -> a
foldl' :: (b -> a -> b) -> b -> Range a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Range a -> b
foldl :: (b -> a -> b) -> b -> Range a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Range a -> b
foldr' :: (a -> b -> b) -> b -> Range a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Range a -> b
foldr :: (a -> b -> b) -> b -> Range a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Range a -> b
foldMap' :: (a -> m) -> Range a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Range a -> m
foldMap :: (a -> m) -> Range a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Range a -> m
fold :: Range m -> m
$cfold :: forall m. Monoid m => Range m -> m
Foldable,Functor Range
Foldable Range
Functor Range
-> Foldable Range
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Range a -> f (Range b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Range (f a) -> f (Range a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Range a -> m (Range b))
-> (forall (m :: * -> *) a. Monad m => Range (m a) -> m (Range a))
-> Traversable Range
(a -> f b) -> Range a -> f (Range b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Range (m a) -> m (Range a)
forall (f :: * -> *) a. Applicative f => Range (f a) -> f (Range a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Range a -> m (Range b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Range a -> f (Range b)
sequence :: Range (m a) -> m (Range a)
$csequence :: forall (m :: * -> *) a. Monad m => Range (m a) -> m (Range a)
mapM :: (a -> m b) -> Range a -> m (Range b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Range a -> m (Range b)
sequenceA :: Range (f a) -> f (Range a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Range (f a) -> f (Range a)
traverse :: (a -> f b) -> Range a -> f (Range b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Range a -> f (Range b)
$cp2Traversable :: Foldable Range
$cp1Traversable :: Functor Range
Traversable,(forall x. Range a -> Rep (Range a) x)
-> (forall x. Rep (Range a) x -> Range a) -> Generic (Range a)
forall x. Rep (Range a) x -> Range a
forall x. Range a -> Rep (Range a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Range a) x -> Range a
forall a x. Range a -> Rep (Range a) x
$cto :: forall a x. Rep (Range a) x -> Range a
$cfrom :: forall a x. Range a -> Rep (Range a) x
Generic,Range a -> ()
(Range a -> ()) -> NFData (Range a)
forall a. NFData a => Range a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Range a -> ()
$crnf :: forall a. NFData a => Range a -> ()
NFData)

-- | Lens access for the lower part of a range.
lower :: Lens' (Range a) (EndPoint a)
lower :: (EndPoint a -> f (EndPoint a)) -> Range a -> f (Range a)
lower = (Range a -> EndPoint a)
-> (Range a -> EndPoint a -> Range a)
-> Lens (Range a) (Range a) (EndPoint a) (EndPoint a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Range a -> EndPoint a
forall a. Range a -> EndPoint a
_lower (\Range a
r EndPoint a
l -> Range a
r{_lower :: EndPoint a
_lower=EndPoint a
l})

-- | Lens access for the upper part of a range.
upper :: Lens' (Range a) (EndPoint a)
upper :: (EndPoint a -> f (EndPoint a)) -> Range a -> f (Range a)
upper = (Range a -> EndPoint a)
-> (Range a -> EndPoint a -> Range a)
-> Lens (Range a) (Range a) (EndPoint a) (EndPoint a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Range a -> EndPoint a
forall a. Range a -> EndPoint a
_upper (\Range a
r EndPoint a
u -> Range a
r{_upper :: EndPoint a
_upper=EndPoint a
u})

-- instance Show a => Show (Range a) where
--   show (Range l u) = printf "Range (%s) (%s)" (show l) (show u)

instance (Show a) => Show (Range a) where
  showsPrec :: Int -> Range a -> ShowS
showsPrec = (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Range a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance Show1 Range where
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Range a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (Range EndPoint a
l EndPoint a
u) =
      (Int -> EndPoint a -> ShowS)
-> (Int -> EndPoint a -> ShowS)
-> String
-> Int
-> EndPoint a
-> EndPoint a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> String -> Int -> a -> b -> ShowS
showsBinaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> EndPoint a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> EndPoint a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"Range" Int
d EndPoint a
l EndPoint a
u

instance (Read a) => Read (Range a) where
  readPrec :: ReadPrec (Range a)
readPrec     = ReadPrec a -> ReadPrec [a] -> ReadPrec (Range a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
forall a. Read a => ReadPrec [a]
readListPrec
  readListPrec :: ReadPrec [Range a]
readListPrec = ReadPrec [Range a]
forall a. Read a => ReadPrec [a]
readListPrecDefault

instance Read1 Range where
  liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Range a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl = ReadPrec (Range a) -> ReadPrec (Range a)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (Range a) -> ReadPrec (Range a))
-> ReadPrec (Range a) -> ReadPrec (Range a)
forall a b. (a -> b) -> a -> b
$
      ReadPrec (EndPoint a)
-> ReadPrec (EndPoint a)
-> String
-> (EndPoint a -> EndPoint a -> Range a)
-> ReadPrec (Range a)
forall a b t.
ReadPrec a -> ReadPrec b -> String -> (a -> b -> t) -> ReadPrec t
readBinaryWith (ReadPrec a -> ReadPrec [a] -> ReadPrec (EndPoint a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl) (ReadPrec a -> ReadPrec [a] -> ReadPrec (EndPoint a)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl) String
"Range" EndPoint a -> EndPoint a -> Range a
forall a. EndPoint a -> EndPoint a -> Range a
Range
  liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [Range a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Range a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault


pattern OpenRange       :: a -> a -> Range a
pattern $bOpenRange :: a -> a -> Range a
$mOpenRange :: forall r a. Range a -> (a -> a -> r) -> (Void# -> r) -> r
OpenRange   l u = Range (Open l)   (Open u)

pattern ClosedRange     :: a -> a -> Range a
pattern $bClosedRange :: a -> a -> Range a
$mClosedRange :: forall r a. Range a -> (a -> a -> r) -> (Void# -> r) -> r
ClosedRange l u = Range (Closed l) (Closed u)

-- | A range from l to u, ignoring/forgetting the type of the endpoints
pattern Range'     :: a -> a -> Range a
pattern $mRange' :: forall r a. Range a -> (a -> a -> r) -> (Void# -> r) -> r
Range' l u <- ((\r -> (r^.lower.unEndPoint,r^.upper.unEndPoint) -> (l,u)))
{-# COMPLETE Range' #-}

instance (Arbitrary r, Ord r) => Arbitrary (Range r) where
  arbitrary :: Gen (Range r)
arbitrary = do
                EndPoint r
l <- Gen (EndPoint r)
forall a. Arbitrary a => Gen a
arbitrary
                EndPoint r
r <- Gen (EndPoint r) -> (EndPoint r -> Bool) -> Gen (EndPoint r)
forall a. Gen a -> (a -> Bool) -> Gen a
suchThat Gen (EndPoint r)
forall a. Arbitrary a => Gen a
arbitrary (EndPoint r -> EndPoint r -> Bool
forall a. Ord a => EndPoint a -> EndPoint a -> Bool
p EndPoint r
l)
                Range r -> Gen (Range r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Range r -> Gen (Range r)) -> Range r -> Gen (Range r)
forall a b. (a -> b) -> a -> b
$ EndPoint r -> EndPoint r -> Range r
forall a. EndPoint a -> EndPoint a -> Range a
Range EndPoint r
l EndPoint r
r
   where
     p :: EndPoint a -> EndPoint a -> Bool
p (Open a
l)   EndPoint a
r = a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<  EndPoint a
rEndPoint a -> Getting a (EndPoint a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (EndPoint a) a
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint
     p (Closed a
l) EndPoint a
r = a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= EndPoint a
rEndPoint a -> Getting a (EndPoint a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (EndPoint a) a
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint


-- | Helper function to show a range in mathematical notation.
--
-- >>> prettyShow $ OpenRange 0 2
-- "(0,2)"
-- >>> prettyShow $ ClosedRange 0 2
-- "[0,2]"
-- >>> prettyShow $ Range (Open 0) (Closed 5)
-- "(0,5]"
prettyShow             :: Show a => Range a -> String
prettyShow :: Range a -> String
prettyShow (Range EndPoint a
l EndPoint a
u) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
lowerB, a -> String
forall a. Show a => a -> String
show (EndPoint a
lEndPoint a -> Getting a (EndPoint a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (EndPoint a) a
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint), String
","
                                , a -> String
forall a. Show a => a -> String
show (EndPoint a
uEndPoint a -> Getting a (EndPoint a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (EndPoint a) a
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint), String
upperB
                                ]
  where
    lowerB :: String
lowerB = if EndPoint a -> Bool
forall a. EndPoint a -> Bool
isOpen EndPoint a
l then String
"(" else String
"["
    upperB :: String
upperB = if EndPoint a -> Bool
forall a. EndPoint a -> Bool
isOpen EndPoint a
u then String
")" else String
"]"



-- | Test if a value lies in a range.
--
-- >>> 1 `inRange` (OpenRange 0 2)
-- True
-- >>> 1 `inRange` (OpenRange 0 1)
-- False
-- >>> 1 `inRange` (ClosedRange 0 1)
-- True
-- >>> 1 `inRange` (ClosedRange 1 1)
-- True
-- >>> 10 `inRange` (OpenRange 1 10)
-- False
-- >>> 10 `inRange` (ClosedRange 0 1)
-- False
--
-- This one is kind of weird
--
-- >>> 0 `inRange` Range (Closed 0) (Open 0)
-- False
inRange                 :: Ord a => a -> Range a -> Bool
a
x inRange :: a -> Range a -> Bool
`inRange` (Range EndPoint a
l EndPoint a
u) = case ((EndPoint a
lEndPoint a -> Getting a (EndPoint a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (EndPoint a) a
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint) a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
x, a
x a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (EndPoint a
uEndPoint a -> Getting a (EndPoint a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (EndPoint a) a
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint)) of
    (Ordering
_, Ordering
GT) -> Bool
False
    (Ordering
GT, Ordering
_) -> Bool
False
    (Ordering
LT,Ordering
LT) -> Bool
True
    (Ordering
LT,Ordering
EQ) -> EndPoint a -> Bool
forall a. EndPoint a -> Bool
include EndPoint a
u -- depends on only u
    (Ordering
EQ,Ordering
LT) -> EndPoint a -> Bool
forall a. EndPoint a -> Bool
include EndPoint a
l -- depends on only l
    (Ordering
EQ,Ordering
EQ) -> EndPoint a -> Bool
forall a. EndPoint a -> Bool
include EndPoint a
l Bool -> Bool -> Bool
&& EndPoint a -> Bool
forall a. EndPoint a -> Bool
include EndPoint a
u -- depends on l and u
  where
    include :: EndPoint a -> Bool
include = EndPoint a -> Bool
forall a. EndPoint a -> Bool
isClosed

type instance IntersectionOf (Range a) (Range a) = [ NoIntersection, Range a]

instance Ord a => Range a `IsIntersectableWith` Range a where

  nonEmptyIntersection :: proxy (Range a)
-> proxy (Range a) -> Intersection (Range a) (Range a) -> Bool
nonEmptyIntersection = proxy (Range a)
-> proxy (Range a) -> Intersection (Range a) (Range a) -> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection

  -- The intersection is empty, if after clipping, the order of the end points is inverted
  -- or if the endpoints are the same, but both are open.
  (Range EndPoint a
l EndPoint a
u) intersect :: Range a -> Range a -> Intersection (Range a) (Range a)
`intersect` Range a
s = let i :: Range a
i = EndPoint a -> Range a -> Range a
forall a. Ord a => EndPoint a -> Range a -> Range a
clipLower' EndPoint a
l (Range a -> Range a) -> (Range a -> Range a) -> Range a -> Range a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndPoint a -> Range a -> Range a
forall a. Ord a => EndPoint a -> Range a -> Range a
clipUpper' EndPoint a
u (Range a -> Range a) -> Range a -> Range a
forall a b. (a -> b) -> a -> b
$ Range a
s
                              in if Range a -> Bool
forall a. Ord a => Range a -> Bool
isValid Range a
i then Range a -> CoRec Identity '[NoIntersection, Range a]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Range a
i else NoIntersection -> CoRec Identity '[NoIntersection, Range a]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection

-- | Get the width of the interval
--
-- >>> width $ ClosedRange 1 10
-- 9
-- >>> width $ OpenRange 5 10
-- 5
width   :: Num r => Range r -> r
width :: Range r -> r
width Range r
i = Range r
iRange r -> Getting r (Range r) r -> r
forall s a. s -> Getting a s a -> a
^.(EndPoint r -> Const r (EndPoint r))
-> Range r -> Const r (Range r)
forall a. Lens' (Range a) (EndPoint a)
upper((EndPoint r -> Const r (EndPoint r))
 -> Range r -> Const r (Range r))
-> ((r -> Const r r) -> EndPoint r -> Const r (EndPoint r))
-> Getting r (Range r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> EndPoint r -> Const r (EndPoint r)
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint r -> r -> r
forall a. Num a => a -> a -> a
- Range r
iRange r -> Getting r (Range r) r -> r
forall s a. s -> Getting a s a -> a
^.(EndPoint r -> Const r (EndPoint r))
-> Range r -> Const r (Range r)
forall a. Lens' (Range a) (EndPoint a)
lower((EndPoint r -> Const r (EndPoint r))
 -> Range r -> Const r (Range r))
-> ((r -> Const r r) -> EndPoint r -> Const r (EndPoint r))
-> Getting r (Range r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> EndPoint r -> Const r (EndPoint r)
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint

-- | Compute the halfway point between the start and end of a range.
midPoint   :: Fractional r => Range r -> r
midPoint :: Range r -> r
midPoint Range r
r = let w :: r
w = Range r -> r
forall a. Num a => Range a -> a
width Range r
r in Range r
rRange r -> Getting r (Range r) r -> r
forall s a. s -> Getting a s a -> a
^.(EndPoint r -> Const r (EndPoint r))
-> Range r -> Const r (Range r)
forall a. Lens' (Range a) (EndPoint a)
lower((EndPoint r -> Const r (EndPoint r))
 -> Range r -> Const r (Range r))
-> ((r -> Const r r) -> EndPoint r -> Const r (EndPoint r))
-> Getting r (Range r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> EndPoint r -> Const r (EndPoint r)
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint r -> r -> r
forall a. Num a => a -> a -> a
+ (r
w r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
2)

-- | Clamps a value to a range. I.e. if the value lies outside the range we
-- report the closest value "in the range". Note that if an endpoint of the
-- range is open we report that value anyway, so we return a value that is
-- truely inside the range only if that side of the range is closed.
--
-- >>> clampTo (ClosedRange 0 10) 20
-- 10
-- >>> clampTo (ClosedRange 0 10) (-20)
-- 0
-- >>> clampTo (ClosedRange 0 10) 5
-- 5
-- >>> clampTo (OpenRange 0 10) 20
-- 10
-- >>> clampTo (OpenRange 0 10) (-20)
-- 0
-- >>> clampTo (OpenRange 0 10) 5
-- 5
clampTo                :: Ord r => Range r -> r -> r
clampTo :: Range r -> r -> r
clampTo (Range' r
l r
u) r
x = (r
x r -> r -> r
forall a. Ord a => a -> a -> a
`max` r
l) r -> r -> r
forall a. Ord a => a -> a -> a
`min` r
u


--------------------------------------------------------------------------------
-- * Helper functions

-- | Clip the interval from below. I.e. intersect with the interval {l,infty),
-- where { is either open, (, orr closed, [.
clipLower     :: Ord a => EndPoint a -> Range a -> Maybe (Range a)
clipLower :: EndPoint a -> Range a -> Maybe (Range a)
clipLower EndPoint a
l Range a
r = let r' :: Range a
r' = EndPoint a -> Range a -> Range a
forall a. Ord a => EndPoint a -> Range a -> Range a
clipLower' EndPoint a
l Range a
r in if Range a -> Bool
forall a. Ord a => Range a -> Bool
isValid Range a
r' then Range a -> Maybe (Range a)
forall a. a -> Maybe a
Just Range a
r' else Maybe (Range a)
forall a. Maybe a
Nothing

-- | Clip the interval from above. I.e. intersect with (-\infty, u}, where } is
-- either open, ), or closed, ],
clipUpper     :: Ord a => EndPoint a -> Range a -> Maybe (Range a)
clipUpper :: EndPoint a -> Range a -> Maybe (Range a)
clipUpper EndPoint a
u Range a
r = let r' :: Range a
r' = EndPoint a -> Range a -> Range a
forall a. Ord a => EndPoint a -> Range a -> Range a
clipUpper' EndPoint a
u Range a
r in if Range a -> Bool
forall a. Ord a => Range a -> Bool
isValid Range a
r' then Range a -> Maybe (Range a)
forall a. a -> Maybe a
Just Range a
r' else Maybe (Range a)
forall a. Maybe a
Nothing

-- | Wether or not the first range completely covers the second one
covers       :: forall a. Ord a => Range a -> Range a -> Bool
Range a
x covers :: Range a -> Range a -> Bool
`covers` Range a
y = (Maybe (Range a) -> Maybe (Range a) -> Bool
forall a. Eq a => a -> a -> Bool
== Range a -> Maybe (Range a)
forall a. a -> Maybe a
Just Range a
y) (Maybe (Range a) -> Bool)
-> (CoRec Identity '[NoIntersection, Range a] -> Maybe (Range a))
-> CoRec Identity '[NoIntersection, Range a]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ts :: [*]).
NatToInt (RIndex (Range a) ts) =>
CoRec Identity ts -> Maybe (Range a)
forall t (ts :: [*]).
NatToInt (RIndex t ts) =>
CoRec Identity ts -> Maybe t
asA @(Range a) (CoRec Identity '[NoIntersection, Range a] -> Bool)
-> CoRec Identity '[NoIntersection, Range a] -> Bool
forall a b. (a -> b) -> a -> b
$ Range a
x Range a -> Range a -> Intersection (Range a) (Range a)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Range a
y


-- | Check if the range is valid and nonEmpty, i.e. if the lower endpoint is
-- indeed smaller than the right endpoint. Note that we treat empty open-ranges
-- as invalid as well.
isValid             :: Ord a => Range a -> Bool
isValid :: Range a -> Bool
isValid (Range EndPoint a
l EndPoint a
u) = case EndPoint a -> a
forall a. EndPoint a -> a
_unEndPoint EndPoint a
l a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` EndPoint a -> a
forall a. EndPoint a -> a
_unEndPoint EndPoint a
u of
                          Ordering
LT                            -> Bool
True
                          Ordering
EQ | EndPoint a -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint a
l Bool -> Bool -> Bool
|| EndPoint a -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint a
u -> Bool
True
                          Ordering
_                             -> Bool
False

-- operation is unsafe, as it may produce an invalid range (where l > u)
clipLower'                  :: Ord a => EndPoint a -> Range a -> Range a
clipLower' :: EndPoint a -> Range a -> Range a
clipLower' EndPoint a
l' r :: Range a
r@(Range EndPoint a
l EndPoint a
u) = case EndPoint a
l' EndPoint a -> EndPoint a -> Ordering
forall a. Ord a => EndPoint a -> EndPoint a -> Ordering
`cmpLower` EndPoint a
l of
                                Ordering
GT -> EndPoint a -> EndPoint a -> Range a
forall a. EndPoint a -> EndPoint a -> Range a
Range EndPoint a
l' EndPoint a
u
                                Ordering
_  -> Range a
r
-- operation is unsafe, as it may produce an invalid range (where l > u)
clipUpper'                  :: Ord a => EndPoint a -> Range a -> Range a
clipUpper' :: EndPoint a -> Range a -> Range a
clipUpper' EndPoint a
u' r :: Range a
r@(Range EndPoint a
l EndPoint a
u) = case EndPoint a
u' EndPoint a -> EndPoint a -> Ordering
forall a. Ord a => EndPoint a -> EndPoint a -> Ordering
`cmpUpper` EndPoint a
u of
                                Ordering
LT -> EndPoint a -> EndPoint a -> Range a
forall a. EndPoint a -> EndPoint a -> Range a
Range EndPoint a
l EndPoint a
u'
                                Ordering
_  -> Range a
r

-- | Compare end points, Closed < Open
cmpLower     :: Ord a => EndPoint a -> EndPoint a -> Ordering
cmpLower :: EndPoint a -> EndPoint a -> Ordering
cmpLower EndPoint a
a EndPoint a
b = case EndPoint a -> a
forall a. EndPoint a -> a
_unEndPoint EndPoint a
a a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` EndPoint a -> a
forall a. EndPoint a -> a
_unEndPoint EndPoint a
b of
                 Ordering
LT -> Ordering
LT
                 Ordering
GT -> Ordering
GT
                 Ordering
EQ -> case (EndPoint a
a,EndPoint a
b) of
                         (Open a
_,   Open a
_)   -> Ordering
EQ  -- if both are same type, report EQ
                         (Closed a
_, Closed a
_) -> Ordering
EQ
                         (Open a
_,  EndPoint a
_)         -> Ordering
GT  -- otherwise, choose the Closed one
                         (Closed a
_,EndPoint a
_)         -> Ordering
LT  -- is the *smallest*


-- | Compare the end points, Open < Closed
cmpUpper     :: Ord a => EndPoint a -> EndPoint a -> Ordering
cmpUpper :: EndPoint a -> EndPoint a -> Ordering
cmpUpper EndPoint a
a EndPoint a
b = case EndPoint a -> a
forall a. EndPoint a -> a
_unEndPoint EndPoint a
a a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` EndPoint a -> a
forall a. EndPoint a -> a
_unEndPoint EndPoint a
b of
                 Ordering
LT -> Ordering
LT
                 Ordering
GT -> Ordering
GT
                 Ordering
EQ -> case (EndPoint a
a,EndPoint a
b) of
                         (Open a
_,   Open a
_)   -> Ordering
EQ  -- if both are same type, report EQ
                         (Closed a
_, Closed a
_) -> Ordering
EQ
                         (Open a
_,  EndPoint a
_)         -> Ordering
LT  -- otherwise, choose the Closed one
                         (Closed a
_,EndPoint a
_)         -> Ordering
GT  -- is the *largest*




--------------------------------------------------------------------------------

-- | Shift a range x units to the left
--
-- >>> prettyShow $ shiftLeft 10 (ClosedRange 10 20)
-- "[0,10]"
-- >>> prettyShow $ shiftLeft 10 (OpenRange 15 25)
-- "(5,15)"
shiftLeft   :: Num r => r -> Range r -> Range r
shiftLeft :: r -> Range r -> Range r
shiftLeft r
x = r -> Range r -> Range r
forall r. Num r => r -> Range r -> Range r
shiftRight (-r
x)

-- | Shifts the range to the right
--
-- >>> prettyShow $ shiftRight 10 (ClosedRange 10 20)
-- "[20,30]"
-- >>> prettyShow $ shiftRight 10 (OpenRange 15 25)
-- "(25,35)"
shiftRight   :: Num r => r -> Range r -> Range r
shiftRight :: r -> Range r -> Range r
shiftRight r
x = (r -> r) -> Range r -> Range r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (r -> r -> r
forall a. Num a => a -> a -> a
+r
x)