git.iko.soy/typeable/postgresql-simple
on master help sign in
Add containment predicate for Range and some haddocks
2e1ce34Leon P Smith
src/Database/PostgreSQL/Simple/Range.hs+39−2
compare with master
unifiedsplit
@@ -17,8 +17,8 @@ module Database.PostgreSQL.Simple.Range
17 ( RangeBound(..)
17 ( RangeBound(..)
18 , PGRange(..)
18 , PGRange(..)
19 , empty
19 , empty
20− , isEmpty
20+ , isEmpty, isEmptyBy
21− , isEmptyBy
21+ , contains, containsBy
22 ) where
22 ) where
23
23
24import Control.Applicative hiding (empty)
24import Control.Applicative hiding (empty)
@@ -83,9 +83,46 @@ isEmptyBy cmp v =
83 (PGRange (Exclusive x) (Inclusive y)) -> cmp x y /= LT
83 (PGRange (Exclusive x) (Inclusive y)) -> cmp x y /= LT
84 (PGRange (Exclusive x) (Exclusive y)) -> cmp x y /= LT
84 (PGRange (Exclusive x) (Exclusive y)) -> cmp x y /= LT
85
85
86+-- | Is a range empty? If this returns 'True', then the 'contains'
87+-- predicate will always return 'False'. However, if this returns
88+-- 'False', it is not necessarily true that there exists a point for
89+-- which 'contains' returns 'True'.
90+-- Consider @'PGRange' ('Excludes' 2) ('Excludes' 3) :: PGRange Int@,
91+-- for example.
86isEmpty :: Ord a => PGRange a -> Bool
92isEmpty :: Ord a => PGRange a -> Bool
87isEmpty = isEmptyBy compare
93isEmpty = isEmptyBy compare
88
94
95+
96+-- | Does a range contain a given point? Note that in some cases, this may
97+-- not correspond exactly with a server-side computation. Consider @UTCTime@
98+-- for example, which has a resolution of a picosecond, whereas postgresql's
99+-- @timestamptz@ types have a resolution of a microsecond. Putting such
100+-- Haskell values into the database will result in them being rounded, which
101+-- can change the value of the containment predicate.
102+
103+contains :: Ord a => PGRange a -> (a -> Bool)
104+contains = containsBy compare
105+
106+containsBy :: (a -> a -> Ordering) -> PGRange a -> (a -> Bool)
107+containsBy cmp rng x =
108+ case rng of
109+ PGRange _lb NegInfinity -> False
110+ PGRange lb ub -> checkLB lb x && checkUB ub x
111+ where
112+ checkLB lb x =
113+ case lb of
114+ NegInfinity -> True
115+ PosInfinity -> False
116+ Inclusive a -> cmp a x /= GT
117+ Exclusive a -> cmp a x == LT
118+
119+ checkUB ub x =
120+ case ub of
121+ NegInfinity -> False
122+ PosInfinity -> True
123+ Inclusive z -> cmp x z /= GT
124+ Exclusive z -> cmp x z == LT
125+
89lowerBound :: Parser (a -> RangeBound a)
126lowerBound :: Parser (a -> RangeBound a)
90lowerBound = (A.char '(' *> pure Exclusive) <|> (A.char '[' *> pure Inclusive)
127lowerBound = (A.char '(' *> pure Exclusive) <|> (A.char '[' *> pure Inclusive)
91{-# INLINE lowerBound #-}
128{-# INLINE lowerBound #-}