{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, LambdaCase, ScopedTypeVariables #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE RoleAnnotations #-}

module Data.Interval.Internal
  ( Boundary(..)
  , Interval
  , lowerBound'
  , upperBound'
  , interval
  , empty
  ) where

import Control.DeepSeq
import Data.Data
import Data.ExtendedReal
import Data.Hashable
import Data.Int
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import GHC.Generics (Generic)

-- | Boundary of an interval may be
-- open (excluding an endpoint) or closed (including an endpoint).
--
-- @since 2.0.0
data Boundary
  = Open
  | Closed
  deriving (Boundary -> Boundary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Boundary -> Boundary -> Bool
$c/= :: Boundary -> Boundary -> Bool
== :: Boundary -> Boundary -> Bool
$c== :: Boundary -> Boundary -> Bool
Eq, Eq Boundary
Boundary -> Boundary -> Bool
Boundary -> Boundary -> Ordering
Boundary -> Boundary -> Boundary
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Boundary -> Boundary -> Boundary
$cmin :: Boundary -> Boundary -> Boundary
max :: Boundary -> Boundary -> Boundary
$cmax :: Boundary -> Boundary -> Boundary
>= :: Boundary -> Boundary -> Bool
$c>= :: Boundary -> Boundary -> Bool
> :: Boundary -> Boundary -> Bool
$c> :: Boundary -> Boundary -> Bool
<= :: Boundary -> Boundary -> Bool
$c<= :: Boundary -> Boundary -> Bool
< :: Boundary -> Boundary -> Bool
$c< :: Boundary -> Boundary -> Bool
compare :: Boundary -> Boundary -> Ordering
$ccompare :: Boundary -> Boundary -> Ordering
Ord, Int -> Boundary
Boundary -> Int
Boundary -> [Boundary]
Boundary -> Boundary
Boundary -> Boundary -> [Boundary]
Boundary -> Boundary -> Boundary -> [Boundary]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Boundary -> Boundary -> Boundary -> [Boundary]
$cenumFromThenTo :: Boundary -> Boundary -> Boundary -> [Boundary]
enumFromTo :: Boundary -> Boundary -> [Boundary]
$cenumFromTo :: Boundary -> Boundary -> [Boundary]
enumFromThen :: Boundary -> Boundary -> [Boundary]
$cenumFromThen :: Boundary -> Boundary -> [Boundary]
enumFrom :: Boundary -> [Boundary]
$cenumFrom :: Boundary -> [Boundary]
fromEnum :: Boundary -> Int
$cfromEnum :: Boundary -> Int
toEnum :: Int -> Boundary
$ctoEnum :: Int -> Boundary
pred :: Boundary -> Boundary
$cpred :: Boundary -> Boundary
succ :: Boundary -> Boundary
$csucc :: Boundary -> Boundary
Enum, Boundary
forall a. a -> a -> Bounded a
maxBound :: Boundary
$cmaxBound :: Boundary
minBound :: Boundary
$cminBound :: Boundary
Bounded, Int -> Boundary -> ShowS
[Boundary] -> ShowS
Boundary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Boundary] -> ShowS
$cshowList :: [Boundary] -> ShowS
show :: Boundary -> String
$cshow :: Boundary -> String
showsPrec :: Int -> Boundary -> ShowS
$cshowsPrec :: Int -> Boundary -> ShowS
Show, ReadPrec [Boundary]
ReadPrec Boundary
Int -> ReadS Boundary
ReadS [Boundary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Boundary]
$creadListPrec :: ReadPrec [Boundary]
readPrec :: ReadPrec Boundary
$creadPrec :: ReadPrec Boundary
readList :: ReadS [Boundary]
$creadList :: ReadS [Boundary]
readsPrec :: Int -> ReadS Boundary
$creadsPrec :: Int -> ReadS Boundary
Read, forall x. Rep Boundary x -> Boundary
forall x. Boundary -> Rep Boundary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Boundary x -> Boundary
$cfrom :: forall x. Boundary -> Rep Boundary x
Generic, Typeable Boundary
Boundary -> DataType
Boundary -> Constr
(forall b. Data b => b -> b) -> Boundary -> Boundary
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Boundary -> u
forall u. (forall d. Data d => d -> u) -> Boundary -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Boundary -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Boundary -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Boundary -> m Boundary
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Boundary -> m Boundary
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Boundary
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Boundary -> c Boundary
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Boundary)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Boundary)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Boundary -> m Boundary
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Boundary -> m Boundary
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Boundary -> m Boundary
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Boundary -> m Boundary
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Boundary -> m Boundary
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Boundary -> m Boundary
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Boundary -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Boundary -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Boundary -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Boundary -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Boundary -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Boundary -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Boundary -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Boundary -> r
gmapT :: (forall b. Data b => b -> b) -> Boundary -> Boundary
$cgmapT :: (forall b. Data b => b -> b) -> Boundary -> Boundary
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Boundary)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Boundary)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Boundary)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Boundary)
dataTypeOf :: Boundary -> DataType
$cdataTypeOf :: Boundary -> DataType
toConstr :: Boundary -> Constr
$ctoConstr :: Boundary -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Boundary
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Boundary
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Boundary -> c Boundary
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Boundary -> c Boundary
Data, Typeable)

instance NFData Boundary

instance Hashable Boundary

-- | The intervals (/i.e./ connected and convex subsets) over a type @r@.
data Interval r
  = Whole
  | Empty
  | Point !r
  | LessThan !r
  | LessOrEqual !r
  | GreaterThan !r
  | GreaterOrEqual !r
  -- For constructors below
  -- the first argument is strictly less than the second one
  | BothClosed !r !r
  | LeftOpen !r !r
  | RightOpen !r !r
  | BothOpen !r !r
  deriving
    ( Interval r -> Interval r -> Bool
forall r. Eq r => Interval r -> Interval r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interval r -> Interval r -> Bool
$c/= :: forall r. Eq r => Interval r -> Interval r -> Bool
== :: Interval r -> Interval r -> Bool
$c== :: forall r. Eq r => Interval r -> Interval r -> Bool
Eq
    , Interval r -> Interval r -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {r}. Ord r => Eq (Interval r)
forall r. Ord r => Interval r -> Interval r -> Bool
forall r. Ord r => Interval r -> Interval r -> Ordering
forall r. Ord r => Interval r -> Interval r -> Interval r
min :: Interval r -> Interval r -> Interval r
$cmin :: forall r. Ord r => Interval r -> Interval r -> Interval r
max :: Interval r -> Interval r -> Interval r
$cmax :: forall r. Ord r => Interval r -> Interval r -> Interval r
>= :: Interval r -> Interval r -> Bool
$c>= :: forall r. Ord r => Interval r -> Interval r -> Bool
> :: Interval r -> Interval r -> Bool
$c> :: forall r. Ord r => Interval r -> Interval r -> Bool
<= :: Interval r -> Interval r -> Bool
$c<= :: forall r. Ord r => Interval r -> Interval r -> Bool
< :: Interval r -> Interval r -> Bool
$c< :: forall r. Ord r => Interval r -> Interval r -> Bool
compare :: Interval r -> Interval r -> Ordering
$ccompare :: forall r. Ord r => Interval r -> Interval r -> Ordering
Ord
      -- ^ Note that this Ord is derived and not semantically meaningful.
      -- The primary intended use case is to allow using 'Interval'
      -- in maps and sets that require ordering.
    , Typeable
    )

peekInterval :: (Applicative m, Monad m, Ord r) => m Int8 -> m r -> m r -> m (Interval r)
peekInterval :: forall (m :: * -> *) r.
(Applicative m, Monad m, Ord r) =>
m Int8 -> m r -> m r -> m (Interval r)
peekInterval m Int8
tagM m r
x m r
y = do
  Int8
tag <- m Int8
tagM
  case Int8
tag of
    Int8
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall r. Interval r
Whole
    Int8
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall r. Interval r
Empty
    Int8
2 -> forall r. r -> Interval r
Point           forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
x
    Int8
3 -> forall r. r -> Interval r
LessThan        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
x
    Int8
4 -> forall r. r -> Interval r
LessOrEqual     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
x
    Int8
5 -> forall r. r -> Interval r
GreaterThan     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
x
    Int8
6 -> forall r. r -> Interval r
GreaterOrEqual  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
x
    Int8
7 -> forall r. Ord r => (r -> r -> Interval r) -> r -> r -> Interval r
wrap forall r. r -> r -> Interval r
BothClosed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m r
y
    Int8
8 -> forall r. Ord r => (r -> r -> Interval r) -> r -> r -> Interval r
wrap forall r. r -> r -> Interval r
LeftOpen   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m r
y
    Int8
9 -> forall r. Ord r => (r -> r -> Interval r) -> r -> r -> Interval r
wrap forall r. r -> r -> Interval r
RightOpen  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m r
y
    Int8
_ -> forall r. Ord r => (r -> r -> Interval r) -> r -> r -> Interval r
wrap forall r. r -> r -> Interval r
BothOpen   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m r
y

-- | Enforce the internal invariant
-- of 'BothClosed' / 'LeftOpen' / 'RightOpen' / 'BothOpen'.
wrap :: Ord r => (r -> r -> Interval r) -> r -> r -> Interval r
wrap :: forall r. Ord r => (r -> r -> Interval r) -> r -> r -> Interval r
wrap r -> r -> Interval r
f r
x r
y
  | r
x forall a. Ord a => a -> a -> Bool
< r
y = r -> r -> Interval r
f r
x r
y
  | Bool
otherwise = forall r. Interval r
Empty

pokeInterval :: Applicative m => (Int8 -> m ()) -> (r -> m ()) -> (r -> m ()) -> Interval r -> m ()
pokeInterval :: forall (m :: * -> *) r.
Applicative m =>
(Int8 -> m ()) -> (r -> m ()) -> (r -> m ()) -> Interval r -> m ()
pokeInterval Int8 -> m ()
tag r -> m ()
actX r -> m ()
actY = \case
  Interval r
Whole            -> Int8 -> m ()
tag (Int8
0 :: Int8)
  Interval r
Empty            -> Int8 -> m ()
tag (Int8
1 :: Int8)
  Point          r
x -> Int8 -> m ()
tag (Int8
2 :: Int8) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x
  LessThan       r
x -> Int8 -> m ()
tag (Int8
3 :: Int8) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x
  LessOrEqual    r
x -> Int8 -> m ()
tag (Int8
4 :: Int8) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x
  GreaterThan    r
x -> Int8 -> m ()
tag (Int8
5 :: Int8) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x
  GreaterOrEqual r
x -> Int8 -> m ()
tag (Int8
6 :: Int8) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x
  BothClosed   r
x r
y -> Int8 -> m ()
tag (Int8
7 :: Int8) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actY r
y
  LeftOpen     r
x r
y -> Int8 -> m ()
tag (Int8
8 :: Int8) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actY r
y
  RightOpen    r
x r
y -> Int8 -> m ()
tag (Int8
9 :: Int8) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actY r
y
  BothOpen     r
x r
y -> Int8 -> m ()
tag (Int8
10 :: Int8) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actY r
y

instance (Storable r, Ord r) => Storable (Interval r) where
  sizeOf :: Interval r -> Int
sizeOf Interval r
_ = Int
3 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: r)
  alignment :: Interval r -> Int
alignment Interval r
_ = forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: r)
  peek :: Ptr (Interval r) -> IO (Interval r)
peek Ptr (Interval r)
ptr = forall (m :: * -> *) r.
(Applicative m, Monad m, Ord r) =>
m Int8 -> m r -> m r -> m (Interval r)
peekInterval
    (forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr)
    (forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1)
    (forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
2)
  poke :: Ptr (Interval r) -> Interval r -> IO ()
poke Ptr (Interval r)
ptr = forall (m :: * -> *) r.
Applicative m =>
(Int8 -> m ()) -> (r -> m ()) -> (r -> m ()) -> Interval r -> m ()
pokeInterval
    (forall a. Storable a => Ptr a -> a -> IO ()
poke forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr)
    (forall a. Storable a => Ptr a -> a -> IO ()
poke forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1)
    (forall a. Storable a => Ptr a -> a -> IO ()
poke forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
2)

-- | Lower endpoint (/i.e./ greatest lower bound) of the interval,
-- together with 'Boundary' information.
-- The result is convenient to use as an argument for 'interval'.
lowerBound' :: Interval r -> (Extended r, Boundary)
lowerBound' :: forall r. Interval r -> (Extended r, Boundary)
lowerBound' = \case
  Interval r
Whole            -> (forall r. Extended r
NegInf,   Boundary
Open)
  Interval r
Empty            -> (forall r. Extended r
PosInf,   Boundary
Open)
  Point r
r          -> (forall r. r -> Extended r
Finite r
r, Boundary
Closed)
  LessThan{}       -> (forall r. Extended r
NegInf,   Boundary
Open)
  LessOrEqual{}    -> (forall r. Extended r
NegInf,   Boundary
Open)
  GreaterThan r
r    -> (forall r. r -> Extended r
Finite r
r, Boundary
Open)
  GreaterOrEqual r
r -> (forall r. r -> Extended r
Finite r
r, Boundary
Closed)
  BothClosed r
p r
_   -> (forall r. r -> Extended r
Finite r
p, Boundary
Closed)
  LeftOpen r
p r
_     -> (forall r. r -> Extended r
Finite r
p, Boundary
Open)
  RightOpen r
p r
_    -> (forall r. r -> Extended r
Finite r
p, Boundary
Closed)
  BothOpen r
p r
_     -> (forall r. r -> Extended r
Finite r
p, Boundary
Open)

-- | Upper endpoint (/i.e./ least upper bound) of the interval,
-- together with 'Boundary' information.
-- The result is convenient to use as an argument for 'interval'.
upperBound' :: Interval r -> (Extended r, Boundary)
upperBound' :: forall r. Interval r -> (Extended r, Boundary)
upperBound' = \case
  Interval r
Whole            -> (forall r. Extended r
PosInf,   Boundary
Open)
  Interval r
Empty            -> (forall r. Extended r
NegInf,   Boundary
Open)
  Point r
r          -> (forall r. r -> Extended r
Finite r
r, Boundary
Closed)
  LessThan r
r       -> (forall r. r -> Extended r
Finite r
r, Boundary
Open)
  LessOrEqual r
r    -> (forall r. r -> Extended r
Finite r
r, Boundary
Closed)
  GreaterThan{}    -> (forall r. Extended r
PosInf,   Boundary
Open)
  GreaterOrEqual{} -> (forall r. Extended r
PosInf,   Boundary
Open)
  BothClosed r
_ r
q   -> (forall r. r -> Extended r
Finite r
q, Boundary
Closed)
  LeftOpen r
_ r
q     -> (forall r. r -> Extended r
Finite r
q, Boundary
Closed)
  RightOpen r
_ r
q    -> (forall r. r -> Extended r
Finite r
q, Boundary
Open)
  BothOpen r
_ r
q     -> (forall r. r -> Extended r
Finite r
q, Boundary
Open)

type role Interval nominal

instance (Ord r, Data r) => Data (Interval r) where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Interval r -> c (Interval r)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z Interval r
x   = forall g. g -> c g
z forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
interval forall d b. Data d => c (d -> b) -> d -> c b
`k` forall r. Interval r -> (Extended r, Boundary)
lowerBound' Interval r
x forall d b. Data d => c (d -> b) -> d -> c b
`k` forall r. Interval r -> (Extended r, Boundary)
upperBound' Interval r
x
  toConstr :: Interval r -> Constr
toConstr Interval r
_     = Constr
intervalConstr
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Interval r)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
interval))
    Int
_ -> forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: Interval r -> DataType
dataTypeOf Interval r
_   = DataType
intervalDataType
  dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Interval r))
dataCast1 forall d. Data d => c (t d)
f    = forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 forall d. Data d => c (t d)
f

intervalConstr :: Constr
intervalConstr :: Constr
intervalConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
intervalDataType String
"interval" [] Fixity
Prefix

intervalDataType :: DataType
intervalDataType :: DataType
intervalDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Interval.Internal.Interval" [Constr
intervalConstr]

instance NFData r => NFData (Interval r) where
  rnf :: Interval r -> ()
rnf = \case
    Interval r
Whole            -> ()
    Interval r
Empty            -> ()
    Point r
r          -> forall a. NFData a => a -> ()
rnf r
r
    LessThan r
r       -> forall a. NFData a => a -> ()
rnf r
r
    LessOrEqual r
r    -> forall a. NFData a => a -> ()
rnf r
r
    GreaterThan r
r    -> forall a. NFData a => a -> ()
rnf r
r
    GreaterOrEqual r
r -> forall a. NFData a => a -> ()
rnf r
r
    BothClosed r
p r
q   -> forall a. NFData a => a -> ()
rnf r
p seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf r
q
    LeftOpen r
p r
q     -> forall a. NFData a => a -> ()
rnf r
p seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf r
q
    RightOpen r
p r
q    -> forall a. NFData a => a -> ()
rnf r
p seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf r
q
    BothOpen r
p r
q     -> forall a. NFData a => a -> ()
rnf r
p seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf r
q

instance Hashable r => Hashable (Interval r) where
  hashWithSalt :: Int -> Interval r -> Int
hashWithSalt Int
s = \case
    Interval r
Whole            -> Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
1 :: Int)
    Interval r
Empty            -> Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
2 :: Int)
    Point r
r          -> Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
3 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
r
    LessThan r
r       -> Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
4 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
r
    LessOrEqual r
r    -> Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
5 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
r
    GreaterThan r
r    -> Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
6 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
r
    GreaterOrEqual r
r -> Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
7 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
r
    BothClosed r
p r
q   -> Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
8 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
p forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
q
    LeftOpen r
p r
q     -> Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
9 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
p forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
q
    RightOpen r
p r
q    -> Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
10 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
p forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
q
    BothOpen r
p r
q     -> Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
11 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
p forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
q

-- | empty (contradicting) interval
empty :: Ord r => Interval r
empty :: forall r. Ord r => Interval r
empty = forall r. Interval r
Empty

-- | smart constructor for 'Interval'
interval
  :: (Ord r)
  => (Extended r, Boundary) -- ^ lower bound and whether it is included
  -> (Extended r, Boundary) -- ^ upper bound and whether it is included
  -> Interval r
interval :: forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
interval = \case
  (Extended r
NegInf, Boundary
_) -> \case
    (Extended r
NegInf, Boundary
_) -> forall r. Interval r
Empty
    (Finite r
r, Boundary
Open) -> forall r. r -> Interval r
LessThan r
r
    (Finite r
r, Boundary
Closed) -> forall r. r -> Interval r
LessOrEqual r
r
    (Extended r
PosInf, Boundary
_) -> forall r. Interval r
Whole
  (Finite r
p, Boundary
Open) -> \case
    (Extended r
NegInf, Boundary
_) -> forall r. Interval r
Empty
    (Finite r
q, Boundary
Open)
      | r
p forall a. Ord a => a -> a -> Bool
< r
q -> forall r. r -> r -> Interval r
BothOpen r
p r
q
      | Bool
otherwise -> forall r. Interval r
Empty
    (Finite r
q, Boundary
Closed)
      | r
p forall a. Ord a => a -> a -> Bool
< r
q -> forall r. r -> r -> Interval r
LeftOpen r
p r
q
      | Bool
otherwise -> forall r. Interval r
Empty
    (Extended r
PosInf, Boundary
_) -> forall r. r -> Interval r
GreaterThan r
p
  (Finite r
p, Boundary
Closed) -> \case
    (Extended r
NegInf, Boundary
_) -> forall r. Interval r
Empty
    (Finite r
q, Boundary
Open)
      | r
p forall a. Ord a => a -> a -> Bool
< r
q -> forall r. r -> r -> Interval r
RightOpen r
p r
q
      | Bool
otherwise -> forall r. Interval r
Empty
    (Finite r
q, Boundary
Closed) -> case r
p forall a. Ord a => a -> a -> Ordering
`compare` r
q of
      Ordering
LT -> forall r. r -> r -> Interval r
BothClosed r
p r
q
      Ordering
EQ -> forall r. r -> Interval r
Point r
p
      Ordering
GT -> forall r. Interval r
Empty
    (Extended r
PosInf, Boundary
_) -> forall r. r -> Interval r
GreaterOrEqual r
p
  (Extended r
PosInf, Boundary
_) -> forall a b. a -> b -> a
const forall r. Interval r
Empty
{-# INLINE interval #-}