{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, LambdaCase, ScopedTypeVariables #-}
{-# LANGUAGE Safe #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
#endif

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

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative hiding (empty)
#endif
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
(Boundary -> Boundary -> Bool)
-> (Boundary -> Boundary -> Bool) -> Eq Boundary
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
Eq Boundary
-> (Boundary -> Boundary -> Ordering)
-> (Boundary -> Boundary -> Bool)
-> (Boundary -> Boundary -> Bool)
-> (Boundary -> Boundary -> Bool)
-> (Boundary -> Boundary -> Bool)
-> (Boundary -> Boundary -> Boundary)
-> (Boundary -> Boundary -> Boundary)
-> Ord 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
$cp1Ord :: Eq Boundary
Ord, Int -> Boundary
Boundary -> Int
Boundary -> [Boundary]
Boundary -> Boundary
Boundary -> Boundary -> [Boundary]
Boundary -> Boundary -> Boundary -> [Boundary]
(Boundary -> Boundary)
-> (Boundary -> Boundary)
-> (Int -> Boundary)
-> (Boundary -> Int)
-> (Boundary -> [Boundary])
-> (Boundary -> Boundary -> [Boundary])
-> (Boundary -> Boundary -> [Boundary])
-> (Boundary -> Boundary -> Boundary -> [Boundary])
-> Enum 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
Boundary -> Boundary -> Bounded Boundary
forall a. a -> a -> Bounded a
maxBound :: Boundary
$cmaxBound :: Boundary
minBound :: Boundary
$cminBound :: Boundary
Bounded, Int -> Boundary -> ShowS
[Boundary] -> ShowS
Boundary -> String
(Int -> Boundary -> ShowS)
-> (Boundary -> String) -> ([Boundary] -> ShowS) -> Show Boundary
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]
(Int -> ReadS Boundary)
-> ReadS [Boundary]
-> ReadPrec Boundary
-> ReadPrec [Boundary]
-> Read 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. Boundary -> Rep Boundary x)
-> (forall x. Rep Boundary x -> Boundary) -> Generic Boundary
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
DataType
Constr
Typeable Boundary
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Boundary -> c Boundary)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Boundary)
-> (Boundary -> Constr)
-> (Boundary -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Boundary -> Boundary)
-> (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 u. (forall d. Data d => d -> u) -> Boundary -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Boundary -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Boundary -> m Boundary)
-> Data Boundary
Boundary -> DataType
Boundary -> Constr
(forall b. Data b => b -> b) -> Boundary -> Boundary
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Boundary -> c Boundary
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cClosed :: Constr
$cOpen :: Constr
$tBoundary :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Boundary -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Boundary -> u
gmapQ :: (forall d. Data d => d -> u) -> Boundary -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Boundary -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Boundary
Data, Typeable)

instance NFData Boundary

instance Hashable Boundary

-- | The intervals (/i.e./ connected and convex subsets) over real numbers __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
(Interval r -> Interval r -> Bool)
-> (Interval r -> Interval r -> Bool) -> Eq (Interval r)
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, Typeable)

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

pokeInterval :: Applicative m => (Int8 -> m ()) -> (r -> m ()) -> (r -> m ()) -> Interval r -> m ()
pokeInterval :: (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) m () -> m () -> m ()
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) m () -> m () -> m ()
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) m () -> m () -> m ()
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) m () -> m () -> m ()
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) m () -> m () -> m ()
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) m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x m () -> m () -> m ()
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) m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x m () -> m () -> m ()
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) m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x m () -> m () -> m ()
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) m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m ()
actX r
x m () -> m () -> m ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* r -> Int
forall a. Storable a => a -> Int
sizeOf (r
forall a. HasCallStack => a
undefined :: r)
  alignment :: Interval r -> Int
alignment Interval r
_ = r -> Int
forall a. Storable a => a -> Int
alignment (r
forall a. HasCallStack => a
undefined :: r)
  peek :: Ptr (Interval r) -> IO (Interval r)
peek Ptr (Interval r)
ptr = IO Int8 -> IO r -> IO r -> IO (Interval r)
forall (m :: * -> *) r.
(Applicative m, Monad m, Ord r) =>
m Int8 -> m r -> m r -> m (Interval r)
peekInterval
    (Ptr Int8 -> IO Int8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Int8 -> IO Int8) -> Ptr Int8 -> IO Int8
forall a b. (a -> b) -> a -> b
$ Ptr (Interval r) -> Ptr Int8
forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr)
    (Ptr r -> IO r
forall a. Storable a => Ptr a -> IO a
peek (Ptr r -> IO r) -> Ptr r -> IO r
forall a b. (a -> b) -> a -> b
$ Ptr (Interval r) -> Ptr r
forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr Ptr r -> Int -> Ptr r
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1)
    (Ptr r -> IO r
forall a. Storable a => Ptr a -> IO a
peek (Ptr r -> IO r) -> Ptr r -> IO r
forall a b. (a -> b) -> a -> b
$ Ptr (Interval r) -> Ptr r
forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr Ptr r -> Int -> Ptr r
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
2)
  poke :: Ptr (Interval r) -> Interval r -> IO ()
poke Ptr (Interval r)
ptr = (Int8 -> IO ())
-> (r -> IO ()) -> (r -> IO ()) -> Interval r -> IO ()
forall (m :: * -> *) r.
Applicative m =>
(Int8 -> m ()) -> (r -> m ()) -> (r -> m ()) -> Interval r -> m ()
pokeInterval
    (Ptr Int8 -> Int8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Int8 -> Int8 -> IO ()) -> Ptr Int8 -> Int8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Interval r) -> Ptr Int8
forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr)
    (Ptr r -> r -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr r -> r -> IO ()) -> Ptr r -> r -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Interval r) -> Ptr r
forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr Ptr r -> Int -> Ptr r
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1)
    (Ptr r -> r -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr r -> r -> IO ()) -> Ptr r -> r -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Interval r) -> Ptr r
forall a b. Ptr a -> Ptr b
castPtr Ptr (Interval r)
ptr Ptr r -> Int -> Ptr r
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' :: Interval r -> (Extended r, Boundary)
lowerBound' = \case
  Interval r
Whole            -> (Extended r
forall r. Extended r
NegInf,   Boundary
Open)
  Interval r
Empty            -> (Extended r
forall r. Extended r
PosInf,   Boundary
Open)
  Point r
r          -> (r -> Extended r
forall r. r -> Extended r
Finite r
r, Boundary
Closed)
  LessThan{}       -> (Extended r
forall r. Extended r
NegInf,   Boundary
Open)
  LessOrEqual{}    -> (Extended r
forall r. Extended r
NegInf,   Boundary
Open)
  GreaterThan r
r    -> (r -> Extended r
forall r. r -> Extended r
Finite r
r, Boundary
Open)
  GreaterOrEqual r
r -> (r -> Extended r
forall r. r -> Extended r
Finite r
r, Boundary
Closed)
  BothClosed r
p r
_   -> (r -> Extended r
forall r. r -> Extended r
Finite r
p, Boundary
Closed)
  LeftOpen r
p r
_     -> (r -> Extended r
forall r. r -> Extended r
Finite r
p, Boundary
Open)
  RightOpen r
p r
_    -> (r -> Extended r
forall r. r -> Extended r
Finite r
p, Boundary
Closed)
  BothOpen r
p r
_     -> (r -> Extended 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' :: Interval r -> (Extended r, Boundary)
upperBound' = \case
  Interval r
Whole            -> (Extended r
forall r. Extended r
PosInf,   Boundary
Open)
  Interval r
Empty            -> (Extended r
forall r. Extended r
NegInf,   Boundary
Open)
  Point r
r          -> (r -> Extended r
forall r. r -> Extended r
Finite r
r, Boundary
Closed)
  LessThan r
r       -> (r -> Extended r
forall r. r -> Extended r
Finite r
r, Boundary
Open)
  LessOrEqual r
r    -> (r -> Extended r
forall r. r -> Extended r
Finite r
r, Boundary
Closed)
  GreaterThan{}    -> (Extended r
forall r. Extended r
PosInf,   Boundary
Open)
  GreaterOrEqual{} -> (Extended r
forall r. Extended r
PosInf,   Boundary
Open)
  BothClosed r
_ r
q   -> (r -> Extended r
forall r. r -> Extended r
Finite r
q, Boundary
Closed)
  LeftOpen r
_ r
q     -> (r -> Extended r
forall r. r -> Extended r
Finite r
q, Boundary
Closed)
  RightOpen r
_ r
q    -> (r -> Extended r
forall r. r -> Extended r
Finite r
q, Boundary
Open)
  BothOpen r
_ r
q     -> (r -> Extended r
forall r. r -> Extended r
Finite r
q, Boundary
Open)

#if __GLASGOW_HASKELL__ >= 708
type role Interval nominal
#endif

instance (Ord r, Data r) => Data (Interval r) where
  gfoldl :: (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   = ((Extended r, Boundary) -> (Extended r, Boundary) -> Interval r)
-> c ((Extended r, Boundary)
      -> (Extended r, Boundary) -> Interval r)
forall g. g -> c g
z (Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
interval c ((Extended r, Boundary) -> (Extended r, Boundary) -> Interval r)
-> (Extended r, Boundary)
-> c ((Extended r, Boundary) -> Interval r)
forall d b. Data d => c (d -> b) -> d -> c b
`k` Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
lowerBound' Interval r
x c ((Extended r, Boundary) -> Interval r)
-> (Extended r, Boundary) -> c (Interval r)
forall d b. Data d => c (d -> b) -> d -> c b
`k` Interval r -> (Extended r, Boundary)
forall r. Interval r -> (Extended r, Boundary)
upperBound' Interval r
x
  toConstr :: Interval r -> Constr
toConstr Interval r
_     = Constr
intervalConstr
  gunfold :: (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 -> c ((Extended r, Boundary) -> Interval r) -> c (Interval r)
forall b r. Data b => c (b -> r) -> c r
k (c ((Extended r, Boundary) -> (Extended r, Boundary) -> Interval r)
-> c ((Extended r, Boundary) -> Interval r)
forall b r. Data b => c (b -> r) -> c r
k (((Extended r, Boundary) -> (Extended r, Boundary) -> Interval r)
-> c ((Extended r, Boundary)
      -> (Extended r, Boundary) -> Interval r)
forall r. r -> c r
z (Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
interval))
    Int
_ -> String -> c (Interval r)
forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: Interval r -> DataType
dataTypeOf Interval r
_   = DataType
intervalDataType
  dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Interval r))
dataCast1 forall d. Data d => c (t d)
f    = c (t r) -> Maybe (c (Interval r))
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 c (t r)
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          -> r -> ()
forall a. NFData a => a -> ()
rnf r
r
    LessThan r
r       -> r -> ()
forall a. NFData a => a -> ()
rnf r
r
    LessOrEqual r
r    -> r -> ()
forall a. NFData a => a -> ()
rnf r
r
    GreaterThan r
r    -> r -> ()
forall a. NFData a => a -> ()
rnf r
r
    GreaterOrEqual r
r -> r -> ()
forall a. NFData a => a -> ()
rnf r
r
    BothClosed r
p r
q   -> r -> ()
forall a. NFData a => a -> ()
rnf r
p () -> () -> ()
`seq` r -> ()
forall a. NFData a => a -> ()
rnf r
q
    LeftOpen r
p r
q     -> r -> ()
forall a. NFData a => a -> ()
rnf r
p () -> () -> ()
`seq` r -> ()
forall a. NFData a => a -> ()
rnf r
q
    RightOpen r
p r
q    -> r -> ()
forall a. NFData a => a -> ()
rnf r
p () -> () -> ()
`seq` r -> ()
forall a. NFData a => a -> ()
rnf r
q
    BothOpen r
p r
q     -> r -> ()
forall a. NFData a => a -> ()
rnf r
p () -> () -> ()
`seq` r -> ()
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 Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
1 :: Int)
    Interval r
Empty            -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
2 :: Int)
    Point r
r          -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
3 :: Int) Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
r
    LessThan r
r       -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
4 :: Int) Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
r
    LessOrEqual r
r    -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
5 :: Int) Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
r
    GreaterThan r
r    -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
6 :: Int) Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
r
    GreaterOrEqual r
r -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
7 :: Int) Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
r
    BothClosed r
p r
q   -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
8 :: Int) Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
p Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
q
    LeftOpen r
p r
q     -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
9 :: Int) Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
p Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
q
    RightOpen r
p r
q    -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
10 :: Int) Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
p Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
q
    BothOpen r
p r
q     -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
11 :: Int) Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
p Int -> r -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` r
q

-- | empty (contradicting) interval
empty :: Ord r => Interval r
empty :: Interval r
empty = Interval r
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 :: (Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
interval = \case
  (Extended r
NegInf, Boundary
_) -> \case
    (Extended r
NegInf, Boundary
_) -> Interval r
forall r. Interval r
Empty
    (Finite r
r, Boundary
Open) -> r -> Interval r
forall r. r -> Interval r
LessThan r
r
    (Finite r
r, Boundary
Closed) -> r -> Interval r
forall r. r -> Interval r
LessOrEqual r
r
    (Extended r
PosInf, Boundary
_) -> Interval r
forall r. Interval r
Whole
  (Finite r
p, Boundary
Open) -> \case
    (Extended r
NegInf, Boundary
_) -> Interval r
forall r. Interval r
Empty
    (Finite r
q, Boundary
Open)
      | r
p r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< r
q -> r -> r -> Interval r
forall r. r -> r -> Interval r
BothOpen r
p r
q
      | Bool
otherwise -> Interval r
forall r. Interval r
Empty
    (Finite r
q, Boundary
Closed)
      | r
p r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< r
q -> r -> r -> Interval r
forall r. r -> r -> Interval r
LeftOpen r
p r
q
      | Bool
otherwise -> Interval r
forall r. Interval r
Empty
    (Extended r
PosInf, Boundary
_) -> r -> Interval r
forall r. r -> Interval r
GreaterThan r
p
  (Finite r
p, Boundary
Closed) -> \case
    (Extended r
NegInf, Boundary
_) -> Interval r
forall r. Interval r
Empty
    (Finite r
q, Boundary
Open)
      | r
p r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< r
q -> r -> r -> Interval r
forall r. r -> r -> Interval r
RightOpen r
p r
q
      | Bool
otherwise -> Interval r
forall r. Interval r
Empty
    (Finite r
q, Boundary
Closed) -> case r
p r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` r
q of
      Ordering
LT -> r -> r -> Interval r
forall r. r -> r -> Interval r
BothClosed r
p r
q
      Ordering
EQ -> r -> Interval r
forall r. r -> Interval r
Point r
p
      Ordering
GT -> Interval r
forall r. Interval r
Empty
    (Extended r
PosInf, Boundary
_) -> r -> Interval r
forall r. r -> Interval r
GreaterOrEqual r
p
  (Extended r
PosInf, Boundary
_) -> Interval r -> (Extended r, Boundary) -> Interval r
forall a b. a -> b -> a
const Interval r
forall r. Interval r
Empty
{-# INLINE interval #-}