{-# 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 <=..<=
data IntegerInterval
= Whole
| Empty
| Point !Integer
| LessOrEqual !Integer
| GreaterOrEqual !Integer
| BothClosed !Integer !Integer
deriving (Eq, Typeable)
lowerBound :: IntegerInterval -> Extended Integer
lowerBound = \case
Whole -> NegInf
Empty -> PosInf
Point r -> Finite r
LessOrEqual _ -> NegInf
GreaterOrEqual r -> Finite r
BothClosed p _ -> Finite p
upperBound :: IntegerInterval -> Extended Integer
upperBound = \case
Whole -> PosInf
Empty -> NegInf
Point r -> Finite r
LessOrEqual r -> Finite r
GreaterOrEqual _ -> PosInf
BothClosed _ p -> Finite p
instance Data IntegerInterval where
gfoldl k z x = z (<=..<=) `k` lowerBound x `k` upperBound x
toConstr _ = intervalConstr
gunfold k z c = case constrIndex c of
1 -> k (k (z (<=..<=)))
_ -> error "gunfold"
dataTypeOf _ = intervalDataType
intervalConstr :: Constr
intervalConstr = mkConstr intervalDataType "<=..<=" [] Infix
intervalDataType :: DataType
intervalDataType = mkDataType "Data.IntegerInterval.Internal.IntegerInterval" [intervalConstr]
instance NFData IntegerInterval where
rnf = \case
Whole -> ()
Empty -> ()
Point r -> rnf r
LessOrEqual r -> rnf r
GreaterOrEqual r -> rnf r
BothClosed p q -> rnf p `seq` rnf q
instance Hashable IntegerInterval where
hashWithSalt s = \case
Whole -> s `hashWithSalt` (1 :: Int)
Empty -> s `hashWithSalt` (2 :: Int)
Point r -> s `hashWithSalt` (3 :: Int) `hashWithSalt` r
LessOrEqual r -> s `hashWithSalt` (4 :: Int) `hashWithSalt` r
GreaterOrEqual r -> s `hashWithSalt` (5 :: Int) `hashWithSalt` r
BothClosed p q -> s `hashWithSalt` (6 :: Int) `hashWithSalt` p `hashWithSalt` q
(<=..<=)
:: Extended Integer
-> Extended Integer
-> IntegerInterval
(<=..<=) PosInf _ = empty
(<=..<=) _ NegInf = empty
(<=..<=) NegInf PosInf = Whole
(<=..<=) NegInf (Finite ub) = LessOrEqual ub
(<=..<=) (Finite lb) PosInf = GreaterOrEqual lb
(<=..<=) (Finite lb) (Finite ub) =
case compare lb ub of
EQ -> Point lb
LT -> BothClosed lb ub
GT -> Empty
{-# INLINE (<=..<=) #-}
empty :: IntegerInterval
empty = Empty