range 0.2.1.1 → 0.3.0.0
raw patch · 16 files changed
+815/−586 lines, 16 files
Files
- Data/Range.hs +422/−0
- Data/Range/Algebra.hs +3/−6
- Data/Range/Algebra/Internal.hs +5/−6
- Data/Range/Algebra/Range.hs +1/−1
- Data/Range/Data.hs +48/−19
- Data/Range/NestedRange.hs +0/−87
- Data/Range/Operators.hs +55/−0
- Data/Range/Parser.hs +5/−8
- Data/Range/Range.hs +0/−207
- Data/Range/RangeInternal.hs +94/−165
- Data/Range/RangeTree.hs +0/−22
- Data/Range/Spans.hs +27/−33
- Data/Range/Util.hs +117/−3
- Test/Range.hs +5/−5
- Test/RangeMerge.hs +29/−19
- range.cabal +4/−5
+ Data/Range.hs view
@@ -0,0 +1,422 @@+{-# 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.+--+-- = 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, in 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 ranges = mergeRanges [Version [1, 1, 0] [] +=+ Version [1,2,1] [], Version [1,3] [] +=* Version [1,4] [], Version [1,4] [] +=* Version [1,4,2] []]+-- >>> inRanges ranges (Version [1,0] [])+-- False+-- >>> inRanges ranges (Version [1,5] [])+-- False+-- >>> inRanges ranges (Version [1,1,5] [])+-- True+-- >>> inRanges ranges (Version [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++import Data.Range.Data+import Data.Range.Operators+import Data.Range.Util+import Data.Range.RangeInternal (exportRangeMerge, joinRM, loadRanges)+import qualified Data.Range.Algebra as Alg++-- | Performs a set union between the two input ranges and returns the resultant set of+-- ranges.+--+-- For example:+--+-- >>> union [SpanRange 1 10] [SpanRange 5 (15 :: Integer)]+-- [SpanRange 1 15]+-- (0.00 secs, 587,152 bytes)+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.+--+-- For example:+--+-- >>> intersection [SpanRange 1 10] [SpanRange 5 (15 :: Integer)]+-- [SpanRange 5 10]+-- (0.00 secs, 584,616 bytes)+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.+--+-- For example:+--+-- >>> difference [SpanRange 1 10] [SpanRange 5 (15 :: Integer)]+-- [SpanRange 1 4]+-- (0.00 secs, 590,424 bytes)+difference :: (Ord a) => [Range a] -> [Range a] -> [Range a]+difference a b = Alg.eval $ Alg.difference (Alg.const a) (Alg.const b)+{-# INLINE difference #-}++-- | An inversion function, given a set of ranges it returns the inverse set of ranges.+--+-- For example:+--+-- >>> invert [SpanRange 1 10, SpanRange 15 (20 :: Integer)]+-- [LowerBoundRange 21,UpperBoundRange 0,SpanRange 11 14]+-- (0.00 secs, 623,456 bytes)+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 overlap or adjoin. The ranges adjoin if no values exist between them.+-- If they do overlap or adjoin then true is returned; false otherwise.+--+-- For example:+--+-- >>> rangesAdjoin (1 +=+ 5) (3 +=+ 7)+-- True+-- >>> rangesAdjoin (1 +=+ 5) (5 +=+ 7)+-- True+-- >>> rangesAdjoin (1 +=* 5) (5 +=+ 7)+-- True+--+-- The last case of these three is the primary "gotcha" of this method. With @[1, 5)@ and @[5, 7]@ there+-- exist no values between them. Therefore the ranges adjoin. If you expected this to return False then+-- it is likely that you would prefer to use 'rangesOverlap' instead.+rangesAdjoin :: (Ord a) => Range a -> Range a -> Bool+rangesAdjoin a b = Adjoin == (rangesOverlapType a b)++-- | Given a range and a value it will tell you wether or not the value is in the range.+-- Remember that all ranges are inclusive.+--+-- 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++-- | Given a list of ranges this function tells you if a value is in any of those ranges.+-- This is especially useful for more complex ranges.+inRanges :: (Ord a) => [Range a] -> a -> Bool+inRanges rs a = any (`inRange` a) rs++-- | 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++-- | Checks if the value provided is above all of the ranges provided.+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++-- | Checks if the value provided is below all of the ranges provided.+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]+-- (0.01 secs, 588,968 bytes)+--+-- 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 []+-- @+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]+-- (0.01 secs, 566,016 bytes)+--+-- An infinite range:+--+-- >>> take 5 . fromRanges $ [inf :: Range Integer]+-- [0,1,-1,2,-2]+-- (0.00 secs, 566,752 bytes)+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++-- | 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.+joinRanges :: (Ord a, Enum a) => [Range a] -> [Range a]+joinRanges = exportRangeMerge . joinRM . loadRanges
Data/Range/Algebra.hs view
@@ -19,13 +19,10 @@ -- -- A simple example of using this module would look like this: ----- @--- ghci> import qualified Data.Range.Algebra as A--- ghci> (A.eval . A.invert $ A.const [SingletonRange 5]) :: [Range Integer]+-- >>> import qualified Data.Range.Algebra as A+-- (A.eval . A.invert $ A.const [SingletonRange 5]) :: [Range Integer] -- [LowerBoundRange 6,UpperBoundRange 4] -- (0.01 secs, 597,656 bytes)--- ghci>--- @ -- -- You can also use this module to evaluate range predicates. --@@ -77,7 +74,7 @@ -- | Multiple ranges represented by a list of disjoint ranges. -- Note that input ranges are allowed to overlap, but the output -- ranges are guaranteed to be disjoint.-instance (Ord a, Enum a) => RangeAlgebra [Range a] where+instance (Ord a) => RangeAlgebra [Range a] where eval = iter rangeAlgebra . getFree -- | Multiple ranges represented by a predicate function, indicating membership
Data/Range/Algebra/Internal.hs view
@@ -7,7 +7,6 @@ import Prelude hiding (const) -import Data.Range.Data import Data.Range.RangeInternal import Control.Monad.Free@@ -31,16 +30,16 @@ liftEq _ _ _ = False instance Show1 RangeExprF where- liftShowsPrec showPrec showList p (Invert x) = showString "not " . showParen True (showPrec (p + 1) x)- liftShowsPrec showPrec showList p (Union a b) =+ liftShowsPrec showPrec _ p (Invert x) = showString "not " . showParen True (showPrec (p + 1) x)+ liftShowsPrec showPrec _ p (Union a b) = showPrec (p + 1) a . showString " \\/ " . showPrec (p + 1) b- liftShowsPrec showPrec showList p (Intersection a b) =+ liftShowsPrec showPrec _ p (Intersection a b) = showPrec (p + 1) a . showString " /\\ " . showPrec (p + 1) b- liftShowsPrec showPrec showList p (Difference a b) =+ liftShowsPrec showPrec _ p (Difference a b) = showPrec (p + 1) a . showString " - " . showPrec (p + 1) b@@ -54,7 +53,7 @@ -- <https://www.schoolofhaskell.com/user/bartosz/understanding-algebras read more on School of Haskell>. type Algebra f a = f a -> a -rangeMergeAlgebra :: (Ord a, Enum a) => Algebra RangeExprF (RangeMerge a)+rangeMergeAlgebra :: (Ord a) => Algebra RangeExprF (RangeMerge a) rangeMergeAlgebra (Invert a) = invertRM a rangeMergeAlgebra (Union a b) = a `unionRangeMerges` b rangeMergeAlgebra (Intersection a b) = a `intersectionRangeMerges` b
Data/Range/Algebra/Range.hs view
@@ -6,5 +6,5 @@ import Control.Monad.Free -rangeAlgebra :: (Ord a, Enum a) => Algebra RangeExprF [Range a]+rangeAlgebra :: (Ord a) => Algebra RangeExprF [Range a] rangeAlgebra = exportRangeMerge . iter rangeMergeAlgebra . Free . fmap (Pure . loadRanges)
Data/Range/Data.hs view
@@ -3,28 +3,57 @@ -- | The Data module for common data types within the code. module Data.Range.Data where +data OverlapType = Separate | Overlap | Adjoin+ deriving (Eq, Show)++-- | Represents a type of boundary.+data BoundType + = Inclusive -- ^ The value at the boundary should be included in the bound.+ | Exclusive -- ^ The value at the boundary should be excluded in the bound.+ deriving (Eq, Show)++-- | Represents a bound at a particular value with a 'BoundType'. +-- There is no implicit understanding if this is a lower or upper bound, it could be either.+data Bound a = Bound+ { boundValue :: a -- ^ The value at the edge of this bound.+ , boundType :: BoundType -- ^ The type of bound. Should be 'Inclusive' or 'Exclusive'.+ } deriving (Eq, Show)++instance Functor Bound where+ fmap f (Bound v vType) = Bound (f v) vType++-- TODO can we implement Monoid for Range a with the addition of an empty?+-- Or maybe we can implement Monoid for a list of ranges...+ -- | The Range Data structure; it is capable of representing any type of range. This is -- the primary data structure in this library. Everything should be possible to convert -- back into this datatype. All ranges in this structure are inclusively bound. data Range a- = SingletonRange a -- ^ Represents a single element as a range.- | SpanRange a a -- ^ Represents a bounded and inclusive range of elements.- | LowerBoundRange a -- ^ Represents a range with only an inclusive lower bound.- | UpperBoundRange a -- ^ Represents a range with only an inclusive upper bound.- | InfiniteRange -- ^ Represents an infinite range over all values.- deriving(Eq, Show)+ = SingletonRange a -- ^ Represents a single element as a range. @SingletonRange a@ is equivalent to @SpanRange (Bound a Inclusive) (Bound a Inclusive)@.+ | SpanRange (Bound a) (Bound a) -- ^ Represents a bounded span of elements. The first argument is expected to be less than or equal to the second argument.+ | LowerBoundRange (Bound a) -- ^ Represents a range with a finite lower bound and an infinite upper bound.+ | UpperBoundRange (Bound a) -- ^ Represents a range with an infinite lower bound and a finite upper bound.+ | InfiniteRange -- ^ Represents an infinite range over all values.+ deriving(Eq) --- | These are the operations that can join two disjunct lists of ranges together.-data RangeOperation- = RangeUnion -- ^ Represents the set union operation.- | RangeIntersection -- ^ Represents the set intersection operation.- | RangeDifference -- ^ Represents the set difference operation.+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 --- | A Range Tree is a construct that can be built and then efficiently evaluated so that--- you can compress an entire tree of operations on ranges into a single range quickly.--- The only purpose of this tree is to allow efficient construction of range operations--- that can be evaluated as is required.-data RangeTree a- = RangeNode RangeOperation (RangeTree a) (RangeTree a) -- ^ Combine two range trees together with a single operation- | RangeNodeInvert (RangeTree a) -- ^ Invert a range tree, this is a 'not' operation.- | RangeLeaf [Range a] -- ^ A leaf with a set of ranges that are collected together.+instance Show a => Show (Range a) where+ showsPrec i (SingletonRange a) = ((++) "SingletonRange ") . showsPrec i a+ showsPrec i (SpanRange (Bound l lType) (Bound r rType)) =+ showsPrec i l . showSymbol lType rType . showsPrec i r+ where+ showSymbol Inclusive Inclusive = (++) " +=+ "+ showSymbol Inclusive Exclusive = (++) " +=* "+ showSymbol Exclusive Inclusive = (++) " *=+ "+ showSymbol Exclusive Exclusive = (++) " *=* "+ showsPrec i (LowerBoundRange (Bound a Inclusive)) = ((++) "lbi ") . (showsPrec i a)+ showsPrec i (LowerBoundRange (Bound a Exclusive)) = ((++) "lbe ") . (showsPrec i a)+ showsPrec i (UpperBoundRange (Bound a Inclusive)) = ((++) "ubi ") . (showsPrec i a)+ showsPrec i (UpperBoundRange (Bound a Exclusive)) = ((++) "ube ") . (showsPrec i a)+ showsPrec _ (InfiniteRange) = (++) "inf"
− Data/Range/NestedRange.hs
@@ -1,87 +0,0 @@-{-# LANGUAGE Safe #-}---- | Nested Ranges are common in practical usage. They appear in such forms as library--- version numbers ("Version 1.4.5.6" for example).------ It is very useful to be able to compare these ranges to one another. This module exists--- for the purpose of allowing these comparisons between nested ranges. The module builds--- upon the basic range concept from other parts of this library.-module Data.Range.NestedRange- ( NestedRange(..)- , fromVersion- , inNestedRange- ) where--import Data.Range.Range-import Data.Version---- | The Nested Range is a structure that in a nested form of many ranges where there can--- be multiple ranges at every level.------ For example, saying that you require a minimum version of 1.2.3 could be represented as:------ @--- NestedRange [[LowerBoundRange 1],[LowerBoundRange 2],[LowerBoundRange 3]]--- @-data NestedRange a = NestedRange [[Range a]]- deriving(Eq, Show)---- I wanted to know if a nested number of elements are in a given range. That way I can--- just immediately run a single function and tell things about ranges.---- | Given a list of nested values and a nested range tell us wether the nested value--- exists inside the nested range.------ == Examples------ In a simple case:------ @--- ghci> inNestedRange [2, 8, 3] (NestedRange [[SpanRange 1 2]] :: NestedRange Integer)--- True--- (0.01 secs, 558,400 bytes)--- ghci>--- @------ Not in the bounds:------ @--- ghci> inNestedRange [2, 8, 3] (NestedRange [[SpanRange 1 2], [UpperBoundRange 7]] :: NestedRange Integer)--- False--- (0.00 secs, 558,896 bytes)--- ghci>--- @------ For something based on Data.Version:------ @--- ghci> version = Version [2, 8, 3] []--- ghci> upperBound = Version [2, 7] []--- ghci> inNestedRange (versionBranch version) (fromVersion UpperBoundRange upperBound)--- False--- ghci>--- ghci> inNestedRange (versionBranch version) (fromVersion LowerBoundRange upperBound)--- True--- ghci>--- @-inNestedRange :: Ord a => [a] -> NestedRange a -> Bool-inNestedRange values (NestedRange ranges) = go values ranges- where- go :: Ord a => [a] -> [[Range a]] -> Bool- go [] [] = True -- If there is nothing left then they are equal- go _ [] = True -- If you have already found the values you have to be in range then they are- go [] _ = False -- If you have not fully matched it yet then it is not in range.- go (value : vs) (range : rs) = inRanges range value && go vs rs---- | This method converts the "Data.Version" datatype into a "NestedRange".------ For example:------ @--- ghci> fromVersion LowerBoundRange (Version [1, 2, 3] [])--- NestedRange [[LowerBoundRange 1],[LowerBoundRange 2],[LowerBoundRange 3]]--- (0.01 secs, 624,736 bytes)--- ghci>--- @-fromVersion :: (Int -> Range Int) -> Version -> NestedRange Int-fromVersion bound = NestedRange . fmap (return . bound) . versionBranch
+ Data/Range/Operators.hs view
@@ -0,0 +1,55 @@+module Data.Range.Operators where++import Data.Range.Data++-- | Mathematically equivalent to @[x, y]@.+--+-- @x +=+ y@ is the short version of @SpanRange (Bound x Inclusive) (Bound y Inclusive)@+(+=+) :: a -> a -> Range a+(+=+) x y = SpanRange (Bound x Inclusive) (Bound y Inclusive)++-- | Mathematically equivalent to @[x, y)@.+--+-- @x +=* y@ is the short version of @SpanRange (Bound x Inclusive) (Bound y Exclusive)@+(+=*) :: a -> a -> Range a+(+=*) x y = SpanRange (Bound x Inclusive) (Bound y Exclusive)++-- | Mathematically equivalent to @(x, y]@.+--+-- @x *=+ y@ is the short version of @SpanRange (Bound x Exclusive) (Bound y Inclusive)@+(*=+) :: a -> a -> Range a+(*=+) x y = SpanRange (Bound x Exclusive) (Bound y Inclusive)++-- | Mathematically equivalent to @(x, y)@.+--+-- @x *=* y@ is the short version of @SpanRange (Bound x Exclusive) (Bound y Exclusive)@+(*=*) :: a -> a -> Range a+(*=*) x y = SpanRange (Bound x Exclusive) (Bound y Exclusive)++-- | Mathematically equivalent to @[x, Infinity)@.+--+-- @lbi x@ is the short version of @LowerBoundRange (Bound x Inclusive)@+lbi :: a -> Range a+lbi x = LowerBoundRange (Bound x Inclusive)++-- | Mathematically equivalent to @(x, Infinity)@.+--+-- @lbe x@ is the short version of @LowerBoundRange (Bound x Exclusive)@+lbe :: a -> Range a+lbe x = LowerBoundRange (Bound x Exclusive)++-- | Mathematically equivalent to @(Infinity, x]@.+--+-- @ubi x@ is the short version of @UpperBoundRange (Bound x Inclusive)@+ubi :: a -> Range a+ubi x = UpperBoundRange (Bound x Inclusive)++-- | Mathematically equivalent to @(Infinity, x)@.+--+-- @ube x@ is the short version of @UpperBoundRange (Bound x Exclusive)@+ube :: a -> Range a+ube x = UpperBoundRange (Bound x Exclusive)++-- | Shorthand for the `InfiniteRange`+inf :: Range a+inf = InfiniteRange
Data/Range/Parser.hs view
@@ -5,12 +5,9 @@ -- This range parser was designed to be a useful tool for CLI programs. For example, by -- default, this example depicts how the parser works: ----- @--- ghci> parseRanges "-5,8-10,13-15,20-" :: Either ParseError [Range Integer]+-- >>> parseRanges "-5,8-10,13-15,20-" :: Either ParseError [Range Integer] -- Right [UpperBoundRange 5,SpanRange 8 10,SpanRange 13 15,LowerBoundRange 20] -- (0.01 secs, 681,792 bytes)--- ghci>--- @ -- -- And the * character translates to an infinite range. This is very useful for accepting -- ranges as input in CLI programs, but not as useful for parsing .cabal or package.json files.@@ -30,7 +27,7 @@ import Text.Parsec import Text.Parsec.String -import Data.Range.Range+import Data.Range -- | These are the arguments that will be used when parsing a string as a range. data RangeParserArgs = Args@@ -86,9 +83,9 @@ string_ $ rangeSeparator args second <- readSection case (first, second) of- (Just x, Just y) -> return $ SpanRange x y- (Just x, _) -> return $ LowerBoundRange x- (_, Just y) -> return $ UpperBoundRange y+ (Just x, Just y) -> return $ SpanRange (Bound x Inclusive) (Bound y Inclusive)+ (Just x, _) -> return $ LowerBoundRange (Bound x Inclusive)+ (_, Just y) -> return $ UpperBoundRange (Bound y Inclusive) _ -> parserFail ("Range should have a number on one end: " ++ rangeSeparator args) singletonRange :: (Read a) => Parser (Range a)
− Data/Range/Range.hs
@@ -1,207 +0,0 @@-{-# 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.------ __Note:__ It is intended that you will read the documentation in this module from top to bottom.-module Data.Range.Range (- Range(..),- inRange,- inRanges,- rangesOverlap,- mergeRanges,- union,- intersection,- difference,- invert,- fromRanges- ) where--import Data.Range.Data-import Data.Range.Util-import qualified Data.Range.Algebra as Alg---- | Performs a set union between the two input ranges and returns the resultant set of--- ranges.------ For example:------ @--- ghci> union [SpanRange 1 10] [SpanRange 5 (15 :: Integer)]--- [SpanRange 1 15]--- (0.00 secs, 587,152 bytes)--- ghci>--- @-union :: (Ord a, Enum 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.------ For example:------ @--- ghci> intersection [SpanRange 1 10] [SpanRange 5 (15 :: Integer)]--- [SpanRange 5 10]--- (0.00 secs, 584,616 bytes)--- ghci>--- @-intersection :: (Ord a, Enum 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.------ For example:------ @--- ghci> difference [SpanRange 1 10] [SpanRange 5 (15 :: Integer)]--- [SpanRange 1 4]--- (0.00 secs, 590,424 bytes)--- ghci>--- @-difference :: (Ord a, Enum a) => [Range a] -> [Range a] -> [Range a]-difference a b = Alg.eval $ Alg.difference (Alg.const a) (Alg.const b)-{-# INLINE difference #-}---- | An inversion function, given a set of ranges it returns the inverse set of ranges.------ For example:------ @--- ghci> invert [SpanRange 1 10, SpanRange 15 (20 :: Integer)]--- [LowerBoundRange 21,UpperBoundRange 0,SpanRange 11 14]--- (0.00 secs, 623,456 bytes)--- ghci>--- @-invert :: (Ord a, Enum a) => [Range a] -> [Range a]-invert = Alg.eval . Alg.invert . Alg.const-{-# INLINE invert #-}---- | A check to see if two ranges overlap. If they do then true is returned; false--- otherwise.-rangesOverlap :: (Ord a) => Range a -> Range a -> Bool-rangesOverlap (SingletonRange a) (SingletonRange b) = a == b-rangesOverlap (SingletonRange a) (SpanRange x y) = isBetween a (x, y)-rangesOverlap (SingletonRange a) (LowerBoundRange lower) = lower <= a-rangesOverlap (SingletonRange a) (UpperBoundRange upper) = a <= upper-rangesOverlap (SpanRange x y) (SpanRange a b) = isBetween x (a, b) || isBetween a (x, y)-rangesOverlap (SpanRange _ y) (LowerBoundRange lower) = lower <= y-rangesOverlap (SpanRange x _) (UpperBoundRange upper) = x <= upper-rangesOverlap (LowerBoundRange _) (LowerBoundRange _) = True-rangesOverlap (LowerBoundRange x) (UpperBoundRange y) = x <= y-rangesOverlap (UpperBoundRange _) (UpperBoundRange _) = True-rangesOverlap InfiniteRange _ = True-rangesOverlap a b = rangesOverlap b a---- | Given a range and a value it will tell you wether or not the value is in the range.--- Remember that all ranges are inclusive.------ 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:------ @--- ghci> :set +s--- ghci> elem (10000000 :: Integer) [1..10000000]--- True--- (0.26 secs, 720,556,888 bytes)--- ghci> inRange (SpanRange 1 10000000) (10000000 :: Integer)--- True--- (0.00 secs, 557,656 bytes)--- ghci>--- @------ 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 = isBetween value (x, y)-inRange (LowerBoundRange lower) value = lower <= value-inRange (UpperBoundRange upper) value = value <= upper-inRange InfiniteRange _ = True---- | Given a list of ranges this function tells you if a value is in any of those ranges.--- This is especially useful for more complex ranges.-inRanges :: (Ord a) => [Range a] -> a -> Bool-inRanges rs a = any (`inRange` a) rs---- | An array of ranges may have overlaps; this function will collapse that array into as few--- Ranges as possible. For example:------ @--- ghci> mergeRanges [LowerBoundRange 12, SpanRange 1 10, SpanRange 5 (15 :: Integer)]--- [LowerBoundRange 1]--- (0.01 secs, 588,968 bytes)--- ghci>--- @------ 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 . intersection []--- @-mergeRanges :: (Ord a, Enum 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.------ == Examples------ A simple span:------ @--- ghci> take 5 . fromRanges $ [SpanRange 1 10 :: Range Integer]--- [1,2,3,4,5]--- (0.01 secs, 566,016 bytes)--- ghci>--- @------ An infinite range:------ @--- ghci> take 5 . fromRanges $ [InfiniteRange :: Range Integer]--- [0,1,-1,2,-2]--- (0.00 secs, 566,752 bytes)--- ghci>--- @-fromRanges :: (Ord a, Enum a) => [Range a] -> [a]-fromRanges = takeEvenly . fmap fromRange . mergeRanges- where- fromRange range = case range of- SingletonRange x -> [x]- SpanRange a b -> [a..b]- LowerBoundRange x -> iterate succ x- UpperBoundRange x -> iterate pred x- InfiniteRange -> zero : takeEvenly [tail $ iterate succ zero, tail $ iterate pred zero]- where- zero = toEnum 0
Data/Range/RangeInternal.hs view
@@ -8,6 +8,8 @@ import Data.Range.Spans import Data.Range.Util +import Control.Monad (guard)+ {- - The following assumptions must be maintained at the beginning of these internal - functions so that we can reason about what we are given.@@ -18,9 +20,9 @@ - * The lower and upper bounds never overlap in such a way to make it an infinite range. -} data RangeMerge a = RM- { largestLowerBound :: Maybe a- , largestUpperBound :: Maybe a- , spanRanges :: [(a, a)]+ { largestLowerBound :: Maybe (Bound a)+ , largestUpperBound :: Maybe (Bound a)+ , spanRanges :: [(Bound a, Bound a)] } | IRM deriving (Show, Eq)@@ -32,30 +34,30 @@ storeRange InfiniteRange = IRM storeRange (LowerBoundRange lower) = emptyRangeMerge { largestLowerBound = Just lower } storeRange (UpperBoundRange upper) = emptyRangeMerge { largestUpperBound = Just upper }-storeRange (SpanRange x y) = emptyRangeMerge { spanRanges = [(min x y, max x y)] }-storeRange (SingletonRange x) = emptyRangeMerge { spanRanges = [(x, x)] }+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)] } -storeRanges :: (Ord a, Enum a) => RangeMerge a -> [Range a] -> RangeMerge a+storeRanges :: (Ord a) => RangeMerge a -> [Range a] -> RangeMerge a storeRanges start ranges = foldr unionRangeMerges start (map storeRange ranges) -loadRanges :: (Ord a, Enum a) => [Range a] -> RangeMerge a+loadRanges :: (Ord a) => [Range a] -> RangeMerge a loadRanges = storeRanges emptyRangeMerge {-# INLINE[0] loadRanges #-} -exportRangeMerge :: (Ord a, Enum a) => RangeMerge a -> [Range a]+exportRangeMerge :: (Eq a) => RangeMerge a -> [Range a] exportRangeMerge IRM = [InfiniteRange]-exportRangeMerge rm = putAll rm+exportRangeMerge (RM lb up spans) = putUpperBound up ++ putSpans spans ++ putLowerBound lb where- putAll IRM = [InfiniteRange]- putAll (RM lb up spans) =- putUpperBound up ++ putSpans spans ++ putLowerBound lb-+ putLowerBound :: Maybe (Bound a) -> [Range a] putLowerBound = maybe [] (return . LowerBoundRange)+ putUpperBound :: Maybe (Bound a) -> [Range a] putUpperBound = maybe [] (return . UpperBoundRange) putSpans = map simplifySpan - simplifySpan (x, y) = if x == y- then SingletonRange x+ simplifySpan (x@(Bound xv xType), y@(Bound _ yType)) = if (x == y) && (pointJoinType xType yType /= Separate)+ then SingletonRange xv else SpanRange x y {-# RULES "load/export" [1] forall x. loadRanges (exportRangeMerge x) = x #-}@@ -65,27 +67,27 @@ where newSpans = intersectSpans (spanRanges one) (spanRanges two) -intersectWith :: (Ord a) => (a -> (a, a) -> Maybe (a, a)) -> Maybe a -> [(a, a)] -> [(a, a)]+intersectWith :: (Ord a) => (Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)) -> Maybe (Bound a) -> [(Bound a, Bound a)] -> [(Bound a, Bound a)] intersectWith _ Nothing _ = [] intersectWith fix (Just lower) xs = catMaybes $ fmap (fix lower) xs -fixLower :: (Ord a) => a -> (a, a) -> Maybe (a, a)-fixLower lower (x, y) = if lower <= y- then Just (max lower x, y)- else Nothing+fixLower :: (Ord a) => Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)+fixLower lower@(Bound lowerValue _) (x, y@(Bound yValue _)) = do+ guard (lowerValue <= yValue)+ return (maxBoundsIntersection lower x, y) -fixUpper :: (Ord a) => a -> (a, a) -> Maybe (a, a)-fixUpper upper (x, y) = if x <= upper- then Just (x, min y upper)- else Nothing+fixUpper :: (Ord a) => Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)+fixUpper upper@(Bound upperValue _) (x@(Bound xValue _), y) = do+ guard (xValue <= upperValue)+ return (x, minBoundsIntersection y upper) -intersectionRangeMerges :: (Ord a, Enum a) => RangeMerge a -> RangeMerge a -> RangeMerge a+intersectionRangeMerges :: (Ord a) => RangeMerge a -> RangeMerge a -> RangeMerge a intersectionRangeMerges IRM two = two intersectionRangeMerges one IRM = one intersectionRangeMerges one two = RM { largestLowerBound = newLowerBound , largestUpperBound = newUpperBound- , spanRanges = joinedSpans+ , spanRanges = unionSpans sortedResults } where lowerOneSpans = intersectWith fixLower (largestLowerBound one) (spanRanges two)@@ -94,7 +96,7 @@ upperTwoSpans = intersectWith fixUpper (largestUpperBound two) (spanRanges one) intersectedSpans = intersectSpans (spanRanges one) (spanRanges two) - sortedResults = foldr1 insertionSortSpans+ sortedResults = removeEmptySpans $ foldr1 insertionSortSpans [ lowerOneSpans , lowerTwoSpans , upperOneSpans@@ -103,56 +105,53 @@ , calculateBoundOverlap one two ] - joinedSpans = joinSpans . unionSpans $ sortedResults-- newLowerBound = calculateNewBound largestLowerBound max one two- newUpperBound = calculateNewBound largestUpperBound min one two+ newLowerBound = calculateNewBound largestLowerBound maxBoundsIntersection one two+ newUpperBound = calculateNewBound largestUpperBound minBoundsIntersection one two calculateNewBound :: (Ord a)- => (RangeMerge a -> Maybe a)- -> (a -> a -> a)- -> RangeMerge a -> RangeMerge a -> Maybe a- calculateNewBound ext comp one two = case (ext one, ext two) of+ => (RangeMerge a -> Maybe (Bound a))+ -> (Bound a -> Bound a -> Bound a)+ -> RangeMerge a -> RangeMerge a -> Maybe (Bound a)+ calculateNewBound ext comp one' two' = case (ext one', ext two') of (Just x, Just y) -> Just $ comp x y (_, Nothing) -> Nothing (Nothing, _) -> Nothing -calculateBoundOverlap :: (Ord a, Enum a) => RangeMerge a -> RangeMerge a -> [(a, a)]+calculateBoundOverlap :: (Ord a) => RangeMerge a -> RangeMerge a -> [(Bound a, Bound a)] calculateBoundOverlap one two = catMaybes [oneWay, secondWay] where- oneWay = case (largestLowerBound one, largestUpperBound two) of- (Just x, Just y) -> if y >= x- then Just (x, y)- else Nothing- _ -> Nothing+ oneWay = do+ x <- largestLowerBound one+ y <- largestUpperBound two+ guard (compareLower y x /= LT)+ return (x, y) - secondWay = case (largestLowerBound two, largestUpperBound one) of- (Just x, Just y) -> if y >= x- then Just (x, y)- else Nothing- _ -> Nothing+ secondWay = do+ x <- largestLowerBound two+ y <- largestUpperBound one+ guard (compareLower y x /= LT)+ return (x, y) -unionRangeMerges :: (Ord a, Enum a) => RangeMerge a -> RangeMerge a -> RangeMerge a+unionRangeMerges :: (Ord a) => RangeMerge a -> RangeMerge a -> RangeMerge a unionRangeMerges IRM _ = IRM unionRangeMerges _ IRM = IRM unionRangeMerges one two = infiniteCheck filterTwo where- filterOne = foldr filterLowerBound boundedRM joinedSpans+ filterOne = foldr filterLowerBound boundedRM (unionSpans sortedSpans) filterTwo = foldr filterUpperBound (filterOne { spanRanges = [] }) (spanRanges filterOne) - infiniteCheck :: (Ord a, Enum a) => RangeMerge a -> RangeMerge a+ infiniteCheck :: (Ord a) => RangeMerge a -> RangeMerge a infiniteCheck IRM = IRM- infiniteCheck rm@(RM (Just x) (Just y) _) = if x <= succ y+ infiniteCheck rm@(RM (Just lower) (Just upper) _) = if compareUpperToLower upper lower /= LT then IRM else rm infiniteCheck rm = rm - newLowerBound = calculateNewBound largestLowerBound min one two- newUpperBound = calculateNewBound largestUpperBound max one two+ newLowerBound = calculateNewBound largestLowerBound minBounds one two+ newUpperBound = calculateNewBound largestUpperBound maxBounds one two sortedSpans = insertionSortSpans (spanRanges one) (spanRanges two)- joinedSpans = joinSpans . unionSpans $ sortedSpans boundedRM = RM { largestLowerBound = newLowerBound@@ -162,86 +161,46 @@ calculateNewBound :: (Ord a)- => (RangeMerge a -> Maybe a)- -> (a -> a -> a)- -> RangeMerge a -> RangeMerge a -> Maybe a- calculateNewBound ext comp one two = case (ext one, ext two) of+ => (RangeMerge a -> Maybe (Bound a))+ -> (Bound a -> Bound a -> Bound a)+ -> RangeMerge a -> RangeMerge a -> Maybe (Bound a)+ calculateNewBound ext comp one' two' = case (ext one', ext two') of (Just x, Just y) -> Just $ comp x y (z, Nothing) -> z (Nothing, z) -> z -filterLowerBound :: (Ord a, Enum a) => (a, a) -> RangeMerge a -> RangeMerge a+filterLowerBound :: (Ord a) => (Bound a, Bound a) -> RangeMerge a -> RangeMerge a filterLowerBound _ IRM = IRM filterLowerBound a rm@(RM Nothing _ _) = rm { spanRanges = a : spanRanges rm } filterLowerBound s@(lower, _) rm@(RM (Just lowestBound) _ _) = case boundCmp lowestBound s of GT -> rm { spanRanges = s : spanRanges rm } LT -> rm- EQ -> rm { largestLowerBound = Just $ min lowestBound lower }+ EQ -> rm { largestLowerBound = Just $ minBounds lowestBound lower } -filterUpperBound :: (Ord a, Enum a) => (a, a) -> RangeMerge a -> RangeMerge a+filterUpperBound :: (Ord a) => (Bound a, Bound a) -> RangeMerge a -> RangeMerge a filterUpperBound _ IRM = IRM filterUpperBound a rm@(RM _ Nothing _) = rm { spanRanges = a : spanRanges rm } filterUpperBound s@(_, upper) rm@(RM _ (Just upperBound) _) = case boundCmp upperBound s of LT -> rm { spanRanges = s : spanRanges rm } GT -> rm- EQ -> rm { largestUpperBound = Just $ max upperBound upper }--boundCmp :: (Ord a, Enum a) => a -> (a, a) -> Ordering-boundCmp x (a, b) = if isBetween x (pred a, succ b)- then EQ- else if x < pred a then LT else GT--appendSpanRM :: (Ord a, Enum a) => (a, a) -> RangeMerge a -> RangeMerge a-appendSpanRM _ IRM = IRM-appendSpanRM sp@(lower, higher) rm =- if (newUpper, newLower) == (lub, llb) && isLower lower newLower && (Just higher) > newUpper- then newRangesRM- { spanRanges = sp : spanRanges rm- }- else newRangesRM- { spanRanges = spanRanges rm- }- where- newRangesRM = rm- { largestLowerBound = newLower- , largestUpperBound = newUpper- }-- isLower :: Ord a => a -> Maybe a -> Bool- isLower _ Nothing = True- isLower y (Just x) = y < x-- lub = largestUpperBound rm- llb = largestLowerBound rm-- newLower = do- bound <- llb- return $ if bound <= higher- then min bound lower- else bound-- newUpper = do- bound <- lub- return $ if lower <= bound- then max bound higher- else bound+ EQ -> rm { largestUpperBound = Just $ maxBounds upperBound upper } -invertRM :: (Ord a, Enum a) => RangeMerge a -> RangeMerge a+invertRM :: (Ord a) => RangeMerge a -> RangeMerge a invertRM IRM = emptyRangeMerge invertRM (RM Nothing Nothing []) = IRM-invertRM (RM (Just lower) Nothing []) = RM Nothing (Just . pred $ lower) []-invertRM (RM Nothing (Just upper) []) = RM (Just . succ $ upper) Nothing []-invertRM (RM (Just lower) (Just upper) []) = RM Nothing Nothing [(succ upper, pred lower)]+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 { largestUpperBound = newUpperBound , largestLowerBound = newLowerBound , spanRanges = upperSpan ++ betweenSpans ++ lowerSpan } where- newLowerValue = succ . snd . last . spanRanges $ rm- newUpperValue = pred . fst . head . spanRanges $ rm+ newLowerValue = invertBound . snd . last . spanRanges $ rm+ newUpperValue = invertBound . fst . head . spanRanges $ rm newUpperBound = case largestUpperBound rm of Just _ -> Nothing@@ -253,71 +212,41 @@ upperSpan = case largestUpperBound rm of Nothing -> []- Just upper -> [(succ upper, newUpperValue)]+ Just upper -> [(invertBound upper, newUpperValue)] lowerSpan = case largestLowerBound rm of Nothing -> []- Just lower -> [(newLowerValue, pred lower)]+ Just lower -> [(newLowerValue, invertBound lower)] betweenSpans = invertSpans . spanRanges $ rm -{--unionRange :: (Ord a) => Range a -> RangeMerge a -> RangeMerge a-unionRange InfiniteRange rm = IRM-unionRange (LowerBoundRange lower) rm = case largestLowerBound rm of- Just currentLowest -> rm { largestLowerBound = Just $ min lower currentLowest }- Nothing -> rm { largestLowerBound = Just lower }--}--{--intersectSpansRM :: (Ord a) => RangeMerge a -> (a, a) -> [(a, a)]-intersectSpansRM rm sp@(lower, upper) = intersectedSpans+joinRM :: (Eq a, Enum a) => RangeMerge a -> RangeMerge a+joinRM o@(RM _ _ []) = o+joinRM rm = RM lower higher spansAfterHigher where- spans = spanRanges rm- intersectedSpans = catMaybes $ map (intersectCompareSpan sp) spans+ joinedSpans = joinSpans . spanRanges $ rm - largestSpan :: Ord a => [(a, a)] -> [(a, a)]- largestSpan [] = []- largestSpan xs = (foldr1 (\(l, m) (x, y) -> (min l x, max m y)) xs) : []+ (lower, spansAfterLower) =+ case (largestLowerBound rm, reverse joinedSpans) of+ o@(Just l, ((xl, xh) : xs)) ->+ if (succ . highestValueInUpperBound $ xh) == lowestValueInLowerBound l+ then (Just xl, reverse xs)+ else o+ x -> x -intersectCompareSpan :: Ord a => (a, a) -> (a, a) -> Maybe (a, a)-intersectCompareSpan f@(l, m) s@(x, y) = if isBetween l s || isBetween m s- then Just (max l x, min m y)- else Nothing--}+ (higher, spansAfterHigher) =+ case (largestUpperBound rm, spansAfterLower) of+ o@(Just h, ((xl, xh) : xs)) ->+ if highestValueInUpperBound h == (pred . lowestValueInLowerBound $ xl)+ then (Just xh, xs)+ else o+ x -> x --- If it was an infinite range then it should not be after an intersection unless it was--- an intersection with another infinite range.-{--intersectionRange :: (Ord a, Enum a) => Range a -> RangeMerge a -> RangeMerge a-intersectionRange InfiniteRange rm = rm -- Intersection with universe remains same-intersectionRange (LowerBoundRange lower) rm = rm- { largestLowerBound = largestLowerBound rm >>= return . max lower- , spanRanges = catMaybes . map (updateRange lower) . spanRanges $ rm- }- where- updateRange :: (Ord a) => a -> (a, a) -> Maybe (a, a)- updateRange lower (begin, end) = if lower <= end- then Just (max lower begin, end)- else Nothing-intersectionRange (UpperBoundRange upper) rm = rm- { largestUpperBound = largestUpperBound rm >>= return . min upper- , spanRanges = catMaybes . map (updateRange upper) . spanRanges $ rm- }- where- updateRange :: (Ord a) => a -> (a, a) -> Maybe (a, a)- updateRange upper (begin, end) = if begin <= upper- then Just (begin, min upper end)- else Nothing-intersectionRange (SpanRange lower upper) rm = rm- -- update the bounds first and then update the spans, if the spans were sorted then- { largestUpperBound = largestUpperBound rm >>= return . min upper- , largestLowerBound = largestLowerBound rm >>= return . max lower- -- they would be faster to update I suspect, lets start with not sorted- , spanRanges = joinUnionSortSpans . ((lower, upper) :) . spanRanges $ rm- }- where- joinUnionSortSpans :: (Ord a, Enum a) => [(a, a)] -> [(a, a)]- joinUnionSortSpans = joinSpans . unionSpans . sortSpans+updateBound :: Bound a -> a -> Bound a+updateBound (Bound _ aType) b = Bound b aType -intersectionRange (SingletonRange value) rm = intersectionRange (SpanRange value value) rm--}+unmergeRM :: RangeMerge a -> [RangeMerge a]+unmergeRM IRM = [IRM]+unmergeRM (RM lower upper spans) =+ (maybe [] (\x -> [RM Nothing (Just x) []]) upper) +++ fmap (\x -> RM Nothing Nothing [x]) spans +++ (maybe [] (\x -> [RM (Just x) Nothing []]) lower)
− Data/Range/RangeTree.hs
@@ -1,22 +0,0 @@-{-# LANGUAGE Safe #-}--module Data.Range.RangeTree {-# DEPRECATED "Use \"Data.Range.Algebra\" instead" #-}- ( evaluate- , RangeTree(..)- , RangeOperation(..)- ) where--import Data.Range.Data-import qualified Data.Range.Algebra as Alg--toExpr :: RangeTree a -> Alg.RangeExpr [Range a]-toExpr (RangeLeaf a) = Alg.const a-toExpr (RangeNodeInvert a) = Alg.invert (toExpr a)-toExpr (RangeNode RangeUnion a b) = Alg.union (toExpr a) (toExpr b)-toExpr (RangeNode RangeIntersection a b) = Alg.intersection (toExpr a) (toExpr b)-toExpr (RangeNode RangeDifference a b) = Alg.difference (toExpr a) (toExpr b)---- | Evaluates a Range Tree into the final set of ranges that it compresses down to. Use--- this whenever you want to finally evaluate your constructed Range Tree.-evaluate :: (Ord a, Enum a) => RangeTree a -> [Range a]-evaluate = Alg.eval . toExpr
Data/Range/Spans.hs view
@@ -3,57 +3,51 @@ -- This module contains every function that purely performs operations on spans. module Data.Range.Spans where -import Data.List (sortBy, insertBy)-import Data.Ord (comparing)- import Data.Range.Util- +import Data.Range.Data+ -- Assume that both inputs are sorted spans-insertionSortSpans :: (Ord a) => [(a, a)] -> [(a, a)] -> [(a, a)]-insertionSortSpans = insertionSort (comparing fst)+insertionSortSpans :: (Ord a) => [(Bound a, Bound a)] -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]+insertionSortSpans = insertionSort (\a b -> compareLower (fst a) (fst b)) -spanCmp :: Ord a => (a, a) -> (a, a) -> Ordering-spanCmp x@(xlow, xhigh) y@(ylow, _) = if isBetween xlow y || isBetween ylow x- then EQ- else if xhigh < ylow then LT else GT+spanCmp :: Ord a => (Bound a, Bound a) -> (Bound a, Bound a) -> Ordering+spanCmp x@(_, Bound xHighValue _) y@(Bound yLowValue _, _) =+ if boundsOverlapType x y /= Separate+ then EQ+ else if xHighValue <= yLowValue then LT else GT -intersectSpans :: (Ord a) => [(a, a)] -> [(a, a)] -> [(a, a)]-intersectSpans (x@(xlow, xup) : xs) (y@(ylow, yup) : ys) = +intersectSpans :: (Ord a) => [(Bound a, Bound a)] -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]+intersectSpans (x@(xlow, xup@(Bound xUpValue _)) : xs) (y@(ylow, yup@(Bound yUpValue _)) : ys) = case spanCmp x y of- EQ -> (max xlow ylow, min xup yup) : if xup < yup- then intersectSpans xs (y : ys)- else intersectSpans (x : xs) ys+ EQ -> if (not . isEmptySpan $ intersectedSpan) then intersectedSpan : equalNext else equalNext LT -> intersectSpans xs (y : ys) GT -> intersectSpans (x : xs) ys-intersectSpans _ _ = []+ where+ intersectedSpan = (maxBoundsIntersection xlow ylow, minBoundsIntersection xup yup) -insertSpan :: Ord a => (a, b) -> [(a, b)] -> [(a, b)]-insertSpan = insertBy (comparing fst)+ lessThanNext = intersectSpans xs (y : ys)+ greaterThanNext = intersectSpans (x : xs) ys+ equalNext = if xUpValue < yUpValue then lessThanNext else greaterThanNext -sortSpans :: (Ord a) => [(a, a)] -> [(a, a)]-sortSpans = sortBy (comparing fst)+intersectSpans _ _ = [] + -- Assume that you are given a sorted list of spans-joinSpans :: (Ord a, Enum a) => [(a, a)] -> [(a, a)]-joinSpans (f@(a, b) : s@(x, y) : xs) = - if succ b == x+joinSpans :: (Eq a, Enum a) => [(Bound a, Bound a)] -> [(Bound a, Bound a)]+joinSpans (f@(a, b) : s@(x, y) : xs) =+ if (succ . highestValueInUpperBound $ b) == lowestValueInLowerBound x then joinSpans $ (a, y) : xs else f : joinSpans (s : xs) joinSpans xs = xs -- Assume that you are given a sorted list of spans-unionSpans :: Ord a => [(a, a)] -> [(a, a)]-unionSpans (f@(a, b) : s@(x, y) : xs) = if isBetween x f - then unionSpans ((a, max b y) : xs)+unionSpans :: Ord a => [(Bound a, Bound a)] -> [(Bound a, Bound a)]+unionSpans (f@(a, b) : s@(_, y) : xs) = if boundsOverlapType f s /= Separate+ then unionSpans ((a, maxBounds b y) : xs) else f : unionSpans (s : xs) unionSpans xs = xs -- Assume that you are given a sorted and joined list of spans-invertSpans :: (Ord a, Enum a) => [(a, a)] -> [(a, a)]-invertSpans ((_, x) : s@(y, _) : xs) = (succ x, pred y) : invertSpans (s : xs)+invertSpans :: [(Bound a, Bound a)] -> [(Bound a, Bound a)]+invertSpans ((_, x) : s@(y, _) : xs) = (invertBound x, invertBound y) : invertSpans (s : xs) invertSpans _ = []--hasOverlaps :: (Ord a, Enum a) => [(a, a)] -> Bool-hasOverlaps xs = any isOverlapping (pairs xs)- where- isOverlapping ((x, y), (a, b)) = isBetween x (pred a, succ b) || isBetween a (pred x, succ y)
Data/Range/Util.hs view
@@ -4,11 +4,59 @@ import Data.Maybe (catMaybes) +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. -insertionSort :: (Ord a) => (a -> a -> Ordering) -> [a] -> [a] -> [a]+compareLower :: Ord a => Bound a -> Bound a -> Ordering+compareLower ab@(Bound a aType) bb@(Bound b _)+ | ab == bb = EQ+ | a == b = if aType == Inclusive then LT else GT+ | a < b = LT+ | otherwise = GT++compareHigher :: Ord a => Bound a -> Bound a -> Ordering+compareHigher ab@(Bound a aType) bb@(Bound b _)+ | ab == bb = EQ+ | a == b = if aType == Inclusive then GT else LT+ | a < b = LT+ | otherwise = GT++compareLowerIntersection :: Ord a => Bound a -> Bound a -> Ordering+compareLowerIntersection ab@(Bound a aType) bb@(Bound b _)+ | ab == bb = EQ+ | a == b = if aType == Exclusive then LT else GT+ | a < b = LT+ | otherwise = GT++compareHigherIntersection :: Ord a => Bound a -> Bound a -> Ordering+compareHigherIntersection ab@(Bound a aType) bb@(Bound b _)+ | ab == bb = EQ+ | a == b = if aType == Exclusive then GT else LT+ | a < b = LT+ | otherwise = GT++compareUpperToLower :: Ord a => Bound a -> Bound a -> Ordering+compareUpperToLower (Bound upper upperType) (Bound lower lowerType)+ | upper == lower = if upperType == Inclusive || lowerType == Inclusive then EQ else LT+ | upper < lower = LT+ | otherwise = GT++minBounds :: Ord a => Bound a -> Bound a -> Bound a+minBounds ao bo = if compareLower ao bo == LT then ao else bo++maxBounds :: Ord a => Bound a -> Bound a -> Bound a+maxBounds ao bo = if compareHigher ao bo == GT then ao else bo++minBoundsIntersection :: Ord a => Bound a -> Bound a -> Bound a+minBoundsIntersection ao bo = if compareLowerIntersection ao bo == LT then ao else bo++maxBoundsIntersection :: Ord a => Bound a -> Bound a -> Bound a+maxBoundsIntersection ao bo = if compareHigherIntersection ao bo == GT then ao else bo++insertionSort :: (a -> a -> Ordering) -> [a] -> [a] -> [a] insertionSort comp xs ys = go xs ys where go (f : fs) (s : ss) = case comp f s of@@ -18,9 +66,67 @@ go [] z = z go z [] = z -isBetween :: (Ord a) => a -> (a, a) -> Bool-isBetween a (x, y) = (x <= a) && (a <= y)+invertBound :: Bound a -> Bound a+invertBound (Bound x Inclusive) = Bound x Exclusive+invertBound (Bound x Exclusive) = Bound x Inclusive +isEmptySpan :: Eq a => (Bound a, Bound a) -> Bool+isEmptySpan (Bound a aType, Bound b bType) = a == b && (aType == Exclusive || bType == Exclusive)++removeEmptySpans :: Eq a => [(Bound a, Bound a)] -> [(Bound a, Bound a)]+removeEmptySpans = filter (not . isEmptySpan)++boundsOverlapType :: Ord a => (Bound a, Bound a) -> (Bound a, Bound a) -> OverlapType+boundsOverlapType l@(ab@(Bound a _), bb@(Bound b _)) r@(xb@(Bound x _), yb@(Bound y _))+ | isEmptySpan l || isEmptySpan r = Separate+ | a == x = Overlap+ | b == y = Overlap+ | otherwise = (ab `boundIsBetween` (xb, yb)) `orOverlapType` (xb `boundIsBetween` (ab, bb))++orOverlapType :: OverlapType -> OverlapType -> OverlapType+orOverlapType Overlap _ = Overlap+orOverlapType _ Overlap = Overlap+orOverlapType Adjoin _ = Adjoin+orOverlapType _ Adjoin = Adjoin+orOverlapType _ _ = Separate++pointJoinType :: BoundType -> BoundType -> OverlapType+pointJoinType Inclusive Inclusive = Overlap+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+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+boundIsBetween :: (Ord a) => Bound a -> (Bound a, Bound a) -> OverlapType+boundIsBetween (Bound a aType) (Bound x xType, Bound y yType)+ | x > a = Separate+ | x == a = pointJoinType aType xType+ | a < y = Overlap+ | 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+ | lower < a = Overlap+ | otherwise = Separate++againstUpperBound :: Ord a => Bound a -> Bound a -> OverlapType+againstUpperBound (Bound a aType) (Bound upper upperType)+ | upper == a = pointJoinType aType upperType+ | a < upper = Overlap+ | otherwise = Separate+ takeEvenly :: [[a]] -> [a] takeEvenly [] = [] takeEvenly xss = (catMaybes . map safeHead $ xss) ++ takeEvenly (filter (not . null) . map tail $ xss)@@ -32,3 +138,11 @@ pairs :: [a] -> [(a, a)] pairs [] = [] pairs xs = zip xs (tail xs)++lowestValueInLowerBound :: Enum a => Bound a -> a+lowestValueInLowerBound (Bound a Inclusive) = a+lowestValueInLowerBound (Bound a Exclusive) = succ a++highestValueInUpperBound :: Enum a => Bound a -> a+highestValueInUpperBound (Bound a Inclusive) = a+highestValueInUpperBound (Bound a Exclusive) = pred a
Test/Range.hs view
@@ -12,7 +12,7 @@ import Control.Monad (liftM) import System.Random -import Data.Range.Range+import Data.Range import qualified Data.Range.Algebra as Alg import Test.RangeMerge@@ -43,7 +43,7 @@ return $ SpanContains (begin, end) middle prop_span_contains :: SpanContains Integer -> Bool-prop_span_contains (SpanContains (begin, end) middle) = inRange (SpanRange begin end) middle+prop_span_contains (SpanContains (begin, end) middle) = inRange (SpanRange (Bound begin Inclusive) (Bound end Inclusive)) middle prop_infinite_range_contains_everything :: Integer -> Bool prop_infinite_range_contains_everything = inRange InfiniteRange@@ -68,9 +68,9 @@ generateSpan = do first <- arbitrarySizedIntegral second <- arbitrarySizedIntegral `suchThat` (> first)- return $ SpanRange first second- generateLowerBound = liftM LowerBoundRange arbitrarySizedIntegral- generateUpperBound = liftM UpperBoundRange arbitrarySizedIntegral+ return $ first +=+ second+ generateLowerBound = liftM lbi arbitrarySizedIntegral+ generateUpperBound = liftM ubi arbitrarySizedIntegral generateInfiniteRange :: Gen (Range a) generateInfiniteRange = return InfiniteRange
Test/RangeMerge.hs view
@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- This is only okay in test classes -module Test.RangeMerge +module Test.RangeMerge ( rangeMergeTestCases ) where @@ -13,25 +13,33 @@ import Data.Maybe (fromMaybe) import System.Random +import Data.Range.Data import Data.Range.RangeInternal+import Data.List (subsequences) instance (Num a, Integral a, Ord a, Random a) => Arbitrary (RangeMerge a) where+ shrink = fmap (foldr unionRangeMerges emptyRangeMerge) . init . subsequences . unmergeRM+ arbitrary = do upperBound <- maybeNumber possibleSpanStart <- arbitrarySizedIntegral spans <- generateSpanList (fromMaybe possibleSpanStart upperBound)- lowerBound <- oneof - [ fmap Just $ fmap ((+) $ maxMaybe (fmap snd $ lastMaybe spans) $ maxMaybe upperBound possibleSpanStart) $ choose (2, 100)+ lowerBound <- oneof+ [ fmap Just $ fmap ((+) $ maxMaybe (fmap (boundValue . snd) $ lastMaybe spans) $ maxMaybe upperBound possibleSpanStart) $ choose (2, 100) , return Nothing ]- return RM - { largestUpperBound = upperBound- , largestLowerBound = lowerBound + return RM+ { largestUpperBound = fmap (\x -> Bound x Inclusive) $ upperBound+ , largestLowerBound = fmap (\x -> Bound x Inclusive) $ lowerBound , spanRanges = spans } where maybeNumber = oneof [liftM Just arbitrarySizedIntegral, return Nothing] + maybeBound = do+ isInclusive <- arbitrary+ return (if isInclusive then Inclusive else Exclusive)+ lastMaybe :: [a] -> Maybe a lastMaybe [] = Nothing lastMaybe xs = Just . last $ xs@@ -40,18 +48,20 @@ maxMaybe Nothing x = x maxMaybe (Just y) x = max x y - generateSpanList :: (Num a, Ord a, Random a) => a -> Gen [(a, a)]+ generateSpanList :: (Num a, Ord a, Random a) => a -> Gen [(Bound a, Bound a)] generateSpanList start = do count <- choose (0, 10) helper count start where- helper :: (Num a, Ord a, Random a) => Integer -> a -> Gen [(a, a)]+ helper :: (Num a, Ord a, Random a) => Integer -> a -> Gen [(Bound a, Bound a)] helper 0 _ = return []- helper x start = do- first <- fmap (+start) $ choose (2, 100)+ helper x hStart = do+ first <- fmap (+hStart) $ choose (2, 100)+ firstBound <- maybeBound second <- fmap (+first) $ choose (2, 100)+ secondBound <- maybeBound remainder <- helper (x - 1) second- return $ (first, second) : remainder+ return $ (Bound first firstBound, Bound second secondBound) : remainder prop_export_load_is_identity :: RangeMerge Integer -> Bool prop_export_load_is_identity x = loadRanges (exportRangeMerge x) == x@@ -79,29 +89,29 @@ ] prop_intersection_with_empty_is_empty :: RangeMerge Integer -> Bool-prop_intersection_with_empty_is_empty rm = +prop_intersection_with_empty_is_empty rm = (rm `intersectionRangeMerges` emptyRangeMerge) == emptyRangeMerge prop_intersection_with_infinite_is_self :: RangeMerge Integer -> Bool-prop_intersection_with_infinite_is_self rm = +prop_intersection_with_infinite_is_self rm = (rm `intersectionRangeMerges` IRM) == rm 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 + [ testProperty "Intersection with empty is empty" prop_intersection_with_empty_is_empty+ , testProperty "Intersection with infinite is self" prop_intersection_with_infinite_is_self ] prop_demorgans_law_one :: (RangeMerge Integer, RangeMerge Integer) -> Bool-prop_demorgans_law_one (a, b) = +prop_demorgans_law_one (a, b) = (invertRM (a `unionRangeMerges` b)) == ((invertRM a) `intersectionRangeMerges` (invertRM b)) prop_demorgans_law_two :: (RangeMerge Integer, RangeMerge Integer) -> Bool-prop_demorgans_law_two (a, b) = +prop_demorgans_law_two (a, b) = (invertRM (a `intersectionRangeMerges` b)) == ((invertRM a) `unionRangeMerges` (invertRM b)) test_complex_laws = testGroup "complex set theory rules"- [ testProperty "DeMorgan Part 1: not (a or b) == (not a) and (not b)" prop_demorgans_law_one- , testProperty "DeMorgan Part 2: not (a and b) == (not a) or (not b)" prop_demorgans_law_two+ [ 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 =
range.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.2.1.1+version: 0.3.0.0 -- A short (one-line) description of the package. synopsis: An efficient and versatile range library.@@ -24,7 +24,7 @@ value offering of this library. If this is your first time using this library it is highly recommended that you start- with "Data.Range.Range"; it contains the basics of this library that meet most use+ with "Data.Range"; it contains the basics of this library that meet most use cases. homepage: https://bitbucket.org/robertmassaioli/range@@ -55,14 +55,13 @@ library -- Modules exported by the library.- exposed-modules: Data.Range.Range- , Data.Range.NestedRange- , Data.Range.RangeTree+ exposed-modules: Data.Range , Data.Range.Parser , Data.Range.Algebra -- Modules included in this library but not exported. other-modules: Data.Range.Data+ , Data.Range.Operators , Data.Range.RangeInternal , Data.Range.Spans , Data.Range.Util