range 0.4.0.0 → 1.0.0.0
raw patch · 16 files changed
+851/−805 lines, 16 files
Files
- Bench/Range.hs +74/−43
- Data/Range.hs +7/−488
- Data/Range/Algebra.hs +31/−17
- Data/Range/Data.hs +0/−7
- Data/Range/Parser.hs +23/−18
- Data/Range/RangeInternal.hs +21/−14
- Data/Range/Util.hs +44/−15
- Data/Ranges.hs +345/−113
- Test/Generators.hs +20/−6
- Test/Range.hs +13/−7
- Test/RangeBounds.hs +123/−0
- Test/RangeLaws.hs +29/−37
- Test/RangeMerge.hs +7/−1
- Test/RangeOrd.hs +43/−19
- Test/RangeParser.hs +55/−18
- range.cabal +16/−2
Bench/Range.hs view
@@ -4,7 +4,7 @@ import Control.Exception (evaluate) import Test.Tasty.Bench -import Data.Range+import Data.Ranges import qualified Data.Range.Algebra as Alg -- ---------------------------------------------------------------------------@@ -13,28 +13,53 @@ -- | N disjoint spans: [0,1], [3,4], [6,7], ... disjointSpans :: Int -> [Range Integer]-disjointSpans n = [fromIntegral (i * 3) +=+ fromIntegral (i * 3 + 1) | i <- [0 .. n - 1]]+disjointSpans n =+ [ SpanRange (Bound (fromIntegral (i * 3)) Inclusive) (Bound (fromIntegral (i * 3 + 1)) Inclusive)+ | i <- [0 .. n - 1]+ ] -- | N fully overlapping spans all starting near 0 and ending far out overlappingSpans :: Int -> [Range Integer]-overlappingSpans n = [fromIntegral i +=+ fromIntegral (i + 1000) | i <- [0 .. n - 1]]+overlappingSpans n =+ [ SpanRange (Bound (fromIntegral i) Inclusive) (Bound (fromIntegral (i + 1000)) Inclusive)+ | i <- [0 .. n - 1]+ ] --- | A pre-merged range list (already normalised)-mergedInput :: Int -> [Range Integer]+-- | N disjoint spans offset by 500000 (no overlap with disjointSpans)+offsetSpans :: Int -> [Range Integer]+offsetSpans n =+ [ SpanRange (Bound (fromIntegral (i * 3) + 500000) Inclusive) (Bound (fromIntegral (i * 3 + 1) + 500000) Inclusive)+ | i <- [0 .. n - 1]+ ]++-- | A pre-merged Ranges (already normalised)+mergedInput :: Int -> Ranges Integer mergedInput = mergeRanges . disjointSpans +-- | A pre-merged offset Ranges (for disjoint intersection benchmarks)+offsetMerged :: Int -> Ranges Integer+offsetMerged = mergeRanges . offsetSpans++-- | Pre-merged overlapping Ranges+overlappingMerged :: Int -> Ranges Integer+overlappingMerged = mergeRanges . overlappingSpans+ -- | Equivalent enumerated list for elem comparison elemList :: Int -> [Integer] elemList n = concatMap (\i -> [fromIntegral (i * 3) .. fromIntegral (i * 3 + 1)]) [0 .. n - 1] -- | Build a left-skewed union tree of N singleton ranges via the Algebra-unionTree :: Int -> Alg.RangeExpr [Range Integer]-unionTree n = foldl1 Alg.union [Alg.const [SingletonRange (fromIntegral i)] | i <- [1 .. n :: Int]]+unionTree :: Int -> Alg.RangeExpr (Ranges Integer)+unionTree n = foldl1 Alg.union+ [ Alg.const (mergeRanges [SingletonRange (fromIntegral i)]) | i <- [1 .. n :: Int] ] -- | Build a left-skewed intersection tree of N overlapping span ranges via the Algebra-intersectionTree :: Int -> Alg.RangeExpr [Range Integer]+intersectionTree :: Int -> Alg.RangeExpr (Ranges Integer) intersectionTree n = foldl1 Alg.intersection- [Alg.const [fromIntegral (i * 2) +=+ fromIntegral (i * 2 + 100)] | i <- [1 .. n :: Int]]+ [ Alg.const (mergeRanges [ SpanRange (Bound (fromIntegral (i * 2)) Inclusive)+ (Bound (fromIntegral (i * 2 + 100)) Inclusive) ])+ | i <- [1 .. n :: Int]+ ] -- --------------------------------------------------------------------------- -- Main@@ -46,55 +71,61 @@ ds10 <- evaluate . force $ disjointSpans 10 ds100 <- evaluate . force $ disjointSpans 100 ds1000 <- evaluate . force $ disjointSpans 1000- ds10000 <- evaluate . force $ disjointSpans 10000 os10 <- evaluate . force $ overlappingSpans 10 os100 <- evaluate . force $ overlappingSpans 100 os1000 <- evaluate . force $ overlappingSpans 1000 ms10 <- evaluate . force $ mergedInput 10 ms100 <- evaluate . force $ mergedInput 100 ms1000 <- evaluate . force $ mergedInput 1000+ ms10000 <- evaluate . force $ mergedInput 10000+ off10 <- evaluate . force $ offsetMerged 10+ off100 <- evaluate . force $ offsetMerged 100+ off1000 <- evaluate . force $ offsetMerged 1000+ oms10 <- evaluate . force $ overlappingMerged 10+ oms100 <- evaluate . force $ overlappingMerged 100+ oms1000 <- evaluate . force $ overlappingMerged 1000 el1000 <- evaluate . force $ elemList 1000 el10000 <- evaluate . force $ elemList 10000 defaultMain [ bgroup "point-queries" [ bgroup "inRange"- [ bench "SpanRange" $ whnf (inRange (1 +=+ 1000000)) (500000 :: Integer)- , bench "LowerBoundRange" $ whnf (inRange (lbi 0)) (999999 :: Integer)- , bench "UpperBoundRange" $ whnf (inRange (ubi 1000000)) (1 :: Integer)- , bench "SingletonRange" $ whnf (inRange (SingletonRange 42)) (42 :: Integer)- , bench "InfiniteRange" $ whnf (inRange (InfiniteRange :: Range Integer)) 0+ [ bench "SpanRange" $ whnf (inRange (SpanRange (Bound 1 Inclusive) (Bound 1000000 Inclusive))) (500000 :: Integer)+ , bench "LowerBoundRange" $ whnf (inRange (LowerBoundRange (Bound 0 Inclusive))) (999999 :: Integer)+ , bench "UpperBoundRange" $ whnf (inRange (UpperBoundRange (Bound 1000000 Inclusive))) (1 :: Integer)+ , bench "SingletonRange" $ whnf (inRange (SingletonRange 42)) (42 :: Integer)+ , bench "InfiniteRange" $ whnf (inRange (InfiniteRange :: Range Integer)) 0 ] , bgroup "inRanges/disjoint-spans"- [ bench "10" $ whnf (inRanges ds10) 29- , bench "100" $ whnf (inRanges ds100) 299- , bench "1000" $ whnf (inRanges ds1000) 2999- , bench "10000" $ whnf (inRanges ds10000) 29999+ [ bench "10" $ whnf (inRanges ms10) 29+ , bench "100" $ whnf (inRanges ms100) 299+ , bench "1000" $ whnf (inRanges ms1000) 2999+ , bench "10000" $ whnf (inRanges ms10000) 29999 ] , bgroup "inRanges/vs-elem" -- Checking for the last element — worst case for both- [ bench "inRanges-1000" $ whnf (inRanges ds1000) 2998+ [ bench "inRanges-1000" $ whnf (inRanges ms1000) 2998 , bench "elem-1000" $ whnf (elem (2998 :: Integer)) el1000- , bench "inRanges-10000" $ whnf (inRanges ds10000) 29998+ , bench "inRanges-10000" $ whnf (inRanges ms10000) 29998 , bench "elem-10000" $ whnf (elem (29998 :: Integer)) el10000 ] , bgroup "aboveRanges/disjoint-spans"- [ bench "10" $ whnf (aboveRanges ds10) 10000- , bench "100" $ whnf (aboveRanges ds100) 10000- , bench "1000" $ whnf (aboveRanges ds1000) 10000+ [ bench "10" $ whnf (aboveRanges ms10) 10000+ , bench "100" $ whnf (aboveRanges ms100) 10000+ , bench "1000" $ whnf (aboveRanges ms1000) 10000 ] , bgroup "belowRanges/disjoint-spans"- [ bench "10" $ whnf (belowRanges ds10) (-1)- , bench "100" $ whnf (belowRanges ds100) (-1)- , bench "1000" $ whnf (belowRanges ds1000) (-1)+ [ bench "10" $ whnf (belowRanges ms10) (-1)+ , bench "100" $ whnf (belowRanges ms100) (-1)+ , bench "1000" $ whnf (belowRanges ms1000) (-1) ] ] , bgroup "set-operations" [ bgroup "mergeRanges/already-merged"- [ bench "10" $ nf mergeRanges ms10- , bench "100" $ nf mergeRanges ms100- , bench "1000" $ nf mergeRanges ms1000+ [ bench "10" $ nf mergeRanges ds10+ , bench "100" $ nf mergeRanges ds100+ , bench "1000" $ nf mergeRanges ds1000 ] , bgroup "mergeRanges/fully-overlapping" [ bench "10" $ nf mergeRanges os10@@ -112,15 +143,15 @@ , bench "1000" $ nf (union ms1000) ms1000 ] , bgroup "intersection/disjoint"- -- Two sets offset so they don't overlap — result is empty- [ bench "10" $ nf (intersection ms10) (fmap (fmap (+500000)) ms10)- , bench "100" $ nf (intersection ms100) (fmap (fmap (+500000)) ms100)- , bench "1000" $ nf (intersection ms1000) (fmap (fmap (+500000)) ms1000)+ -- Two pre-merged sets offset so they share no values — result is empty+ [ bench "10" $ nf (intersection ms10) off10+ , bench "100" $ nf (intersection ms100) off100+ , bench "1000" $ nf (intersection ms1000) off1000 ] , bgroup "intersection/overlapping"- [ bench "10" $ nf (intersection os10) os10- , bench "100" $ nf (intersection os100) os100- , bench "1000" $ nf (intersection os1000) os1000+ [ bench "10" $ nf (intersection oms10) oms10+ , bench "100" $ nf (intersection oms100) oms100+ , bench "1000" $ nf (intersection oms1000) oms1000 ] , bgroup "difference" [ bench "10" $ nf (difference ms10) ms10@@ -136,14 +167,14 @@ , bgroup "construction-conversion" [ bgroup "fromRanges/take-N"- [ bench "take-100" $ nf (take 100 . fromRanges) ds10- , bench "take-1000" $ nf (take 1000 . fromRanges) ds10- , bench "take-10000" $ nf (take 10000 . fromRanges) ds10+ [ bench "take-100" $ nf (take 100 . fromRanges) ms10+ , bench "take-1000" $ nf (take 1000 . fromRanges) ms10+ , bench "take-10000" $ nf (take 10000 . fromRanges) ms10 ] , bgroup "joinRanges/adjacent"- [ bench "10" $ nf joinRanges ds10- , bench "100" $ nf joinRanges ds100- , bench "1000" $ nf joinRanges ds1000+ [ bench "10" $ nf joinRanges ms10+ , bench "100" $ nf joinRanges ms100+ , bench "1000" $ nf joinRanges ms1000 ] ]
Data/Range.hs view
@@ -1,492 +1,11 @@ {-# LANGUAGE Safe #-} --- | This module provides a simple api to access range functionality. It provides standard--- set operations on ranges, the ability to merge ranges together and, importantly, the ability--- to check if a value is within a range. The primary benifit of the Range library is performance--- and versatility.------ __Note:__ It is intended that you will read the documentation in this module from top to bottom.------ = Module guide------ * "Data.Range" — __start here__. Direct functions on @['Range' a]@.--- * "Data.Ranges" — 'Data.Ranges.Ranges' newtype with 'Monoid' \/ 'Semigroup' semantics (@('<>')@ means union).--- * "Data.Range.Ord" — 'Data.Range.Ord.KeyRange' and 'Data.Range.Ord.SortedRange' newtypes for 'Ord'-requiring contexts.--- * "Data.Range.Parser" — Parsec-based parser for CLI range strings.--- * "Data.Range.Algebra" — F-Algebra for deferred, efficient expression trees.------ = Understanding custom range syntax------ This library supports five different types of ranges:------ * 'SpanRange': A range starting from a value and ending with another value.--- * 'SingletonRange': This range is really just a shorthand for a range that starts and ends with the same value.--- * 'LowerBoundRange': A range that starts at a value and extends infinitely in the positive direction.--- * 'UpperBoundRange': A range that starts at a value and extends infinitely in the negative direction.--- * 'InfiniteRange': A range that includes all values in your range.------ All of these ranges are bounded in an 'Inclusive' or 'Exclusive' manner.------ To run through a simple example of what this looks like, let's start with mathematical notation and then--- move into our own notation.------ The bound @[1, 5)@ says "All of the numbers from one to five, including one but excluding 5."------ Using the data types directly, you could write this as:------ @SpanRange (Bound 1 Inclusive) (Bound 5 Exclusive)@------ This is overly verbose, as a result, this library contains operators and functions for writing this much--- more succinctly. The above example could be written as:------ @1 +=* 5@------ There the @+@ symbol is used to represent the inclusive side of a range and the @*@ symbol is used to represent--- the exclusive side of a range.------ The 'Show' instance of the 'Range' class will actually output these simplified helper functions, for example:------ >>> [SingletonRange 5, SpanRange (Bound 1 Inclusive) (Bound 5 Exclusive), InfiniteRange]--- [SingletonRange 5,1 +=* 5,inf]------ There are 'lbi', 'lbe', 'ubi' and 'ube' functions to create lower bound inclusive, lower bound exclusive, upper--- bound inclusive and upper bound exclusive ranges respectively.------ @SingletonRange x@ is equivalent to @x +=+ x@ but is nicer for presentational purposes in a 'Show'.------ Now that you know the basic syntax to declare ranges, the following uses cases will be easier to understand.------ = Use case 1: Basic Integer Range------ The standard use case for this library is efficiently discovering if an integer is within a given range.------ For example, if we had the range made up of the inclusive unions of @[5, 10]@ and @[20, 30]@ and @[25, Infinity)@--- then we could instantiate, and simplify, such a range like this:------ >>> mergeRanges [(5 :: Integer) +=+ 10, 20 +=+ 30, lbi 25]--- [5 +=+ 10,lbi 20]------ You can then test if elements are within this range:------ >>> let ranges = mergeRanges [(5 :: Integer) +=+ 10, 20 +=+ 30, lbi 25]--- >>> inRanges ranges 7--- True--- >>> inRanges ranges 50--- True--- >>> inRanges ranges 15--- False------ The other convenience methods in this library will help you perform more range operations.------ = Use case 2: Version ranges------ All the 'Data.Range' library really needs to work, is the Ord type. If you have a data type that can--- be ordered, than we can perform range calculations on it. The Data.Version type is an excellent example--- of this. For example, let's say that you want to say: "I accept a version range of [1.1.0, 1.2.1] or [1.3, 1.4) or [1.4, 1.4.2)"--- then you can write that as:------ @--- \>\>\> :m + Data.Version--- \>\>\> let v x = Version x []--- \>\>\> let ranges = mergeRanges [v [1, 1, 0] +=+ v [1,2,1], v [1,3] +=* v [1,4], v [1,4] +=* v [1,4,2]]--- \>\>\> inRanges ranges (v [1,0])--- False--- \>\>\> inRanges ranges (v [1,5])--- False--- \>\>\> inRanges ranges (v [1,1,5])--- True--- \>\>\> inRanges ranges (v [1,3,5])--- True--- @------ As you can see, it is almost identical to the previous example, yet you are now comparing if a version is within a version range!--- Not only that, but so long as your type is orderable, the ranges can be merged together cleanly.------ With any luck, you can apply this library to your use case of choice. Good luck!-module Data.Range (- -- * Range creation- (+=+),- (+=*),- (*=+),- (*=*),- lbi,- lbe,- ubi,- ube,- inf,- -- * Comparison functions- inRange,- inRanges,- aboveRange,- aboveRanges,- belowRange,- belowRanges,- rangesOverlap,- rangesAdjoin,- -- * Set operations- mergeRanges,- union,- intersection,- difference,- invert,- -- * Enumerable methods- fromRanges,- joinRanges,- -- * Data types- Bound(..),- BoundType(..),- Range(..)- ) where---- $setup--- >>> import Data.Range--import Data.Range.Data-import Data.Range.Operators-import Data.Range.Util-import Data.Range.RangeInternal (exportRangeMerge, joinRM, loadRanges, RangeMerge(..), buildSpanQuery)-import qualified Data.Range.Algebra as Alg---- | Performs a set union between the two input ranges and returns the resultant set of--- ranges. The output is already in merged (canonical) form; a subsequent call to--- 'mergeRanges' is redundant.------ >>> union [1 +=+ 10] [5 +=+ (15 :: Integer)]--- [1 +=+ 15]------ See also 'intersection', 'difference', 'invert'.-union :: (Ord a) => [Range a] -> [Range a] -> [Range a]-union a b = Alg.eval $ Alg.union (Alg.const a) (Alg.const b)-{-# INLINE union #-}---- | Performs a set intersection between the two input ranges and returns the resultant set of--- ranges. The output is already in merged (canonical) form; a subsequent call to--- 'mergeRanges' is redundant.------ >>> intersection [1 +=* 10] [5 +=+ (15 :: Integer)]--- [5 +=* 10]------ See also 'union', 'difference', 'invert'.-intersection :: (Ord a) => [Range a] -> [Range a] -> [Range a]-intersection a b = Alg.eval $ Alg.intersection (Alg.const a) (Alg.const b)-{-# INLINE intersection #-}---- | Performs a set difference between the two input ranges and returns the resultant set of--- ranges. The output is already in merged (canonical) form; a subsequent call to--- 'mergeRanges' is redundant.------ >>> difference [1 +=+ 10] [5 +=+ (15 :: Integer)]--- [1 +=* 5]------ See also 'union', 'intersection', 'invert'.-difference :: (Ord a) => [Range a] -> [Range a] -> [Range a]-difference a b = Alg.eval $ Alg.difference (Alg.const a) (Alg.const b)-{-# INLINE difference #-}---- | Returns the complement of the given ranges: all values /not/ covered by any--- of the input ranges.------ >>> invert [1 +=* 10, 15 *=+ (20 :: Integer)]--- [ube 1,10 +=+ 15,lbe 20]------ Note that @'invert' . 'invert' == 'id'@ for any list of ranges.------ See also 'union', 'intersection', 'difference'.-invert :: (Ord a) => [Range a] -> [Range a]-invert = Alg.eval . Alg.invert . Alg.const-{-# INLINE invert #-}---- | A check to see if two ranges overlap. The ranges overlap if at least one value exists within both ranges.--- If they do overlap then true is returned; false otherwise.------ For example:------ >>> rangesOverlap (1 +=+ 5) (3 +=+ 7)--- True--- >>> rangesOverlap (1 +=+ 5) (5 +=+ 7)--- True--- >>> rangesOverlap (1 +=* 5) (5 +=+ 7)--- False------ The last case of these three is the primary "gotcha" of this method. With @[1, 5)@ and @[5, 7]@ there is no--- value that exists within both ranges. Therefore, technically, the ranges do not overlap. If you expected--- this to return True then it is likely that you would prefer to use 'rangesAdjoin' instead.-rangesOverlap :: (Ord a) => Range a -> Range a -> Bool-rangesOverlap a b = Overlap == (rangesOverlapType a b)--rangesOverlapType :: (Ord a) => Range a -> Range a -> OverlapType-rangesOverlapType (SingletonRange a) x = rangesOverlapType (SpanRange b b) x- where- b = Bound a Inclusive-rangesOverlapType (SpanRange x y) (SpanRange a b) = boundsOverlapType (x, y) (a, b)-rangesOverlapType (SpanRange _ y) (LowerBoundRange lower) = againstLowerBound y lower-rangesOverlapType (SpanRange x _) (UpperBoundRange upper) = againstUpperBound x upper-rangesOverlapType (LowerBoundRange _) (LowerBoundRange _) = Overlap-rangesOverlapType (LowerBoundRange lower) (UpperBoundRange upper) = againstUpperBound lower upper-rangesOverlapType (UpperBoundRange _) (UpperBoundRange _) = Overlap-rangesOverlapType InfiniteRange _ = Overlap-rangesOverlapType a b = rangesOverlapType b a---- | A check to see if two ranges adjoin. Ranges adjoin if they share no values but touch at a--- single boundary point — exactly one of the touching bounds is exclusive.------ For example:------ >>> rangesAdjoin (1 +=* 5) (5 +=+ 7)--- True--- >>> rangesAdjoin (1 +=+ 5) (5 *=+ 7)--- True--- >>> rangesAdjoin (1 +=+ 5) (3 +=+ 7)--- False------ The third case illustrates the distinction from 'rangesOverlap': @[1, 5]@ and @[3, 7]@ share--- values 3–5, so they overlap, not adjoin. See also 'rangesOverlap'.-rangesAdjoin :: (Ord a) => Range a -> Range a -> Bool-rangesAdjoin a b = Adjoin == (rangesOverlapType a b)---- | Given a range and a value, returns 'True' if the value is within the range.--- Respects 'Inclusive' and 'Exclusive' bounds.------ See also 'inRanges' for testing against a list of ranges.------ The primary value of this library is performance and this method can be used to show--- this quite clearly. For example, you can try and approximate basic range functionality--- with "Data.List.elem" so we can generate an apples to apples comparison in GHCi:------ @--- \>\>\> :set +s--- \>\>\> elem (10000000 :: Integer) [1..10000000]--- True--- (0.26 secs, 720,556,888 bytes)--- \>\>\> inRange (1 +=+ 10000000) (10000000 :: Integer)--- True--- (0.00 secs, 557,656 bytes)--- @------ As you can see, this function is significantly more performant, in both speed and memory,--- than using the elem function.-inRange :: (Ord a) => Range a -> a -> Bool-inRange (SingletonRange a) value = value == a-inRange (SpanRange x y) value = Overlap == boundIsBetween (Bound value Inclusive) (x, y)-inRange (LowerBoundRange lower) value = Overlap == againstLowerBound (Bound value Inclusive) lower-inRange (UpperBoundRange upper) value = Overlap == againstUpperBound (Bound value Inclusive) upper-inRange InfiniteRange _ = True---- | Returns 'True' if the value falls within any of the given ranges.--- This is the primary membership test for the library and is significantly more--- performant than approximating it with @'elem' x [lo..hi]@.------ The range list is canonicalised and a 'Data.Map'-backed lookup structure is--- built when this function is partially applied to its range argument. This--- means that when testing multiple values against the same set of ranges,--- partial application amortises the setup cost:------ @--- -- Efficient: map is built once--- let memberOf = inRanges myRanges--- filter memberOf largeList------ -- Also fine for one-off checks--- inRanges myRanges someValue--- @------ The first argument does not need to be in merged\/canonical form; the--- function canonicalises it internally. If the input is already canonical--- (e.g. the result of 'mergeRanges'), canonicalisation is a no-op.------ >>> inRanges [1 +=+ 10, 20 +=+ 30] (5 :: Integer)--- True--- >>> inRanges [1 +=+ 10, 20 +=+ 30] (15 :: Integer)--- False--- >>> inRanges [] (0 :: Integer)--- False------ See also 'inRange' for testing against a single range.-inRanges :: (Ord a) => [Range a] -> a -> Bool-inRanges rs =- case loadRanges rs of- IRM -> const True- RM lb ub spans -> buildSpanQuery lb ub spans---- | Checks if the value provided is above (or greater than) the biggest value in--- the given range.------ The "LowerBoundRange" and the "InfiniteRange" will always--- cause this method to return False because you can't have a value--- higher than them since they are both infinite in the positive--- direction.------ >>> aboveRange (SingletonRange 5) (6 :: Integer)--- True--- >>> aboveRange (1 +=+ 5) (6 :: Integer)--- True--- >>> aboveRange (1 +=+ 5) (0 :: Integer)--- False--- >>> aboveRange (lbi 0) (6 :: Integer)--- False--- >>> aboveRange (ubi 0) (6 :: Integer)--- True--- >>> aboveRange inf (6 :: Integer)--- False-aboveRange :: (Ord a) => Range a -> a -> Bool-aboveRange (SingletonRange a) value = value > a-aboveRange (SpanRange _ y) value = Overlap == againstLowerBound (Bound value Inclusive) (invertBound y)-aboveRange (LowerBoundRange _) _ = False-aboveRange (UpperBoundRange upper) value = Overlap == againstLowerBound (Bound value Inclusive) (invertBound upper)-aboveRange InfiniteRange _ = False---- | Returns 'True' if the value is strictly above (greater than the upper bound of)--- all of the given ranges.------ >>> aboveRanges [1 +=+ 5, 10 +=+ 15] (20 :: Integer)--- True--- >>> aboveRanges [1 +=+ 5, lbi 10] (20 :: Integer)--- False--- >>> aboveRanges [] (0 :: Integer)--- True------ See also 'aboveRange', 'belowRanges'.-aboveRanges :: (Ord a) => [Range a] -> a -> Bool-aboveRanges rs a = all (`aboveRange` a) rs---- | Checks if the value provided is below (or less than) the smallest value in--- the given range.------ The "UpperBoundRange" and the "InfiniteRange" will always--- cause this method to return False because you can't have a value--- lower than them since they are both infinite in the negative--- direction.------ >>> belowRange (SingletonRange 5) (4 :: Integer)--- True--- >>> belowRange (1 +=+ 5) (0 :: Integer)--- True--- >>> belowRange (1 +=+ 5) (6 :: Integer)--- False--- >>> belowRange (lbi 6) (0 :: Integer)--- True--- >>> belowRange (ubi 6) (0 :: Integer)--- False--- >>> belowRange inf (6 :: Integer)--- False-belowRange :: (Ord a) => Range a -> a -> Bool-belowRange (SingletonRange a) value = value < a-belowRange (SpanRange x _) value = Overlap == againstUpperBound (Bound value Inclusive) (invertBound x)-belowRange (LowerBoundRange lower) value = Overlap == againstUpperBound (Bound value Inclusive) (invertBound lower)-belowRange (UpperBoundRange _) _ = False-belowRange InfiniteRange _ = False---- | Returns 'True' if the value is strictly below (less than the lower bound of)--- all of the given ranges.------ >>> belowRanges [5 +=+ 10, 20 +=+ 30] (1 :: Integer)--- True--- >>> belowRanges [ubi 10, 20 +=+ 30] (1 :: Integer)--- False--- >>> belowRanges [] (0 :: Integer)--- True------ See also 'belowRange', 'aboveRanges'.-belowRanges :: (Ord a) => [Range a] -> a -> Bool-belowRanges rs a = all (`belowRange` a) rs---- | An array of ranges may have overlaps; this function will collapse that array into as few--- Ranges as possible. For example:------ >>> mergeRanges [lbi 12, 1 +=+ 10, 5 +=+ (15 :: Integer)]--- [lbi 1]------ As you can see, the mergeRanges method collapsed multiple ranges into a single range that--- still covers the same surface area.------ This may be useful for a few use cases:------ * You are hyper concerned about performance and want to have the minimum number of ranges--- for comparison in the inRanges function.--- * You wish to display ranges to a human and want to show the minimum number of ranges to--- avoid having to make people perform those calculations themselves.------ Please note that the use of any of the operations on sets of ranges like invert, union and--- intersection will have the same behaviour as mergeRanges as a side effect. So, for example,--- this is redundant:------ @--- mergeRanges . union []--- @------ See also 'joinRanges' for merging ranges that are contiguous for 'Enum' types.-mergeRanges :: (Ord a) => [Range a] -> [Range a]-mergeRanges = Alg.eval . Alg.union (Alg.const []) . Alg.const-{-# INLINE mergeRanges #-}---- | Instantiate all of the values in a range.------ __Warning__: This method is meant as a convenience method, it is not efficient.------ A set of ranges represents a collection of real values without actually instantiating--- those values. Not instantiating ranges, allows the range library to support infinite--- ranges and be super performant.------ However, sometimes you actually want to get the values that your range represents, or even--- get a sample set of the values. This function generates as many of the values that belong--- to your range as you like.------ Because ranges can be infinite, it is highly recommended to combine this method with something like--- "Data.List.take" to avoid an infinite recursion.------ This method will attempt to take a sample from all of the ranges that you have provided, however--- it is not guaranteed that you will get an even sampling. All that is guaranteed is that you will--- only get back values that are within one or more of the ranges you provide.------ == Examples------ A simple span:------ >>> take 5 . fromRanges $ [1 +=+ 10 :: Range Integer, 20 +=+ 30]--- [1,20,2,21,3]------ An infinite range:+-- | __Deprecated.__ Import "Data.Ranges" instead. ----- >>> take 5 . fromRanges $ [inf :: Range Integer]--- [0,1,-1,2,-2]-fromRanges :: (Ord a, Enum a) => [Range a] -> [a]-fromRanges = takeEvenly . fmap fromRange . mergeRanges- where- fromRange range = case range of- SingletonRange x -> [x]- SpanRange (Bound a aType) (Bound b bType) -> [(if aType == Inclusive then a else succ a)..(if bType == Inclusive then b else pred b)]- LowerBoundRange (Bound x xType) -> iterate succ (if xType == Inclusive then x else succ x)- UpperBoundRange (Bound x xType) -> iterate pred (if xType == Inclusive then x else pred x)- InfiniteRange -> zero : takeEvenly [tail $ iterate succ zero, tail $ iterate pred zero]- where- zero = toEnum 0+-- This module is a re-export shim kept for backwards compatibility.+-- All types and functions are now in "Data.Ranges".+module Data.Range {-# DEPRECATED "Import Data.Ranges instead of Data.Range." #-}+ ( module Data.Ranges+ ) where --- | Joins together ranges that we only know can be joined because of the 'Enum' class.------ To make the purpose of this method easier to understand, let's run throuh a simple example:------ >>> mergeRanges [1 +=+ 5, 6 +=+ 10] :: [Range Integer]--- [1 +=+ 5,6 +=+ 10]------ In this example, you know that the values are all of the type 'Integer'. Because of this, you--- know that there are no values between 5 and 6. You may expect that the `mergeRanges` function--- should "just know" that it can merge these together; but it can't because it does not have the--- required constraints. This becomes more obvious if you modify the example to use 'Double' instead:------ >>> mergeRanges [1.5 +=+ 5.5, 6.5 +=+ 10.5] :: [Range Double]--- [1.5 +=+ 5.5,6.5 +=+ 10.5]------ Now we can see that there are an infinite number of values between 5.5 and 6.5 and thus no such --- join between the two ranges could occur.------ This function, joinRanges, provides the missing piece that you would expect:------ >>> joinRanges $ mergeRanges [1 +=+ 5, 6 +=+ 10] :: [Range Integer]--- [1 +=+ 10]------ You can use this method to ensure that all ranges for whom the value implements 'Enum' can be--- compressed to their smallest representation.------ See also 'mergeRanges' for the overlap-only merge that works on any 'Ord' type.-joinRanges :: (Ord a, Enum a) => [Range a] -> [Range a]-joinRanges = exportRangeMerge . joinRM . loadRanges+import Data.Ranges
Data/Range/Algebra.hs view
@@ -9,8 +9,9 @@ -- -- __When to use this module:__ Build a 'RangeExpr' when you are combining three -- or more operations in a pipeline, or when you want to evaluate the same--- expression against multiple targets (e.g. both @['Range' a]@ and @a -> 'Bool'@).--- A single @union a b@ is no faster through the algebra than a direct call.+-- expression against multiple targets (e.g. both 'Data.Ranges.Ranges' and+-- @a -> 'Bool'@). A single @union a b@ is no faster through the algebra than+-- a direct call. -- -- __Note:__ This module is based on F-Algebras. If you have never encountered -- them before, see@@ -19,21 +20,28 @@ -- -- == Examples ----- Evaluate to a concrete list of ranges:+-- Evaluate to a 'Data.Ranges.Ranges' value (the typical use): -- -- @ -- import qualified Data.Range.Algebra as A--- import Data.Range--- A.eval . A.invert $ A.const [SingletonRange (5 :: Integer)]--- -- [ube 4,lbi 6]+-- import Data.Ranges+--+-- expr :: A.RangeExpr (Ranges Integer)+-- expr = A.invert (A.const (SingletonRange 5))+--+-- A.eval expr :: Ranges Integer+-- -- Ranges [ube 4,lbi 6] -- @ ----- Evaluate the same expression as a predicate (no intermediate list is built):+-- Evaluate the same expression as a predicate (no intermediate structure built): -- -- @--- let expr = A.union (A.const [1 +=+ 10]) (A.const [20 +=+ 30]) :: A.RangeExpr [Range Integer]--- (A.eval expr :: Integer -> Bool) 25 -- True--- (A.eval expr :: Integer -> Bool) 15 -- False+-- import qualified Data.Range.Algebra as A+-- import Data.Ranges+--+-- let expr = A.union (A.const (1 +=+ 10)) (A.const (20 +=+ 30)) :: A.RangeExpr (Ranges Integer)+-- A.eval (fmap inRanges expr) 25 -- True+-- A.eval (fmap inRanges expr) 15 -- False -- @ -- module Data.Range.Algebra@@ -83,23 +91,29 @@ difference a b = RangeExpr . Free $ Difference (getFree a) (getFree b) -- | A type class for types that a 'RangeExpr' can be evaluated to.--- Two instances are provided out of the box; additional targets can be added+-- Three instances are provided out of the box; additional targets can be added -- by implementing this class. class RangeAlgebra a where -- | Collapses a 'RangeExpr' tree into its target representation by- -- evaluating every node bottom-up. Two evaluation targets are supported:+ -- evaluating every node bottom-up. Three evaluation targets are supported: --- -- * @['Data.Range.Range' a]@ — a merged, canonical list of non-overlapping ranges.- -- * @a -> 'Bool'@ — a membership predicate; no intermediate list is constructed.+ -- * 'Data.Ranges.Ranges' @a@ — canonical, indexed set with pre-built+ -- membership predicate. The primary target for user code; instance defined+ -- in "Data.Ranges".+ -- * @['Data.Range.Data.Range' a]@ — a merged, canonical list. Used internally+ -- and useful when you need to inspect individual ranges.+ -- * @a -> 'Bool'@ — a membership predicate; no intermediate structure built. eval :: Algebra RangeExpr a -- | Evaluates to a merged, canonical list of non-overlapping ranges.--- Input ranges are allowed to overlap; the output is guaranteed to be disjoint.+-- Used internally by "Data.Ranges" and useful when you need to inspect+-- individual 'Range' values. Prefer the 'Data.Ranges.Ranges' instance for+-- general use. instance (Ord a) => RangeAlgebra [Range a] where eval = iter rangeAlgebra . getFree -- | Evaluates to a membership predicate @a -> 'Bool'@.--- More efficient than the @['Range' a]@ instance when you only need to test--- membership and do not need to inspect the ranges themselves.+-- No intermediate structure is constructed. With 'Data.Ranges.Ranges' leaves,+-- use @'eval' ('fmap' 'Data.Ranges.inRanges' expr)@ to reach this instance. instance RangeAlgebra (a -> Bool) where eval = iter predicateAlgebra . getFree
Data/Range/Data.hs view
@@ -48,13 +48,6 @@ instance NFData a => NFData (Range a) -instance Functor Range where- fmap f (SingletonRange x) = SingletonRange . f $ x- fmap f (SpanRange x y) = SpanRange (fmap f x) (fmap f y)- fmap f (LowerBoundRange x) = LowerBoundRange (fmap f x)- fmap f (UpperBoundRange x) = UpperBoundRange (fmap f x)- fmap _ InfiniteRange = InfiniteRange- instance Show a => Show (Range a) where showsPrec i (SingletonRange a) = ((++) "SingletonRange ") . showsPrec i a showsPrec i (SpanRange (Bound l lType) (Bound r rType)) =
Data/Range/Parser.hs view
@@ -4,19 +4,19 @@ -- -- By default, ranges are separated by commas and span endpoints by a hyphen: ----- >>> parseRanges "-5,8-10,13-15,20-" :: Either ParseError [Range Integer]--- Right [ubi 5,8 +=+ 10,13 +=+ 15,lbi 20]+-- >>> parseRanges "-5,8-10,13-15,20-" :: Either ParseError (Ranges Integer)+-- Right (Ranges [ubi 5,8 +=+ 10,13 +=+ 15,lbi 20]) -- -- The @*@ wildcard produces an infinite range: ----- >>> parseRanges "*" :: Either ParseError [Range Integer]--- Right [inf]+-- >>> parseRanges "*" :: Either ParseError (Ranges Integer)+-- Right (Ranges [inf]) -- -- Use 'customParseRanges' to change the separator characters: -- -- >>> let args = defaultArgs { unionSeparator = ";", rangeSeparator = ".." }--- >>> customParseRanges args "1..5;10" :: Either ParseError [Range Integer]--- Right [1 +=+ 5,SingletonRange 10]+-- >>> customParseRanges args "1..5;10" :: Either ParseError (Ranges Integer)+-- Right (Ranges [1 +=+ 5,SingletonRange 10]) -- -- __Known limitations:__ --@@ -25,13 +25,14 @@ -- For negative values, use 'customParseRanges' with a different 'rangeSeparator', -- or pre-process the input string. ----- * Unrecognised input is silently consumed as an empty list rather than producing--- a parse error. For example, @parseRanges \"abc\"@ returns @Right []@. This is a+-- * Unrecognised input is silently consumed as an empty set rather than producing+-- a parse error. For example, @parseRanges \"abc\"@ returns @Right mempty@. This is a -- consequence of using 'Text.Parsec.sepBy' internally and is by design for -- CLI use where partial input is common. -- -- For more complex parsing (e.g. @.cabal@ or @package.json@ files), parse version--- strings with Parsec or Alex\/Happy and convert the results into 'Range' values directly.+-- strings with Parsec or Alex\/Happy and convert the results into 'Range' values directly,+-- then call 'mergeRanges'. module Data.Range.Parser ( -- * Parsing parseRanges@@ -48,13 +49,13 @@ ) where -- $setup--- >>> import Data.Range+-- >>> import Data.Ranges -- >>> import Data.Range.Parser import Text.Parsec import Text.Parsec.String -import Data.Range+import Data.Ranges -- | Configuration for the range parser. All three fields are plain strings, so -- multi-character separators (e.g. @\"..\"@) are supported.@@ -78,7 +79,8 @@ } -- | Parses a range string using the default separators (@,@ and @-@). Returns--- either a 'ParseError' or the list of parsed ranges.+-- either a 'ParseError' or a canonicalised 'Ranges' value ready for membership+-- testing and set operations. -- -- The 'Read' instance of @a@ is used to parse individual numeric literals, so -- the type must have a well-behaved 'Read'. Exotic types with unusual 'Read'@@ -86,17 +88,17 @@ -- -- See the module documentation for known limitations around negative numbers -- and unrecognised input.-parseRanges :: (Read a) => String -> Either ParseError [Range a]-parseRanges = parse (ranges defaultArgs) "(range parser)"+parseRanges :: (Read a, Ord a) => String -> Either ParseError (Ranges a)+parseRanges = fmap mergeRanges . parse (ranges defaultArgs) "(range parser)" -- | Like 'parseRanges' but with caller-supplied separator configuration. -- Use this when the default @,@ and @-@ characters conflict with your input format. -- -- >>> let args = defaultArgs { unionSeparator = ";", rangeSeparator = ".." }--- >>> customParseRanges args "1..5;10" :: Either ParseError [Range Integer]--- Right [1 +=+ 5,SingletonRange 10]-customParseRanges :: Read a => RangeParserArgs -> String -> Either ParseError [Range a]-customParseRanges args = parse (ranges args) "(range parser)"+-- >>> customParseRanges args "1..5;10" :: Either ParseError (Ranges Integer)+-- Right (Ranges [1 +=+ 5,SingletonRange 10])+customParseRanges :: (Read a, Ord a) => RangeParserArgs -> String -> Either ParseError (Ranges a)+customParseRanges args = fmap mergeRanges . parse (ranges args) "(range parser)" string_ :: Stream s m Char => String -> ParsecT s u m () string_ x = string x >> return ()@@ -104,6 +106,9 @@ -- | Returns a Parsec 'Parser' for a list of ranges using the given configuration. -- Use this when embedding range parsing into a larger Parsec grammar; for -- standalone parsing prefer 'parseRanges' or 'customParseRanges'.+--+-- The returned list is unmerged — call 'mergeRanges' on the result to produce+-- a canonical 'Ranges' value. ranges :: (Read a) => RangeParserArgs -> Parser [Range a] ranges args = range `sepBy` (string $ unionSeparator args) where
Data/Range/RangeInternal.hs view
@@ -34,12 +34,18 @@ storeRange :: (Ord a) => Range a -> RangeMerge a storeRange InfiniteRange = IRM-storeRange (LowerBoundRange lower) = emptyRangeMerge { largestLowerBound = Just lower }-storeRange (UpperBoundRange upper) = emptyRangeMerge { largestUpperBound = Just upper }+storeRange (LowerBoundRange lower) =+ RM { largestLowerBound = Just lower, largestUpperBound = Nothing, spanRanges = [] }+storeRange (UpperBoundRange upper) =+ RM { largestLowerBound = Nothing, largestUpperBound = Just upper, spanRanges = [] } storeRange (SpanRange x@(Bound xValue xType) y@(Bound yValue yType)) | xValue == yValue && pointJoinType xType yType == Separate = emptyRangeMerge- | otherwise = emptyRangeMerge { spanRanges = [(minBounds x y, maxBounds x y)] }-storeRange (SingletonRange x) = emptyRangeMerge { spanRanges = [(Bound x Inclusive, Bound x Inclusive)] }+ | otherwise =+ RM { largestLowerBound = Nothing, largestUpperBound = Nothing+ , spanRanges = [(minBounds x y, maxBounds x y)] }+storeRange (SingletonRange x) =+ RM { largestLowerBound = Nothing, largestUpperBound = Nothing+ , spanRanges = [(Bound x Inclusive, Bound x Inclusive)] } storeRanges :: (Ord a) => RangeMerge a -> [Range a] -> RangeMerge a storeRanges start ranges = foldr unionRangeMerges start (map storeRange ranges)@@ -62,7 +68,6 @@ then SingletonRange xv else SpanRange x y -{-# RULES "load/export" [1] forall x. loadRanges (exportRangeMerge x) = x #-} intersectSpansRM :: (Ord a) => RangeMerge a -> RangeMerge a -> RangeMerge a intersectSpansRM one two = RM Nothing Nothing newSpans@@ -141,7 +146,9 @@ unionRangeMerges one two = infiniteCheck filterTwo where filterOne = foldr filterLowerBound boundedRM (unionSpans sortedSpans)- filterTwo = foldr filterUpperBound (filterOne { spanRanges = [] }) (spanRanges filterOne)+ filterTwo = case filterOne of+ IRM -> IRM+ rm -> foldr filterUpperBound (rm { spanRanges = [] }) (spanRanges rm) infiniteCheck :: (Ord a) => RangeMerge a -> RangeMerge a infiniteCheck IRM = IRM@@ -195,31 +202,31 @@ invertRM (RM (Just lower) Nothing []) = RM Nothing (Just . invertBound $ lower) [] invertRM (RM Nothing (Just upper) []) = RM (Just . invertBound $ upper) Nothing [] invertRM (RM (Just lower) (Just upper) []) = RM Nothing Nothing [(invertBound upper, invertBound lower)]-invertRM rm = RM+invertRM (RM lb ub spans@(firstSpan : _)) = RM { largestUpperBound = newUpperBound , largestLowerBound = newLowerBound , spanRanges = upperSpan ++ betweenSpans ++ lowerSpan } where- newLowerValue = invertBound . snd . last . spanRanges $ rm- newUpperValue = invertBound . fst . head . spanRanges $ rm+ newUpperValue = invertBound . fst $ firstSpan+ newLowerValue = invertBound . snd . last $ spans - newUpperBound = case largestUpperBound rm of+ newUpperBound = case ub of Just _ -> Nothing Nothing -> Just newUpperValue - newLowerBound = case largestLowerBound rm of+ newLowerBound = case lb of Just _ -> Nothing Nothing -> Just newLowerValue - upperSpan = case largestUpperBound rm of+ upperSpan = case ub of Nothing -> [] Just upper -> [(invertBound upper, newUpperValue)]- lowerSpan = case largestLowerBound rm of+ lowerSpan = case lb of Nothing -> [] Just lower -> [(newLowerValue, invertBound lower)] - betweenSpans = invertSpans . spanRanges $ rm+ betweenSpans = invertSpans spans joinRM :: (Eq a, Enum a) => RangeMerge a -> RangeMerge a joinRM o@(RM _ _ []) = o
Data/Range/Util.hs view
@@ -1,15 +1,41 @@ {-# LANGUAGE Safe #-} -module Data.Range.Util where+-- | Internal utility functions shared across the range library.+-- This module is in @other-modules@ and is not part of the public API.+--+-- Functions are grouped by the layer that consumes them:+-- * "Used by Ranges\/Ord" — consumed by the semi-public modules+-- * "Used by Spans\/RangeInternal" — consumed only by the strictly-internal layer+-- * "Util-internal" — building blocks used only within this module+module Data.Range.Util+ ( -- * Used by Ranges and Ord+ compareLower+ , compareHigher+ , invertBound+ , boundsOverlapType+ , pointJoinType+ , boundIsBetween+ , againstLowerBound+ , againstUpperBound+ , takeEvenly+ -- * Used by Spans and RangeInternal+ , compareUpperToLower+ , minBounds+ , maxBounds+ , minBoundsIntersection+ , maxBoundsIntersection+ , insertionSort+ , isEmptySpan+ , removeEmptySpans+ , boundCmp+ , lowestValueInLowerBound+ , highestValueInUpperBound+ ) where import Data.List (transpose) import Data.Range.Data --- This module is supposed to contain all of the functions that are required by the rest--- of the code but could be easily pulled into separate and completely non-related--- codebases or libraries.- compareLower :: Ord a => Bound a -> Bound a -> Ordering compareLower ab@(Bound a aType) bb@(Bound b _) | ab == bb = EQ@@ -24,6 +50,7 @@ | a < b = LT | otherwise = GT +-- | Util-internal: used only by 'minBoundsIntersection'. compareLowerIntersection :: Ord a => Bound a -> Bound a -> Ordering compareLowerIntersection ab@(Bound a aType) bb@(Bound b _) | ab == bb = EQ@@ -31,6 +58,7 @@ | a < b = LT | otherwise = GT +-- | Util-internal: used only by 'maxBoundsIntersection'. compareHigherIntersection :: Ord a => Bound a -> Bound a -> Ordering compareHigherIntersection ab@(Bound a aType) bb@(Bound b _) | ab == bb = EQ@@ -83,6 +111,7 @@ | b == y = Overlap | otherwise = (ab `boundIsBetween` (xb, yb)) `orOverlapType` (xb `boundIsBetween` (ab, bb)) +-- | Util-internal: used only by 'boundsOverlapType'. orOverlapType :: OverlapType -> OverlapType -> OverlapType orOverlapType Overlap _ = Overlap orOverlapType _ Overlap = Overlap@@ -95,15 +124,22 @@ pointJoinType Exclusive Exclusive = Separate pointJoinType _ _ = Adjoin --- This function assumes that the bound on the left is a lower bound and that the range is in (lower, upper)--- bound order+-- | This function assumes that the bound on the left is a lower bound and+-- that the range is in @(lower, upper)@ bound order. boundCmp :: (Ord a) => Bound a -> (Bound a, Bound a) -> Ordering boundCmp ab@(Bound a _) (xb@(Bound x _), yb) | boundIsBetween ab (xb, yb) /= Separate = EQ | a <= x = LT | otherwise = GT --- TODO replace everywhere with boundsOverlapType+-- | Tests whether a single 'Bound' falls within the span @(lower, upper)@,+-- returning the 'OverlapType' at that point.+--+-- This is the point-in-span primitive. 'boundsOverlapType' is built on top+-- of it and handles the span-vs-span case. Replacing call sites of this+-- function with 'boundsOverlapType' would require constructing a degenerate+-- span @(b, b)@ for each point — see @ai-planning/boundIsBetween-todo.md@+-- for the full analysis. boundIsBetween :: (Ord a) => Bound a -> (Bound a, Bound a) -> OverlapType boundIsBetween (Bound a aType) (Bound x xType, Bound y yType) | x > a = Separate@@ -112,9 +148,6 @@ | a == y = pointJoinType aType yType | otherwise = Separate -singletonInSpan :: Ord a => a -> (Bound a, Bound a) -> OverlapType-singletonInSpan a span' = boundIsBetween (Bound a Inclusive) span'- againstLowerBound :: Ord a => Bound a -> Bound a -> OverlapType againstLowerBound (Bound a aType) (Bound lower lowerType) | lower == a = pointJoinType aType lowerType@@ -129,10 +162,6 @@ takeEvenly :: [[a]] -> [a] takeEvenly = concat . transpose--pairs :: [a] -> [(a, a)]-pairs [] = []-pairs xs = zip xs (tail xs) lowestValueInLowerBound :: Enum a => Bound a -> a lowestValueInLowerBound (Bound a Inclusive) = a
Data/Ranges.hs view
@@ -1,28 +1,63 @@ {-# LANGUAGE Safe #-} --- | This module provides a 'Newtype' wrapper around @['Data.Range.Range' a]@ that--- integrates with standard Haskell type classes, making it easy to accumulate and--- compose ranges using familiar idioms.+-- | The primary interface to the range library. ----- The primary advantage over "Data.Range" is that 'Ranges' implements 'Semigroup'--- and 'Monoid', where @('<>')@ means /union-and-merge/. This composes naturally with--- standard Haskell functions:+-- A 'Range' describes a membership set over any 'Ord' type. This module+-- provides the 'Ranges' type — a canonicalised, indexed collection of+-- 'Range' values — along with construction operators, set operations, and+-- membership predicates. ----- >>> import Data.Foldable (fold)--- >>> fold [1 +=+ 5, 3 +=+ 8, lbi 20 :: Ranges Integer]--- Ranges [1 +=+ 8,lbi 20]+-- = Quick start --+-- Build ranges with the construction operators and combine them with @('<>')@:+--+-- >>> (1 +=+ 5 :: Ranges Integer) <> (3 +=+ 8)+-- Ranges [1 +=+ 8]+--+-- Test membership:+--+-- >>> inRanges (1 +=+ 10 <> 20 +=+ 30 :: Ranges Integer) 5+-- True+-- >>> inRanges (1 +=+ 10 <> 20 +=+ 30 :: Ranges Integer) 15+-- False+--+-- Use 'mconcat' to build from a list:+-- -- >>> mconcat [1 +=+ 5, 10 +=+ 15, 12 +=+ 20 :: Ranges Integer] -- Ranges [1 +=+ 5,10 +=+ 20] ----- __When to use this module vs "Data.Range":__+-- = Transforming ranges ----- * Use "Data.Range" when working with @['Range' a]@ directly or calling individual--- set operations like 'union' and 'intersection'.--- * Use this module when you want 'Monoid' / 'Semigroup' semantics, need 'Functor'--- to map over all range boundaries, or are threading ranges through code that--- expects a 'Monoid' (e.g. 'mconcat', 'fold', writer-style accumulation).+-- 'Ranges' does not implement 'Functor'. Mapping a function over boundary+-- values is not a well-defined operation for half-infinite ranges: an+-- order-reversing function like @negate@ applied to 'lbi' would need to+-- produce 'ubi', but 'Functor' cannot express that structural flip.+--+-- The idiomatic alternative is to __map the query value__, not the ranges.+-- Instead of converting boundaries to a new domain, convert incoming queries+-- back to the range's domain:+--+-- @+-- -- Unit conversion: test a Fahrenheit value against Celsius ranges+-- let safeTemp = 20 +=+ 37 :: Ranges Double -- defined in °C+-- let inSafeTemp f = inRanges safeTemp ((f - 32) * 5 / 9)+-- @+--+-- This is always correct regardless of whether the conversion is monotone,+-- never requires re-canonicalisation, and avoids the constructor-flip hazard.+--+-- = Module guide+--+-- * "Data.Ranges" — __start here__. 'Ranges' type, all set operations.+-- * "Data.Range" — deprecated re-export shim; use "Data.Ranges" instead.+-- * "Data.Range.Ord" — 'Data.Range.Ord.KeyRange' and 'Data.Range.Ord.SortedRange' for 'Ord'-requiring contexts.+-- * "Data.Range.Parser" — Parsec-based parser for range strings.+-- * "Data.Range.Algebra" — F-Algebra for deferred, efficient expression trees. module Data.Ranges (+ -- * Core types+ Range(..),+ Bound(..),+ BoundType(..), -- * The Ranges type Ranges(unRanges), -- * Range creation@@ -36,11 +71,18 @@ ubi, ube, inf,- -- * Comparison functions+ -- * Single-range predicates+ inRange,+ aboveRange,+ belowRange,+ rangesOverlap,+ rangesAdjoin,+ -- * Multi-range predicates inRanges, aboveRanges, belowRanges, -- * Set operations+ mergeRanges, union, intersection, difference,@@ -54,16 +96,58 @@ -- >>> import Data.Ranges -- >>> import Data.Foldable (fold) -import Data.Semigroup-import qualified Data.Range as R+import Control.DeepSeq (NFData, rnf) --- | Smart constructor. Canonicalises the range list and pre-builds the cached--- lookup predicate. All internal paths that produce a 'Ranges' go through this.-mkRanges :: Ord a => [R.Range a] -> Ranges a+import Data.Range.Data+import Data.Range.Util+ ( againstLowerBound, againstUpperBound, boundIsBetween, boundsOverlapType+ , invertBound, takeEvenly+ )+import Data.Range.RangeInternal+ ( loadRanges, exportRangeMerge, joinRM, buildSpanQuery+ , RangeMerge(..)+ )+import qualified Data.Range.Operators as Op+import qualified Data.Range.Algebra as Alg++-- ---------------------------------------------------------------------------+-- Internal helpers+-- ---------------------------------------------------------------------------++-- | Build an O(log n) membership predicate from a canonical range list.+buildQuery :: Ord a => [Range a] -> a -> Bool+buildQuery rs = case loadRanges rs of+ IRM -> const True+ RM lb ub spans -> buildSpanQuery lb ub spans++-- | Build an O(1) "above all ranges" predicate from the canonical range list.+-- The last element has the largest upper bound; if @a@ is above it, it is+-- above every range. If the last element is a 'LowerBoundRange' or+-- 'InfiniteRange', nothing can be above it, so the predicate returns 'False'.+buildAboveQuery :: Ord a => [Range a] -> a -> Bool+buildAboveQuery [] = const True+buildAboveQuery rs = aboveRange (last rs)++-- | Build an O(1) "below all ranges" predicate from the canonical range list.+-- The first element has the smallest lower bound; if @a@ is below it, it is+-- below every range. If the first element is an 'UpperBoundRange' or+-- 'InfiniteRange', nothing can be below it, so the predicate returns 'False'.+buildBelowQuery :: Ord a => [Range a] -> a -> Bool+buildBelowQuery [] = const True+buildBelowQuery (r:_) = belowRange r++-- | Smart constructor. Canonicalises the range list and pre-builds the+-- membership predicate. Every 'Ranges' value in this module is produced+-- through this function.+mkRanges :: Ord a => [Range a] -> Ranges a mkRanges xs =- let canonical = R.mergeRanges xs- in Ranges canonical (Just (R.inRanges canonical))+ let canonical = Alg.eval $ Alg.union (Alg.const []) (Alg.const xs)+ in Ranges canonical (buildQuery canonical) (buildAboveQuery canonical) (buildBelowQuery canonical) +-- ---------------------------------------------------------------------------+-- The Ranges type+-- ---------------------------------------------------------------------------+ -- $creation -- Each operator constructs a single-element 'Ranges'. Because 'Ranges' is a -- 'Semigroup', you can combine them directly with '<>':@@ -71,103 +155,209 @@ -- >>> (1 +=+ 5 :: Ranges Integer) <> (3 +=+ 8) -- Ranges [1 +=+ 8] ----- The operators mirror those in "Data.Range" but return 'Ranges' instead of--- @'R.Range'@, so they compose naturally without wrapping and unwrapping.+-- The operators mirror those in "Data.Range.Operators" but return 'Ranges'+-- instead of 'Range', so they compose naturally without wrapping. -- | A set of ranges represented as a merged, canonical list of--- non-overlapping 'R.Range' values.+-- non-overlapping 'Range' values, with pre-built O(log n) membership,+-- O(1) above, and O(1) below predicates. ----- The 'Semigroup' instance merges ranges on @('<>')@:+-- Construct values with the operators ('+=+', 'lbi', etc.) or with+-- 'mergeRanges'. Combine with @('<>')@ or 'mconcat'. --+-- __Semigroup__: @('<>')@ computes the set union and merges the result into+-- canonical form.+-- -- >>> (1 +=+ 5 :: Ranges Integer) <> (3 +=+ 8) -- Ranges [1 +=+ 8] ----- 'mempty' is the empty set (no ranges). 'mconcat' merges an entire list at once,--- which is more efficient than repeated @('<>')@:+-- __Monoid__: 'mempty' is the empty set. 'mconcat' merges an entire list in a+-- single pass, more efficiently than repeated @('<>')@: -- -- >>> mconcat [1 +=+ 5, 10 +=+ 15, 12 +=+ 20 :: Ranges Integer] -- Ranges [1 +=+ 5,10 +=+ 20] ----- The 'Functor' instance maps a function over every boundary value in every range:------ >>> fmap (*2) (1 +=+ 5 :: Ranges Integer)--- Ranges [2 +=+ 10]------ Use 'unRanges' to extract the underlying list. Do not construct 'Ranges'--- directly; use the operators or set-operation functions so that the cached--- lookup structure is always kept consistent.+-- Use 'unRanges' to extract the underlying list. data Ranges a = Ranges- { unRanges :: [R.Range a] -- ^ The canonical (sorted, non-overlapping) range list.- , _rangesQuery :: Maybe (a -> Bool) -- ^ Cached O(log n) predicate; Nothing after 'fmap'.+ { unRanges :: [Range a] -- ^ The canonical (sorted, non-overlapping) list.+ , _rangesQuery :: a -> Bool -- ^ Cached O(log n) membership predicate.+ , _aboveQuery :: a -> Bool -- ^ Cached O(1) "above all ranges" predicate.+ , _belowQuery :: a -> Bool -- ^ Cached O(1) "below all ranges" predicate. } +-- | Two 'Ranges' values are equal when their canonical range lists are equal.+instance Eq a => Eq (Ranges a) where+ a == b = unRanges a == unRanges b+ instance Show a => Show (Ranges a) where- showsPrec i r = ((++) "Ranges ") . showsPrec i (unRanges r)+ showsPrec i r = showParen (i > 10) $ ("Ranges " ++) . shows (unRanges r) --- | @('<>')@ computes the set union of two 'Ranges' and merges the result into--- canonical (non-overlapping) form. Associative, with 'mempty' as the identity.+-- | Forces the canonical range list; the cached predicate closure is not+-- forced (it is derived from the list and adds no new thunks).+instance NFData a => NFData (Ranges a) where+ rnf r = rnf (unRanges r)+ instance Ord a => Semigroup (Ranges a) where- (<>) a b = mkRanges $ unRanges a ++ unRanges b+ (<>) a b = mkRanges (unRanges a ++ unRanges b) --- | 'mempty' is the empty set. 'mconcat' is more efficient than folding '<>'--- because it merges all ranges in a single pass.+-- | Evaluates a 'Alg.RangeExpr' tree whose leaves are 'Ranges' values,+-- producing a canonicalised 'Ranges' with a pre-built membership predicate.+--+-- This is the primary evaluation target for user-facing algebra expressions.+-- The implementation converts leaves to @['Range' a]@ internally, folds the+-- tree in a single @'RangeMerge'@ pass (the same efficient path as the+-- @['Range' a]@ instance), then wraps the result with 'mkRanges'.+instance (Ord a) => Alg.RangeAlgebra (Ranges a) where+ eval expr = mkRanges (Alg.eval (fmap unRanges expr))+ instance Ord a => Monoid (Ranges a) where- mempty = mkRanges []- mappend a b = mkRanges $ unRanges a ++ unRanges b- mconcat = mkRanges . concat . fmap unRanges+ mempty = mkRanges []+ mconcat = mkRanges . concatMap unRanges --- | Maps a function over every boundary value in every range.--- Note that mapping a non-monotonic function can produce ill-formed ranges--- (e.g. a span whose lower bound ends up greater than its upper bound).--- Use with care on ordered types.------ The cached lookup predicate cannot be pre-built here because 'Functor' does--- not allow an 'Ord' constraint. Calling 'inRanges' on the result will still--- pre-build the map on partial application via 'Data.Range.inRanges'.-instance Functor Ranges where- fmap f r = Ranges (fmap (fmap f) (unRanges r)) Nothing+-- ---------------------------------------------------------------------------+-- Construction operators+-- --------------------------------------------------------------------------- --- | Mathematically equivalent to @[x, y]@. See 'R.+=+' for details.+-- | Mathematically equivalent to @[x, y]@. See 'SpanRange' for the+-- underlying constructor.+--+-- >>> 1 +=+ 5 :: Ranges Integer+-- Ranges [1 +=+ 5] (+=+) :: Ord a => a -> a -> Ranges a-(+=+) a b = mkRanges . pure $ (R.+=+) a b+(+=+) a b = mkRanges [(Op.+=+) a b] --- | Mathematically equivalent to @[x, y)@. See 'R.+=*' for details.+-- | Mathematically equivalent to @[x, y)@.+--+-- >>> 1 +=* 5 :: Ranges Integer+-- Ranges [1 +=* 5] (+=*) :: Ord a => a -> a -> Ranges a-(+=*) a b = mkRanges . pure $ (R.+=*) a b+(+=*) a b = mkRanges [(Op.+=*) a b] --- | Mathematically equivalent to @(x, y]@. See 'R.*=+' for details.+-- | Mathematically equivalent to @(x, y]@.+--+-- >>> 1 *=+ 5 :: Ranges Integer+-- Ranges [1 *=+ 5] (*=+) :: Ord a => a -> a -> Ranges a-(*=+) a b = mkRanges . pure $ (R.*=+) a b+(*=+) a b = mkRanges [(Op.*=+) a b] --- | Mathematically equivalent to @(x, y)@. See 'R.*=*' for details.+-- | Mathematically equivalent to @(x, y)@.+--+-- >>> 1 *=* 5 :: Ranges Integer+-- Ranges [1 *=* 5] (*=*) :: Ord a => a -> a -> Ranges a-(*=*) a b = mkRanges . pure $ (R.*=*) a b+(*=*) a b = mkRanges [(Op.*=*) a b] --- | Mathematically equivalent to @[x, ∞)@. See 'R.lbi' for details.+-- | Mathematically equivalent to @[x, ∞)@.+--+-- >>> lbi 5 :: Ranges Integer+-- Ranges [lbi 5] lbi :: Ord a => a -> Ranges a-lbi = mkRanges . pure . R.lbi+lbi = mkRanges . (:[]) . Op.lbi --- | Mathematically equivalent to @(x, ∞)@. See 'R.lbe' for details.+-- | Mathematically equivalent to @(x, ∞)@. lbe :: Ord a => a -> Ranges a-lbe = mkRanges . pure . R.lbe+lbe = mkRanges . (:[]) . Op.lbe --- | Mathematically equivalent to @(−∞, x]@. See 'R.ubi' for details.+-- | Mathematically equivalent to @(−∞, x]@. ubi :: Ord a => a -> Ranges a-ubi = mkRanges . pure . R.ubi+ubi = mkRanges . (:[]) . Op.ubi --- | Mathematically equivalent to @(−∞, x)@. See 'R.ube' for details.+-- | Mathematically equivalent to @(−∞, x)@. ube :: Ord a => a -> Ranges a-ube = mkRanges . pure . R.ube+ube = mkRanges . (:[]) . Op.ube --- | The infinite range, covering all values. See 'R.inf' for details.+-- | The infinite range, covering all values. inf :: Ord a => Ranges a-inf = mkRanges [R.inf]+inf = mkRanges [Op.inf] +-- ---------------------------------------------------------------------------+-- Single-range predicates+-- ---------------------------------------------------------------------------++-- | Returns 'True' if the value falls within the single range.+-- Respects 'Inclusive' and 'Exclusive' bounds.+--+-- See 'inRanges' for testing against a 'Ranges' collection.+--+-- >>> inRange (SpanRange (Bound 1 Inclusive) (Bound 10 Inclusive)) (5 :: Integer)+-- True+-- >>> inRange (SpanRange (Bound 1 Inclusive) (Bound 10 Exclusive)) (10 :: Integer)+-- False+inRange :: Ord a => Range a -> a -> Bool+inRange (SingletonRange a) value = value == a+inRange (SpanRange x y) value = Overlap == boundIsBetween (Bound value Inclusive) (x, y)+inRange (LowerBoundRange lower) value = Overlap == againstLowerBound (Bound value Inclusive) lower+inRange (UpperBoundRange upper) value = Overlap == againstUpperBound (Bound value Inclusive) upper+inRange InfiniteRange _ = True++-- | Returns 'True' if the value is strictly above (greater than the upper+-- bound of) the given range.+--+-- >>> aboveRange (SpanRange (Bound 1 Inclusive) (Bound 5 Inclusive)) (6 :: Integer)+-- True+-- >>> aboveRange (LowerBoundRange (Bound 0 Inclusive)) (6 :: Integer)+-- False+aboveRange :: Ord a => Range a -> a -> Bool+aboveRange (SingletonRange a) value = value > a+aboveRange (SpanRange _ y) value = Overlap == againstLowerBound (Bound value Inclusive) (invertBound y)+aboveRange (LowerBoundRange _) _ = False+aboveRange (UpperBoundRange upper) value = Overlap == againstLowerBound (Bound value Inclusive) (invertBound upper)+aboveRange InfiniteRange _ = False++-- | Returns 'True' if the value is strictly below (less than the lower+-- bound of) the given range.+--+-- >>> belowRange (SpanRange (Bound 1 Inclusive) (Bound 5 Inclusive)) (0 :: Integer)+-- True+-- >>> belowRange (UpperBoundRange (Bound 6 Inclusive)) (0 :: Integer)+-- False+belowRange :: Ord a => Range a -> a -> Bool+belowRange (SingletonRange a) value = value < a+belowRange (SpanRange x _) value = Overlap == againstUpperBound (Bound value Inclusive) (invertBound x)+belowRange (LowerBoundRange lower) value = Overlap == againstUpperBound (Bound value Inclusive) (invertBound lower)+belowRange (UpperBoundRange _) _ = False+belowRange InfiniteRange _ = False++-- | Returns 'True' if two ranges share at least one value.+--+-- >>> rangesOverlap (SpanRange (Bound 1 Inclusive) (Bound 5 Inclusive)) (SpanRange (Bound 3 Inclusive) (Bound 7 Inclusive) :: Range Integer)+-- True+-- >>> rangesOverlap (SpanRange (Bound 1 Inclusive) (Bound 5 Exclusive)) (SpanRange (Bound 5 Inclusive) (Bound 7 Inclusive) :: Range Integer)+-- False+rangesOverlap :: Ord a => Range a -> Range a -> Bool+rangesOverlap a b = Overlap == rangesOverlapType a b++-- | Returns 'True' if two ranges touch at a single exclusive boundary but+-- share no values.+--+-- >>> rangesAdjoin (SpanRange (Bound 1 Inclusive) (Bound 5 Exclusive)) (SpanRange (Bound 5 Inclusive) (Bound 7 Inclusive) :: Range Integer)+-- True+-- >>> rangesAdjoin (SpanRange (Bound 1 Inclusive) (Bound 5 Inclusive)) (SpanRange (Bound 3 Inclusive) (Bound 7 Inclusive) :: Range Integer)+-- False+rangesAdjoin :: Ord a => Range a -> Range a -> Bool+rangesAdjoin a b = Adjoin == rangesOverlapType a b++rangesOverlapType :: Ord a => Range a -> Range a -> OverlapType+rangesOverlapType (SingletonRange a) x =+ rangesOverlapType (SpanRange (Bound a Inclusive) (Bound a Inclusive)) x+rangesOverlapType (SpanRange x y) (SpanRange a b) = boundsOverlapType (x, y) (a, b)+rangesOverlapType (SpanRange _ y) (LowerBoundRange lower) = againstLowerBound y lower+rangesOverlapType (SpanRange x _) (UpperBoundRange upper) = againstUpperBound x upper+rangesOverlapType (LowerBoundRange _) (LowerBoundRange _) = Overlap+rangesOverlapType (LowerBoundRange lo) (UpperBoundRange up) = againstUpperBound lo up+rangesOverlapType (UpperBoundRange _) (UpperBoundRange _) = Overlap+rangesOverlapType InfiniteRange _ = Overlap+rangesOverlapType a b = rangesOverlapType b a++-- ---------------------------------------------------------------------------+-- Multi-range predicates+-- ---------------------------------------------------------------------------+ -- | Returns 'True' if the value falls within any of the given ranges. ----- The lookup structure is pre-built when the 'Ranges' value is constructed,--- so each membership test is O(log n) where n is the number of spans.--- Partial application is idiomatic:+-- The membership predicate is pre-built when the 'Ranges' value is+-- constructed, so each call is O(log n) in the number of spans. Partial+-- application is idiomatic: -- -- @ -- let memberOf = inRanges myRanges@@ -179,69 +369,111 @@ -- >>> inRanges (1 +=+ 10 <> 20 +=+ 30 :: Ranges Integer) 15 -- False inRanges :: Ord a => Ranges a -> a -> Bool-inRanges r = case _rangesQuery r of- Just f -> f- Nothing -> R.inRanges (unRanges r)+inRanges = _rangesQuery --- | Returns 'True' if the value is strictly above (greater than the upper--- bound of) all of the given ranges.+-- | Returns 'True' if the value is strictly above all of the given ranges. --+-- This predicate is O(1): the answer is determined by the last element of the+-- canonical range list (which has the largest upper bound), cached at+-- construction time.+-- -- >>> aboveRanges (1 +=+ 5 <> 10 +=+ 15 :: Ranges Integer) 20 -- True -- >>> aboveRanges (1 +=+ 5 <> lbi 10 :: Ranges Integer) 20 -- False-aboveRanges :: (Ord a) => Ranges a -> a -> Bool-aboveRanges r a = R.aboveRanges (unRanges r) a+aboveRanges :: Ord a => Ranges a -> a -> Bool+aboveRanges = _aboveQuery --- | Returns 'True' if the value is strictly below (less than the lower--- bound of) all of the given ranges.+-- | Returns 'True' if the value is strictly below all of the given ranges. --+-- This predicate is O(1): the answer is determined by the first element of the+-- canonical range list (which has the smallest lower bound), cached at+-- construction time.+-- -- >>> belowRanges (5 +=+ 10 <> 20 +=+ 30 :: Ranges Integer) 1 -- True -- >>> belowRanges (ubi 10 <> 20 +=+ 30 :: Ranges Integer) 1 -- False-belowRanges :: (Ord a) => Ranges a -> a -> Bool-belowRanges r a = R.belowRanges (unRanges r) a+belowRanges :: Ord a => Ranges a -> a -> Bool+belowRanges = _belowQuery --- | Set union of two 'Ranges'. The output is in merged canonical form.--- Equivalent to @('<>')@.-union :: (Ord a) => Ranges a -> Ranges a -> Ranges a-union a b = mkRanges $ R.union (unRanges a) (unRanges b)+-- ---------------------------------------------------------------------------+-- Set operations+-- --------------------------------------------------------------------------- --- | Set intersection of two 'Ranges'. Returns only values present in both.+-- | Canonicalise a raw list of 'Range' values into a 'Ranges'. Overlapping+-- ranges are merged; the result is sorted and non-overlapping. --+-- >>> mergeRanges [LowerBoundRange (Bound 12 Inclusive), SpanRange (Bound 1 Inclusive) (Bound 10 Inclusive), SpanRange (Bound 5 Inclusive) (Bound 15 Inclusive) :: Range Integer]+-- Ranges [lbi 1]+mergeRanges :: Ord a => [Range a] -> Ranges a+mergeRanges = mkRanges++-- | Set union. Equivalent to @('<>')@.+--+-- >>> union (1 +=+ 10) (5 +=+ 15 :: Ranges Integer)+-- Ranges [1 +=+ 15]+union :: Ord a => Ranges a -> Ranges a -> Ranges a+union a b = mkRanges $ Alg.eval $+ Alg.union (Alg.const (unRanges a)) (Alg.const (unRanges b))++-- | Set intersection. Returns only values present in both.+-- -- >>> intersection (1 +=+ 10) (5 +=+ 15 :: Ranges Integer) -- Ranges [5 +=+ 10]-intersection :: (Ord a) => Ranges a -> Ranges a -> Ranges a-intersection a b = mkRanges $ R.intersection (unRanges a) (unRanges b)+intersection :: Ord a => Ranges a -> Ranges a -> Ranges a+intersection a b = mkRanges $ Alg.eval $+ Alg.intersection (Alg.const (unRanges a)) (Alg.const (unRanges b)) --- | Set difference: values in the first 'Ranges' that are not in the second.+-- | Set difference: values in the first 'Ranges' not in the second. -- -- >>> difference (1 +=+ 10) (5 +=+ 15 :: Ranges Integer) -- Ranges [1 +=* 5]-difference :: (Ord a) => Ranges a -> Ranges a -> Ranges a-difference a b = mkRanges $ R.difference (unRanges a) (unRanges b)+difference :: Ord a => Ranges a -> Ranges a -> Ranges a+difference a b = mkRanges $ Alg.eval $+ Alg.difference (Alg.const (unRanges a)) (Alg.const (unRanges b)) --- | Returns the complement of the given 'Ranges': all values /not/ covered.--- Note that @'invert' . 'invert' == 'id'@.-invert :: (Ord a) => Ranges a -> Ranges a-invert = mkRanges . R.invert . unRanges+-- | Complement: all values /not/ covered by the given 'Ranges'.+-- @'invert' . 'invert' == 'id'@.+--+-- >>> invert (1 +=* 10 <> 15 *=+ 20 :: Ranges Integer)+-- Ranges [ube 1,10 +=+ 15,lbe 20]+invert :: Ord a => Ranges a -> Ranges a+invert = mkRanges . Alg.eval . Alg.invert . Alg.const . unRanges --- | Instantiates all values covered by the ranges as a list.--- __Warning:__ This is a convenience function and is not efficient. Prefer--- membership checks with 'inRanges' where possible. Combine with 'take' to--- avoid evaluating infinite ranges.+-- ---------------------------------------------------------------------------+-- Enumerable methods+-- ---------------------------------------------------------------------------++-- | Instantiate all values covered by the ranges as a list.+-- __Warning:__ not efficient. Prefer 'inRanges' for membership tests.+-- Combine with 'take' to avoid evaluating infinite ranges. --+-- >>> take 5 . fromRanges $ (1 +=+ 10 :: Ranges Integer)+-- [1,2,3,4,5]+-- -- >>> take 6 . fromRanges $ (1 +=+ 3 :: Ranges Integer) <> (10 +=+ 12) -- [1,10,2,11,3,12] fromRanges :: (Ord a, Enum a) => Ranges a -> [a]-fromRanges = R.fromRanges . unRanges+fromRanges = takeEvenly . fmap fromRange . unRanges+ where+ fromRange (SingletonRange x) = [x]+ fromRange (SpanRange (Bound a aType) (Bound b bType)) =+ [ (if aType == Inclusive then a else succ a)+ .. (if bType == Inclusive then b else pred b) ]+ fromRange (LowerBoundRange (Bound x xType)) =+ iterate succ (if xType == Inclusive then x else succ x)+ fromRange (UpperBoundRange (Bound x xType)) =+ iterate pred (if xType == Inclusive then x else pred x)+ fromRange InfiniteRange =+ zero : takeEvenly [iterate succ (succ zero), iterate pred (pred zero)]+ where zero = toEnum 0 --- | Joins adjacent ranges that are contiguous for 'Enum' types. For example,--- @[1 +=+ 5, 6 +=+ 10]@ can be collapsed to @[1 +=+ 10]@ for 'Integer'--- because there is no integer between 5 and 6.+-- | Join adjacent ranges that are contiguous for 'Enum' types.+-- For example, @[1 +=+ 5, 6 +=+ 10]@ collapses to @[1 +=+ 10]@ for+-- 'Integer' because there is no integer between 5 and 6. -- -- >>> joinRanges (mconcat [1 +=+ 5, 6 +=+ 10] :: Ranges Integer) -- Ranges [1 +=+ 10] joinRanges :: (Ord a, Enum a) => Ranges a -> Ranges a-joinRanges = mkRanges . R.joinRanges . unRanges+joinRanges = mkRanges . exportRangeMerge . joinRM . loadRanges . unRanges
Test/Generators.hs view
@@ -7,9 +7,12 @@ import Test.QuickCheck import Control.Monad (liftM) -import Data.Range+import Data.Ranges import qualified Data.Range.Algebra as Alg +instance Arbitrary BoundType where+ arbitrary = elements [Inclusive, Exclusive]+ instance (Num a, Integral a, Ord a, Enum a) => Arbitrary (Range a) where arbitrary = oneof [ generateSingleton@@ -21,13 +24,24 @@ where generateSingleton = liftM SingletonRange arbitrarySizedIntegral generateSpan = do- first <- arbitrarySizedIntegral- second <- arbitrarySizedIntegral `suchThat` (> first)- return $ first +=+ second- generateLowerBound = liftM lbi arbitrarySizedIntegral- generateUpperBound = liftM ubi arbitrarySizedIntegral+ first <- arbitrarySizedIntegral+ second <- arbitrarySizedIntegral `suchThat` (> first)+ loBound <- arbitrary+ hiBound <- arbitrary+ return $ SpanRange (Bound first loBound) (Bound second hiBound)+ generateLowerBound = do+ x <- arbitrarySizedIntegral+ bound <- arbitrary+ return $ LowerBoundRange (Bound x bound)+ generateUpperBound = do+ x <- arbitrarySizedIntegral+ bound <- arbitrary+ return $ UpperBoundRange (Bound x bound) generateInfiniteRange :: Gen (Range a) generateInfiniteRange = return InfiniteRange++instance (Num a, Integral a, Ord a, Enum a) => Arbitrary (Ranges a) where+ arbitrary = mergeRanges <$> listOf arbitrary instance (Num a, Integral a, Ord a, Enum a) => Arbitrary (Alg.RangeExpr [Range a]) where arbitrary = frequency
Test/Range.hs view
@@ -4,19 +4,20 @@ module Main where -import Test.Framework (defaultMain, testGroup)+import Test.Framework (Test, defaultMain, testGroup) import Test.QuickCheck import Test.Framework.Providers.QuickCheck2 import System.Random -import Data.Range+import Data.Ranges import qualified Data.Range.Algebra as Alg import Test.RangeMerge import Test.RangeLaws import Test.RangeParser import Test.RangeOrd+import Test.RangeBounds import Test.Generators () data UnequalPair a = UnequalPair (a, a)@@ -50,9 +51,10 @@ prop_infinite_range_contains_everything :: Integer -> Bool prop_infinite_range_contains_everything = inRange InfiniteRange +tests_inRange :: Test tests_inRange = testGroup "inRange Function" [ testProperty "equal singletons in range" prop_singleton_in_range- , testProperty "unequal singletons not in range" prop_singleton_not_in_range+ , testProperty "unequal singletons not in range" (prop_singleton_not_in_range :: UnequalPair Integer -> Bool) , testProperty "spans contain values in their middles" prop_span_contains , testProperty "infinite ranges contain everything" prop_infinite_range_contains_everything ]@@ -64,10 +66,11 @@ -- (1, 3) intersection (3, 4) = (3, 3) -- ((1, 3) intersection (3, 4)) union (3, 4) => (3, 4) -prop_in_range_out_of_range_after_invert :: (Integer, [Range Integer]) -> Bool+prop_in_range_out_of_range_after_invert :: (Integer, Ranges Integer) -> Bool prop_in_range_out_of_range_after_invert (point, ranges) = (inRanges ranges point) /= (inRanges (invert ranges) point) +test_ranges_invert :: Test test_ranges_invert = testGroup "invert function for ranges" [ testProperty "element in range is now out of range after invert" prop_in_range_out_of_range_after_invert ]@@ -75,14 +78,15 @@ prop_equivalence_eval_and_evalPredicate :: ([Integer], Alg.RangeExpr [Range Integer]) -> Bool prop_equivalence_eval_and_evalPredicate (points, expr) = actual == expected where- actual = map (inRanges $ Alg.eval expr) points- expected = map (Alg.eval $ fmap inRanges expr) points+ actual = map (inRanges (mergeRanges (Alg.eval expr))) points+ expected = map (Alg.eval (fmap (inRanges . mergeRanges) expr)) points +test_algebra_equivalence :: Test test_algebra_equivalence = testGroup "algebra equivalence" [ testProperty "eval and evalPredicate" prop_equivalence_eval_and_evalPredicate ] ---tests :: [Test]+tests :: [Test] tests = [ tests_inRange , test_ranges_invert@@ -92,5 +96,7 @@ ++ rangeLawTestCases ++ rangeParserTestCases ++ rangeOrdTestCases+ ++ rangeBoundsTestCases +main :: IO () main = defaultMain tests
+ Test/RangeBounds.hs view
@@ -0,0 +1,123 @@+module Test.RangeBounds+ ( rangeBoundsTestCases+ ) where++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck (Positive(..), Property, (==>))++import Data.Ranges+import Test.Generators ()++-- ---------------------------------------------------------------------------+-- inRange: exclusive vs inclusive endpoint behaviour+-- ---------------------------------------------------------------------------++-- Exclusive lower bound: the boundary value itself is NOT in the range.+prop_exclusive_lower_excludes_endpoint :: Positive Integer -> Bool+prop_exclusive_lower_excludes_endpoint (Positive x) =+ not $ inRange (SpanRange (Bound x Exclusive) (Bound (x + 10) Inclusive)) x++-- Inclusive lower bound: the boundary value IS in the range.+prop_inclusive_lower_includes_endpoint :: Positive Integer -> Bool+prop_inclusive_lower_includes_endpoint (Positive x) =+ inRange (SpanRange (Bound x Inclusive) (Bound (x + 10) Inclusive)) x++-- Exclusive upper bound: the boundary value itself is NOT in the range.+prop_exclusive_upper_excludes_endpoint :: Positive Integer -> Bool+prop_exclusive_upper_excludes_endpoint (Positive x) =+ not $ inRange (SpanRange (Bound x Inclusive) (Bound (x + 10) Exclusive)) (x + 10)++-- Inclusive upper bound: the boundary value IS in the range.+prop_inclusive_upper_includes_endpoint :: Positive Integer -> Bool+prop_inclusive_upper_includes_endpoint (Positive x) =+ inRange (SpanRange (Bound x Inclusive) (Bound (x + 10) Inclusive)) (x + 10)++test_inrange_endpoints :: Test+test_inrange_endpoints = testGroup "inRange endpoint inclusion"+ [ testProperty "exclusive lower bound excludes endpoint" prop_exclusive_lower_excludes_endpoint+ , testProperty "inclusive lower bound includes endpoint" prop_inclusive_lower_includes_endpoint+ , testProperty "exclusive upper bound excludes endpoint" prop_exclusive_upper_excludes_endpoint+ , testProperty "inclusive upper bound includes endpoint" prop_inclusive_upper_includes_endpoint+ ]++-- ---------------------------------------------------------------------------+-- aboveRange / belowRange: exclusive bound semantics+-- ---------------------------------------------------------------------------++-- A value equal to an exclusive upper bound is ABOVE the range+-- (the range ends strictly before that value).+prop_above_exclusive_upper :: Positive Integer -> Bool+prop_above_exclusive_upper (Positive x) =+ aboveRange (SpanRange (Bound x Inclusive) (Bound (x + 10) Exclusive)) (x + 10)++-- A value equal to an exclusive lower bound is BELOW the range+-- (the range starts strictly after that value).+prop_below_exclusive_lower :: Positive Integer -> Bool+prop_below_exclusive_lower (Positive x) =+ belowRange (SpanRange (Bound x Exclusive) (Bound (x + 10) Inclusive)) x++test_above_below_exclusive :: Test+test_above_below_exclusive = testGroup "aboveRange/belowRange with exclusive bounds"+ [ testProperty "value at exclusive upper bound is above range" prop_above_exclusive_upper+ , testProperty "value at exclusive lower bound is below range" prop_below_exclusive_lower+ ]++-- ---------------------------------------------------------------------------+-- Half-infinite ranges: exclusive bounds+-- ---------------------------------------------------------------------------++-- lbe: exclusive lower bound does not include the endpoint but includes succ+prop_lbe_excludes_endpoint :: Integer -> Bool+prop_lbe_excludes_endpoint x =+ not (inRange (LowerBoundRange (Bound x Exclusive)) x)+ && inRange (LowerBoundRange (Bound x Exclusive)) (x + 1)++-- ube: exclusive upper bound does not include the endpoint but includes pred+prop_ube_excludes_endpoint :: Integer -> Bool+prop_ube_excludes_endpoint x =+ not (inRange (UpperBoundRange (Bound x Exclusive)) x)+ && inRange (UpperBoundRange (Bound x Exclusive)) (x - 1)++test_halfinfinte_exclusive :: Test+test_halfinfinte_exclusive = testGroup "half-infinite exclusive bounds"+ [ testProperty "lbe excludes endpoint, includes successor" prop_lbe_excludes_endpoint+ , testProperty "ube excludes endpoint, includes predecessor" prop_ube_excludes_endpoint+ ]++-- ---------------------------------------------------------------------------+-- Mutual exclusion: belowRanges / inRanges / aboveRanges+-- ---------------------------------------------------------------------------++-- For any point and any non-empty Ranges, no two of below/in/above can be+-- simultaneously true. (A point in the gap between disjoint ranges is none+-- of the three — that is also correct.)+--+-- The non-empty guard is necessary: for Ranges [], belowRanges and aboveRanges+-- both return True vacuously (there are no ranges to fail to be above/below),+-- so the mutual-exclusion invariant only holds for non-empty range sets.+prop_below_in_above_mutually_exclusive :: (Integer, Ranges Integer) -> Property+prop_below_in_above_mutually_exclusive (x, rs) =+ not (null (unRanges rs)) ==>+ let b = belowRanges rs x+ i = inRanges rs x+ a = aboveRanges rs x+ in not (b && i) && not (a && i) && not (b && a)++test_partition :: Test+test_partition = testGroup "below/in/above mutual exclusion"+ [ testProperty "at most one of belowRanges/inRanges/aboveRanges holds"+ prop_below_in_above_mutually_exclusive+ ]++-- ---------------------------------------------------------------------------+-- Export+-- ---------------------------------------------------------------------------++rangeBoundsTestCases :: [Test]+rangeBoundsTestCases =+ [ test_inrange_endpoints+ , test_above_below_exclusive+ , test_halfinfinte_exclusive+ , test_partition+ ]
Test/RangeLaws.hs view
@@ -3,37 +3,33 @@ ) where import Test.Framework (Test, testGroup)-import Test.QuickCheck+import Test.QuickCheck () import Test.Framework.Providers.QuickCheck2 -import Data.Range+import Data.Ranges import Test.Generators () -- --------------------------------------------------------------------------- -- Helpers -- --------------------------------------------------------------------------- --- Sort before comparing so that order differences don't cause false failures.--- mergeRanges produces a canonical form, so we use it to normalise both sides.-canonical :: Ord a => [Range a] -> [Range a]-canonical = mergeRanges--eq :: (Ord a) => [Range a] -> [Range a] -> Bool-eq a b = canonical a == canonical b+-- Ranges is always in canonical form; compare the underlying lists.+eq :: Ord a => Ranges a -> Ranges a -> Bool+eq a b = unRanges a == unRanges b -- --------------------------------------------------------------------------- -- Idempotency -- --------------------------------------------------------------------------- -prop_mergeRanges_idempotent :: [Range Integer] -> Bool+prop_mergeRanges_idempotent :: Ranges Integer -> Bool prop_mergeRanges_idempotent xs =- mergeRanges (mergeRanges xs) == mergeRanges xs+ mergeRanges (unRanges xs) `eq` xs -prop_union_idempotent :: [Range Integer] -> Bool+prop_union_idempotent :: Ranges Integer -> Bool prop_union_idempotent xs = union xs xs `eq` xs -prop_intersection_idempotent :: [Range Integer] -> Bool+prop_intersection_idempotent :: Ranges Integer -> Bool prop_intersection_idempotent xs = intersection xs xs `eq` xs @@ -48,11 +44,11 @@ -- Commutativity -- --------------------------------------------------------------------------- -prop_union_commutative :: ([Range Integer], [Range Integer]) -> Bool+prop_union_commutative :: (Ranges Integer, Ranges Integer) -> Bool prop_union_commutative (a, b) = union a b `eq` union b a -prop_intersection_commutative :: ([Range Integer], [Range Integer]) -> Bool+prop_intersection_commutative :: (Ranges Integer, Ranges Integer) -> Bool prop_intersection_commutative (a, b) = intersection a b `eq` intersection b a @@ -66,11 +62,11 @@ -- Associativity -- --------------------------------------------------------------------------- -prop_union_associative :: ([Range Integer], [Range Integer], [Range Integer]) -> Bool+prop_union_associative :: (Ranges Integer, Ranges Integer, Ranges Integer) -> Bool prop_union_associative (a, b, c) = union (union a b) c `eq` union a (union b c) -prop_intersection_associative :: ([Range Integer], [Range Integer], [Range Integer]) -> Bool+prop_intersection_associative :: (Ranges Integer, Ranges Integer, Ranges Integer) -> Bool prop_intersection_associative (a, b, c) = intersection (intersection a b) c `eq` intersection a (intersection b c) @@ -85,12 +81,12 @@ -- --------------------------------------------------------------------------- prop_intersection_distributes_over_union- :: ([Range Integer], [Range Integer], [Range Integer]) -> Bool+ :: (Ranges Integer, Ranges Integer, Ranges Integer) -> Bool prop_intersection_distributes_over_union (a, b, c) = intersection a (union b c) `eq` union (intersection a b) (intersection a c) prop_union_distributes_over_intersection- :: ([Range Integer], [Range Integer], [Range Integer]) -> Bool+ :: (Ranges Integer, Ranges Integer, Ranges Integer) -> Bool prop_union_distributes_over_intersection (a, b, c) = union a (intersection b c) `eq` intersection (union a b) (union a c) @@ -106,32 +102,28 @@ -- Identity laws -- --------------------------------------------------------------------------- --- The empty range list acts as the identity for union-prop_union_identity_empty :: [Range Integer] -> Bool+prop_union_identity_empty :: Ranges Integer -> Bool prop_union_identity_empty xs =- union xs [] `eq` xs+ union xs mempty `eq` xs --- InfiniteRange acts as the identity for intersection-prop_intersection_identity_infinite :: [Range Integer] -> Bool+prop_intersection_identity_infinite :: Ranges Integer -> Bool prop_intersection_identity_infinite xs =- intersection xs [InfiniteRange] `eq` xs+ intersection xs inf `eq` xs --- Union with InfiniteRange absorbs everything-prop_union_absorb_infinite :: [Range Integer] -> Bool+prop_union_absorb_infinite :: Ranges Integer -> Bool prop_union_absorb_infinite xs =- union xs [InfiniteRange] `eq` [InfiniteRange]+ union xs inf `eq` inf --- Intersection with empty absorbs everything-prop_intersection_absorb_empty :: [Range Integer] -> Bool+prop_intersection_absorb_empty :: Ranges Integer -> Bool prop_intersection_absorb_empty xs =- intersection xs [] `eq` []+ intersection xs mempty `eq` mempty test_identity_absorption :: Test test_identity_absorption = testGroup "identity and absorption"- [ testProperty "union with [] is identity" prop_union_identity_empty- , testProperty "intersection with InfiniteRange is identity" prop_intersection_identity_infinite- , testProperty "union with InfiniteRange absorbs" prop_union_absorb_infinite- , testProperty "intersection with [] absorbs" prop_intersection_absorb_empty+ [ testProperty "union with mempty is identity" prop_union_identity_empty+ , testProperty "intersection with inf is identity" prop_intersection_identity_infinite+ , testProperty "union with inf absorbs" prop_union_absorb_infinite+ , testProperty "intersection with mempty absorbs" prop_intersection_absorb_empty ] -- ---------------------------------------------------------------------------@@ -139,7 +131,7 @@ -- --------------------------------------------------------------------------- prop_difference_eq_intersection_invert- :: ([Range Integer], [Range Integer]) -> Bool+ :: (Ranges Integer, Ranges Integer) -> Bool prop_difference_eq_intersection_invert (a, b) = difference a b `eq` intersection a (invert b) @@ -153,7 +145,7 @@ -- Double inversion -- --------------------------------------------------------------------------- -prop_invert_twice_identity :: [Range Integer] -> Bool+prop_invert_twice_identity :: Ranges Integer -> Bool prop_invert_twice_identity xs = invert (invert xs) `eq` xs
Test/RangeMerge.hs view
@@ -5,7 +5,7 @@ ( rangeMergeTestCases ) where -import Test.Framework (testGroup)+import Test.Framework (Test, testGroup) import Test.QuickCheck import Test.Framework.Providers.QuickCheck2 @@ -66,6 +66,7 @@ prop_export_load_is_identity :: RangeMerge Integer -> Bool prop_export_load_is_identity x = loadRanges (exportRangeMerge x) == x +test_loadRM :: Test test_loadRM = testGroup "loadRanges function" [ testProperty "loading export results in identity" prop_export_load_is_identity ]@@ -73,6 +74,7 @@ prop_invert_twice_is_identity :: RangeMerge Integer -> Bool prop_invert_twice_is_identity x = (invertRM . invertRM $ x) == x +test_invertRM :: Test test_invertRM = testGroup "invertRM function" [ testProperty "inverting twice results in identity" prop_invert_twice_is_identity ]@@ -83,6 +85,7 @@ prop_union_with_infinite_is_infinite :: RangeMerge Integer -> Bool prop_union_with_infinite_is_infinite rm = (rm `unionRangeMerges` IRM) == IRM +test_unionRM :: Test test_unionRM = testGroup "unionRangeMerges function" [ testProperty "Union with empty is self" prop_union_with_empty_is_self , testProperty "Union with infinite is infinite" prop_union_with_infinite_is_infinite@@ -96,6 +99,7 @@ prop_intersection_with_infinite_is_self rm = (rm `intersectionRangeMerges` IRM) == rm +test_intersectionRM :: Test test_intersectionRM = testGroup "intersectionRangeMerges function" [ testProperty "Intersection with empty is empty" prop_intersection_with_empty_is_empty , testProperty "Intersection with infinite is self" prop_intersection_with_infinite_is_self@@ -109,11 +113,13 @@ prop_demorgans_law_two (a, b) = (invertRM (a `intersectionRangeMerges` b)) == ((invertRM a) `unionRangeMerges` (invertRM b)) +test_complex_laws :: Test test_complex_laws = testGroup "complex set theory rules" [ testProperty "DeMorgan Part 1: not (a or b) == (not a) and (not b)" (verboseShrinking (withMaxSuccess 10000 prop_demorgans_law_one)) , testProperty "DeMorgan Part 2: not (a and b) == (not a) or (not b)" (verboseShrinking (withMaxSuccess 10000 prop_demorgans_law_two)) ] +rangeMergeTestCases :: [Test] rangeMergeTestCases = [ test_loadRM , test_invertRM
Test/RangeOrd.hs view
@@ -2,20 +2,44 @@ ( rangeOrdTestCases ) where -import Data.List (sort, sortOn)+import Data.List (sortOn) import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck+import Test.QuickCheck () -import Data.Range+import Data.Ranges import Data.Range.Ord import Test.Generators () -- ---------------------------------------------------------------------------+-- Local helpers — the module-level operators now return Ranges, not Range+-- ---------------------------------------------------------------------------++-- | Inclusive span Range+spanI :: a -> a -> Range a+spanI a b = SpanRange (Bound a Inclusive) (Bound b Inclusive)++-- | Lower bound inclusive Range+lbiR :: a -> Range a+lbiR x = LowerBoundRange (Bound x Inclusive)++-- | Upper bound inclusive Range+ubiR :: a -> Range a+ubiR x = UpperBoundRange (Bound x Inclusive)++-- | Upper bound exclusive Range+ubeR :: a -> Range a+ubeR x = UpperBoundRange (Bound x Exclusive)++-- | Infinite Range+infR :: Range a+infR = InfiniteRange++-- --------------------------------------------------------------------------- -- Helpers -- --------------------------------------------------------------------------- @@ -35,19 +59,19 @@ -- UpperBoundRange < InfiniteRange prop_key_constructor_singleton_lt_span :: Bool prop_key_constructor_singleton_lt_span =- KeyRange (SingletonRange (0 :: Integer)) < KeyRange (0 +=+ 0)+ KeyRange (SingletonRange (0 :: Integer)) < KeyRange (spanI 0 0) prop_key_constructor_span_lt_lower :: Bool prop_key_constructor_span_lt_lower =- KeyRange (0 +=+ (0 :: Integer)) < KeyRange (lbi 0)+ KeyRange (spanI 0 (0 :: Integer)) < KeyRange (lbiR 0) prop_key_constructor_lower_lt_upper :: Bool prop_key_constructor_lower_lt_upper =- KeyRange (lbi (0 :: Integer)) < KeyRange (ubi 0)+ KeyRange (lbiR (0 :: Integer)) < KeyRange (ubiR 0) prop_key_constructor_upper_lt_infinite :: Bool prop_key_constructor_upper_lt_infinite =- KeyRange (ubi (0 :: Integer)) < KeyRange (inf :: Range Integer)+ KeyRange (ubiR (0 :: Integer)) < KeyRange (infR :: Range Integer) -- Within the same constructor, compare by fields prop_key_singletons_by_value :: Bool@@ -56,23 +80,23 @@ prop_key_spans_by_lower_first :: Bool prop_key_spans_by_lower_first =- KeyRange ((1 :: Integer) +=+ 10) < KeyRange (2 +=+ 10)+ KeyRange (spanI (1 :: Integer) 10) < KeyRange (spanI 2 10) prop_key_spans_by_upper_on_equal_lower :: Bool prop_key_spans_by_upper_on_equal_lower =- KeyRange ((1 :: Integer) +=+ 5) < KeyRange (1 +=+ 10)+ KeyRange (spanI (1 :: Integer) 5) < KeyRange (spanI 1 10) prop_key_lower_bounds_by_value :: Bool prop_key_lower_bounds_by_value =- KeyRange (lbi (1 :: Integer)) < KeyRange (lbi 2)+ KeyRange (lbiR (1 :: Integer)) < KeyRange (lbiR 2) prop_key_upper_bounds_by_value :: Bool prop_key_upper_bounds_by_value =- KeyRange (ubi (1 :: Integer)) < KeyRange (ubi 2)+ KeyRange (ubiR (1 :: Integer)) < KeyRange (ubiR 2) prop_key_infinite_eq_infinite :: Bool prop_key_infinite_eq_infinite =- compare (KeyRange (inf :: Range Integer)) (KeyRange inf) == EQ+ compare (KeyRange (infR :: Range Integer)) (KeyRange infR) == EQ test_keyrange_unit :: Test test_keyrange_unit = testGroup "KeyRange unit"@@ -132,11 +156,11 @@ -- Ranges with NegInfinity lower bound sort before those with a finite lower bound prop_sorted_upper_before_span :: Bool prop_sorted_upper_before_span =- SortedRange (ubi (0 :: Integer)) < SortedRange (lbi 0)+ SortedRange (ubiR (0 :: Integer)) < SortedRange (lbiR 0) prop_sorted_infinite_before_lower :: Bool prop_sorted_infinite_before_lower =- SortedRange (inf :: Range Integer) < SortedRange (lbi 1)+ SortedRange (infR :: Range Integer) < SortedRange (lbiR 1) -- Spans ordered by lower bound prop_sorted_singletons_by_value :: Bool@@ -145,24 +169,24 @@ prop_sorted_spans_by_lower :: Bool prop_sorted_spans_by_lower =- SortedRange ((1 :: Integer) +=+ 10) < SortedRange (2 +=+ 10)+ SortedRange (spanI (1 :: Integer) 10) < SortedRange (spanI 2 10) -- When lower bounds are equal, tiebreak by upper bound (smaller upper = comes first) prop_sorted_tiebreak_by_upper :: Bool prop_sorted_tiebreak_by_upper =- SortedRange ((1 :: Integer) +=+ 5) < SortedRange (1 +=+ 10)+ SortedRange (spanI (1 :: Integer) 5) < SortedRange (spanI 1 10) -- InfiniteRange and UpperBoundRange both start at -∞; -- InfiniteRange ends at +∞ so it sorts after a finite UpperBoundRange prop_sorted_upper_before_infinite :: Bool prop_sorted_upper_before_infinite =- SortedRange (ubi (0 :: Integer)) < SortedRange (inf :: Range Integer)+ SortedRange (ubiR (0 :: Integer)) < SortedRange (infR :: Range Integer) -- The canonical display order: UpperBoundRange, SpanRange, LowerBoundRange prop_sorted_display_order :: Bool prop_sorted_display_order =- sortOn SortedRange [lbi 10, (1 :: Integer) +=+ 5, ube 0]- == [ube 0, 1 +=+ 5, lbi 10]+ sortOn SortedRange [lbiR 10, spanI (1 :: Integer) 5, ubeR 0]+ == [ubeR 0, spanI 1 5, lbiR 10] -- SingletonRange 5 and 5 +=+ 5 occupy the same position so compare as EQ prop_sorted_singleton_eq_degenerate_span :: Bool
Test/RangeParser.hs view
@@ -6,20 +6,21 @@ import Test.QuickCheck import Test.Framework.Providers.QuickCheck2 -import Data.Range+import Data.Ranges import Data.Range.Parser -- --------------------------------------------------------------------------- -- Helpers -- --------------------------------------------------------------------------- +-- | Check that parsing @input@ produces a 'Ranges' equal to @mergeRanges expected@. shouldParse :: String -> [Range Integer] -> Bool shouldParse input expected = case parseRanges input of- Right result -> result == expected+ Right result -> result == mergeRanges expected Left _ -> False shouldFail :: String -> Bool-shouldFail input = case (parseRanges input :: Either ParseError [Range Integer]) of+shouldFail input = case (parseRanges input :: Either ParseError (Ranges Integer)) of Left _ -> True Right _ -> False @@ -27,9 +28,6 @@ -- Haddock example tests -- --------------------------------------------------------------------------- --- The example from the module documentation:--- >>> parseRanges "-5,8-10,13-15,20-" :: Either ParseError [Range Integer]--- Right [UpperBoundRange 5,SpanRange 8 10,SpanRange 13 15,LowerBoundRange 20] prop_haddock_example :: Bool prop_haddock_example = shouldParse "-5,8-10,13-15,20-" [ UpperBoundRange (Bound 5 Inclusive)@@ -98,9 +96,9 @@ prop_parse_wildcard :: Bool prop_parse_wildcard = shouldParse "*" [InfiniteRange] +-- InfiniteRange absorbs everything; the canonical result is just inf. prop_parse_wildcard_in_union :: Bool-prop_parse_wildcard_in_union = shouldParse "*,5"- [InfiniteRange, SingletonRange 5]+prop_parse_wildcard_in_union = shouldParse "*,5" [InfiniteRange, SingletonRange 5] test_wildcard :: Test test_wildcard = testGroup "wildcard / infinite range"@@ -134,18 +132,18 @@ -- --------------------------------------------------------------------------- prop_empty_string_parses :: Bool-prop_empty_string_parses = case (parseRanges "" :: Either ParseError [Range Integer]) of- Right [] -> True- _ -> False+prop_empty_string_parses = case (parseRanges "" :: Either ParseError (Ranges Integer)) of+ Right result -> result == mempty+ _ -> False -- The parser uses sepBy which returns [] on no matches,--- so non-range input like "abc" or "-" parses as Right [].+-- so non-range input like "abc" parses as Right mempty. -- This is a known limitation of the current parser design. prop_non_range_input_parses_empty :: Bool prop_non_range_input_parses_empty =- case (parseRanges "abc" :: Either ParseError [Range Integer]) of- Right [] -> True- _ -> False+ case (parseRanges "abc" :: Either ParseError (Ranges Integer)) of+ Right result -> result == mempty+ _ -> False test_edge_cases :: Test test_edge_cases = testGroup "edge cases"@@ -154,15 +152,53 @@ ] -- ---------------------------------------------------------------------------+-- Invalid inputs (must fail)+--+-- The parser commits after consuming a union separator. If no valid range+-- follows the separator, it produces a Left rather than silently succeeding.+-- ---------------------------------------------------------------------------++-- "1," — trailing comma: separator consumed, then end-of-input reached+-- before the next range element.+prop_trailing_comma_fails :: Bool+prop_trailing_comma_fails = shouldFail "1,"++-- "1,2,3," — trailing comma after multiple valid ranges.+prop_trailing_comma_after_many_fails :: Bool+prop_trailing_comma_after_many_fails = shouldFail "1,2,3,"++-- "1,,2" — double comma: separator consumed, then another comma is found+-- where a range element is expected.+prop_double_comma_fails :: Bool+prop_double_comma_fails = shouldFail "1,,2"++-- "-" alone is the range separator with nothing on either side.+-- spanRange wraps in try so it backtracks; singletonRange needs digits.+-- The overall parser returns empty rather than failing (no input consumed).+-- This test documents that behaviour — it is NOT a failure case.+prop_bare_separator_parses_empty :: Bool+prop_bare_separator_parses_empty =+ case (parseRanges "-" :: Either ParseError (Ranges Integer)) of+ Right result -> result == mempty+ _ -> False++test_invalid :: Test+test_invalid = testGroup "invalid inputs"+ [ testProperty "trailing comma produces parse error" prop_trailing_comma_fails+ , testProperty "trailing comma after many ranges fails" prop_trailing_comma_after_many_fails+ , testProperty "double comma produces parse error" prop_double_comma_fails+ , testProperty "bare separator parses as empty (not an error)" prop_bare_separator_parses_empty+ ]++-- --------------------------------------------------------------------------- -- Custom parser args -- --------------------------------------------------------------------------- prop_custom_separators :: Bool prop_custom_separators = let args = defaultArgs { unionSeparator = ";", rangeSeparator = ".." }- result = customParseRanges args "1..5;10" :: Either ParseError [Range Integer]- in case result of- Right ranges -> ranges ==+ in case customParseRanges args "1..5;10" :: Either ParseError (Ranges Integer) of+ Right result -> result == mergeRanges [ SpanRange (Bound 1 Inclusive) (Bound 5 Inclusive) , SingletonRange 10 ]@@ -186,5 +222,6 @@ , test_wildcard , test_union , test_edge_cases+ , test_invalid , test_custom ]
range.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.4.0.0+version: 1.0.0.0 -- A short (one-line) description of the package. synopsis: An efficient and versatile range library.@@ -95,7 +95,21 @@ , Test.RangeLaws , Test.RangeParser , Test.RangeOrd+ , Test.RangeBounds , Test.Generators+ -- library modules accessed directly by test internals:+ , Data.Ranges+ , Data.Range.Algebra+ , Data.Range.Algebra.Internal+ , Data.Range.Algebra.Predicate+ , Data.Range.Algebra.Range+ , Data.Range.Data+ , Data.Range.Operators+ , Data.Range.Ord+ , Data.Range.Parser+ , Data.Range.RangeInternal+ , Data.Range.Spans+ , Data.Range.Util build-depends: base >= 4.5 && < 5 , Cabal >= 1.14 , QuickCheck >= 2.4.0.1 && < 3@@ -108,7 +122,7 @@ , containers >= 0.5 && < 1 , range default-language: Haskell2010- ghc-options: -rtsopts -Wall -fno-enable-rewrite-rules+ ghc-options: -rtsopts -Wall test-suite doctest-range type: exitcode-stdio-1.0