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

module Data.IntegerInterval.Internal
  ( IntegerInterval
  , lowerBound
  , upperBound
  , (<=..<=)
  , empty
  ) where

import Control.DeepSeq
import Data.Data
import Data.ExtendedReal
import Data.Hashable

infix 5 <=..<=

-- | The intervals (/i.e./ connected and convex subsets) over integers (__Z__).
data IntegerInterval
  = Whole
  | Empty
  | Point !Integer
  | LessOrEqual !Integer
  | GreaterOrEqual !Integer
  | BothClosed !Integer !Integer
  deriving (IntegerInterval -> IntegerInterval -> Bool
(IntegerInterval -> IntegerInterval -> Bool)
-> (IntegerInterval -> IntegerInterval -> Bool)
-> Eq IntegerInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntegerInterval -> IntegerInterval -> Bool
$c/= :: IntegerInterval -> IntegerInterval -> Bool
== :: IntegerInterval -> IntegerInterval -> Bool
$c== :: IntegerInterval -> IntegerInterval -> Bool
Eq, Typeable)

-- | Lower endpoint (/i.e./ greatest lower bound)  of the interval.
--
-- * 'lowerBound' of the empty interval is 'PosInf'.
--
-- * 'lowerBound' of a left unbounded interval is 'NegInf'.
--
-- * 'lowerBound' of an interval may or may not be a member of the interval.
lowerBound :: IntegerInterval -> Extended Integer
lowerBound :: IntegerInterval -> Extended Integer
lowerBound = \case
  IntegerInterval
Whole            -> Extended Integer
forall r. Extended r
NegInf
  IntegerInterval
Empty            -> Extended Integer
forall r. Extended r
PosInf
  Point Integer
r          -> Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
r
  LessOrEqual Integer
_    -> Extended Integer
forall r. Extended r
NegInf
  GreaterOrEqual Integer
r -> Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
r
  BothClosed Integer
p Integer
_   -> Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
p

-- | Upper endpoint (/i.e./ least upper bound) of the interval.
--
-- * 'upperBound' of the empty interval is 'NegInf'.
--
-- * 'upperBound' of a right unbounded interval is 'PosInf'.
--
-- * 'upperBound' of an interval is a member of the interval.
upperBound :: IntegerInterval -> Extended Integer
upperBound :: IntegerInterval -> Extended Integer
upperBound = \case
  IntegerInterval
Whole            -> Extended Integer
forall r. Extended r
PosInf
  IntegerInterval
Empty            -> Extended Integer
forall r. Extended r
NegInf
  Point Integer
r          -> Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
r
  LessOrEqual Integer
r    -> Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
r
  GreaterOrEqual Integer
_ -> Extended Integer
forall r. Extended r
PosInf
  BothClosed Integer
_ Integer
p   -> Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
p

-- This instance preserves data abstraction at the cost of inefficiency.
-- We provide limited reflection services for the sake of data abstraction.

instance Data IntegerInterval where
  gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntegerInterval -> c IntegerInterval
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z IntegerInterval
x   = (Extended Integer -> Extended Integer -> IntegerInterval)
-> c (Extended Integer -> Extended Integer -> IntegerInterval)
forall g. g -> c g
z Extended Integer -> Extended Integer -> IntegerInterval
(<=..<=) c (Extended Integer -> Extended Integer -> IntegerInterval)
-> Extended Integer -> c (Extended Integer -> IntegerInterval)
forall d b. Data d => c (d -> b) -> d -> c b
`k` IntegerInterval -> Extended Integer
lowerBound IntegerInterval
x c (Extended Integer -> IntegerInterval)
-> Extended Integer -> c IntegerInterval
forall d b. Data d => c (d -> b) -> d -> c b
`k` IntegerInterval -> Extended Integer
upperBound IntegerInterval
x
  toConstr :: IntegerInterval -> Constr
toConstr IntegerInterval
_     = Constr
intervalConstr
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntegerInterval
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 Integer -> IntegerInterval) -> c IntegerInterval
forall b r. Data b => c (b -> r) -> c r
k (c (Extended Integer -> Extended Integer -> IntegerInterval)
-> c (Extended Integer -> IntegerInterval)
forall b r. Data b => c (b -> r) -> c r
k ((Extended Integer -> Extended Integer -> IntegerInterval)
-> c (Extended Integer -> Extended Integer -> IntegerInterval)
forall r. r -> c r
z Extended Integer -> Extended Integer -> IntegerInterval
(<=..<=)))
    Int
_ -> [Char] -> c IntegerInterval
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
  dataTypeOf :: IntegerInterval -> DataType
dataTypeOf IntegerInterval
_   = DataType
intervalDataType

intervalConstr :: Constr
intervalConstr :: Constr
intervalConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
intervalDataType [Char]
"<=..<=" [] Fixity
Infix

intervalDataType :: DataType
intervalDataType :: DataType
intervalDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.IntegerInterval.Internal.IntegerInterval" [Constr
intervalConstr]

instance NFData IntegerInterval where
  rnf :: IntegerInterval -> ()
rnf = \case
    IntegerInterval
Whole            -> ()
    IntegerInterval
Empty            -> ()
    Point Integer
r          -> Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
r
    LessOrEqual Integer
r    -> Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
r
    GreaterOrEqual Integer
r -> Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
r
    BothClosed Integer
p Integer
q   -> Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
p () -> () -> ()
`seq` Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
q

instance Hashable IntegerInterval where
  hashWithSalt :: Int -> IntegerInterval -> Int
hashWithSalt Int
s = \case
    IntegerInterval
Whole            -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
1 :: Int)
    IntegerInterval
Empty            -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
2 :: Int)
    Point Integer
r          -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
3 :: Int) Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Integer
r
    LessOrEqual Integer
r    -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
4 :: Int) Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Integer
r
    GreaterOrEqual Integer
r -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
5 :: Int) Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Integer
r
    BothClosed Integer
p Integer
q   -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`  (Int
6 :: Int) Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Integer
p Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Integer
q

-- | closed interval [@l@,@u@]
(<=..<=)
  :: Extended Integer -- ^ lower bound @l@
  -> Extended Integer -- ^ upper bound @u@
  -> IntegerInterval
<=..<= :: Extended Integer -> Extended Integer -> IntegerInterval
(<=..<=) Extended Integer
PosInf Extended Integer
_ = IntegerInterval
empty
(<=..<=) Extended Integer
_ Extended Integer
NegInf = IntegerInterval
empty
(<=..<=) Extended Integer
NegInf Extended Integer
PosInf = IntegerInterval
Whole
(<=..<=) Extended Integer
NegInf (Finite Integer
ub) = Integer -> IntegerInterval
LessOrEqual Integer
ub
(<=..<=) (Finite Integer
lb) Extended Integer
PosInf = Integer -> IntegerInterval
GreaterOrEqual Integer
lb
(<=..<=) (Finite Integer
lb) (Finite Integer
ub) =
  case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
lb Integer
ub of
    Ordering
EQ -> Integer -> IntegerInterval
Point Integer
lb
    Ordering
LT -> Integer -> Integer -> IntegerInterval
BothClosed Integer
lb Integer
ub
    Ordering
GT -> IntegerInterval
Empty
{-# INLINE (<=..<=) #-}

-- | empty (contradicting) interval
empty :: IntegerInterval
empty :: IntegerInterval
empty = IntegerInterval
Empty