msakai / data-interval / 74

Committed 07 Jun 2025 02:12PM UTC coverage: 86.789% (-0.05%) from 86.837%

Build # 74

Build Type

push

github

Committed by

web-flow

Commit Message

Merge 0e36d5686 into 8f4ec0ead

Run Details

992 of 1143 relevant lines covered (86.79%)

0.87 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

80.85

/src/Data/IntegerInterval/Internal.hs

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

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 (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 = \case
  Whole            -> NegInf
  Empty            -> PosInf
  Point r          -> Finite r
  LessOrEqual _    -> NegInf
  GreaterOrEqual r -> Finite r
  BothClosed p _   -> Finite 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 = \case
  Whole            -> PosInf
  Empty            -> NegInf
  Point r          -> Finite r
  LessOrEqual r    -> Finite r
  GreaterOrEqual _ -> PosInf
  BothClosed _ p   -> Finite 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 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

-- | closed interval [@l@,@u@]
(<=..<=)
  :: Extended Integer -- ^ lower bound @l@
  -> Extended Integer -- ^ upper bound @u@
  -> 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 (contradicting) interval
empty :: IntegerInterval
empty = Empty

1	{-# OPTIONS_GHC -Wall #-}
2	{-# LANGUAGE DeriveDataTypeable, LambdaCase #-}
3	{-# LANGUAGE Safe #-}
4	{-# LANGUAGE RoleAnnotations #-}
5
6	module Data.IntegerInterval.Internal
7	( IntegerInterval
8	, lowerBound
9	, upperBound
10	, (<=..<=)
11	, empty
12	) where
13
14	import Control.DeepSeq
15	import Data.Data
16	import Data.ExtendedReal
17	import Data.Hashable
18
19	infix 5 <=..<=
20
21	-- \| The intervals (/i.e./ connected and convex subsets) over integers (__Z__).
22	data IntegerInterval
23	= Whole
24	\| Empty
25	\| Point !Integer
26	\| LessOrEqual !Integer
27	\| GreaterOrEqual !Integer
28	\| BothClosed !Integer !Integer
29	deriving (Eq, Typeable)	1✔
30
31	-- \| Lower endpoint (/i.e./ greatest lower bound) of the interval.
32	--
33	-- * 'lowerBound' of the empty interval is 'PosInf'.
34	--
35	-- * 'lowerBound' of a left unbounded interval is 'NegInf'.
36	--
37	-- * 'lowerBound' of an interval may or may not be a member of the interval.
38	lowerBound :: IntegerInterval -> Extended Integer
39	lowerBound = \case	1✔
40	Whole -> NegInf	1✔
41	Empty -> PosInf	1✔
42	Point r -> Finite r	1✔
43	LessOrEqual _ -> NegInf	1✔
44	GreaterOrEqual r -> Finite r	1✔
45	BothClosed p _ -> Finite p	1✔
46
47	-- \| Upper endpoint (/i.e./ least upper bound) of the interval.
48	--
49	-- * 'upperBound' of the empty interval is 'NegInf'.
50	--
51	-- * 'upperBound' of a right unbounded interval is 'PosInf'.
52	--
53	-- * 'upperBound' of an interval is a member of the interval.
54	upperBound :: IntegerInterval -> Extended Integer
55	upperBound = \case	1✔
56	Whole -> PosInf	1✔
57	Empty -> NegInf	1✔
58	Point r -> Finite r	1✔
59	LessOrEqual r -> Finite r	1✔
60	GreaterOrEqual _ -> PosInf	1✔
61	BothClosed _ p -> Finite p	1✔
62
63	-- This instance preserves data abstraction at the cost of inefficiency.
64	-- We provide limited reflection services for the sake of data abstraction.
65
66	instance Data IntegerInterval where
67	gfoldl k z x = z (<=..<=) `k` lowerBound x `k` upperBound x	1✔
68	toConstr _ = intervalConstr	×
69	gunfold k z c = case constrIndex c of	×
70	1 -> k (k (z (<=..<=)))	×
71	_ -> error "gunfold"	×
72	dataTypeOf _ = intervalDataType	×
73
74	intervalConstr :: Constr
75	intervalConstr = mkConstr intervalDataType "<=..<=" [] Infix	×
76
77	intervalDataType :: DataType
78	intervalDataType = mkDataType "Data.IntegerInterval.Internal.IntegerInterval" [intervalConstr]	×
79
80	instance NFData IntegerInterval where
81	rnf = \case	1✔
82	Whole -> ()	1✔
83	Empty -> ()	1✔
84	Point r -> rnf r	×
85	LessOrEqual r -> rnf r	1✔
86	GreaterOrEqual r -> rnf r	1✔
87	BothClosed p q -> rnf p `seq` rnf q	1✔
88
89	instance Hashable IntegerInterval where
90	hashWithSalt s = \case	1✔
91	Whole -> s `hashWithSalt` (1 :: Int)	1✔
92	Empty -> s `hashWithSalt` (2 :: Int)	1✔
93	Point r -> s `hashWithSalt` (3 :: Int) `hashWithSalt` r	×
94	LessOrEqual r -> s `hashWithSalt` (4 :: Int) `hashWithSalt` r	1✔
95	GreaterOrEqual r -> s `hashWithSalt` (5 :: Int) `hashWithSalt` r	1✔
96	BothClosed p q -> s `hashWithSalt` (6 :: Int) `hashWithSalt` p `hashWithSalt` q	1✔
97
98	-- \| closed interval [@l@,@u@]
99	(<=..<=)
100	:: Extended Integer -- ^ lower bound @l@
101	-> Extended Integer -- ^ upper bound @u@
102	-> IntegerInterval
103	(<=..<=) PosInf _ = empty	1✔
104	(<=..<=) _ NegInf = empty	1✔
105	(<=..<=) NegInf PosInf = Whole	1✔
106	(<=..<=) NegInf (Finite ub) = LessOrEqual ub	1✔
107	(<=..<=) (Finite lb) PosInf = GreaterOrEqual lb	1✔
108	(<=..<=) (Finite lb) (Finite ub) =
109	case compare lb ub of	1✔
110	EQ -> Point lb	1✔
111	LT -> BothClosed lb ub	1✔
112	GT -> Empty	1✔
113	{-# INLINE (<=..<=) #-}
114
115	-- \| empty (contradicting) interval
116	empty :: IntegerInterval
117	empty = Empty	1✔

msakai / data-interval / 74

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous