typed-range (empty) → 0.1.0.0

raw patch · 17 files changed

+2023/−0 lines, 17 filesdep +Cabaldep +QuickCheckdep +basesetup-changed

Dependencies added: Cabal, QuickCheck, base, free, optics-core, parsec, random, test-framework, test-framework-quickcheck2, typed-range

Files

• Data/Range/Typed.hs +478/−0
• Data/Range/Typed/Algebra.hs +87/−0
• Data/Range/Typed/Algebra/Internal.hs +57/−0
• Data/Range/Typed/Algebra/Predicate.hs +16/−0
• Data/Range/Typed/Algebra/Range.hs +9/−0
• Data/Range/Typed/Data.hs +172/−0
• Data/Range/Typed/Operators.hs +77/−0
• Data/Range/Typed/Parser.hs +100/−0
• Data/Range/Typed/RangeInternal.hs +278/−0
• Data/Range/Typed/Ranges.hs +110/−0
• Data/Range/Typed/Spans.hs +50/−0
• Data/Range/Typed/Util.hs +218/−0
• LICENSE +20/−0
• Setup.hs +3/−0
• Test/Range.hs +131/−0
• Test/RangeMerge.hs +138/−0
• typed-range.cabal +79/−0

@@ -0,0 +1,478 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | 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 (InclusiveBound 1) (ExclusiveBound 5)@+--+-- 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:+--+-- >>> [anyRange $ SingletonRange 5, anyRange $ SpanRange (InclusiveBound 1) (ExclusiveBound 5), anyRange 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 [anyRange (5 :: Integer) +=+ 10, anyRange $ 20 +=+ 30, anyRange $ lbi 25]+-- [5 +=+ 10,lbi 20]+--+-- You can then test if elements are within this range:+--+-- >>> let ranges = mergeRanges [anyRange (5 :: Integer) +=+ 10, anyRange $ 20 +=+ 30, anyRange $ 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 [anyRange $ v [1, 1, 0] +=+ v [1,2,1], anyRange $ v [1,3] +=* v [1,4], anyRange $ 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.Typed+  ( -- * Range creation+    (+=+),+    (+=*),+    (*=+),+    (*=*),+    lbi,+    lbe,+    ubi,+    ube,+    inf,+    empty,+    singleton,++    -- * `AnyRange`-related+    anyRange,+    anyRangeFor,+    withRange,++    -- * `Bound`-related+    compareLower,+    compareHigher,+    compareLowerIntersection,+    compareHigherIntersection,+    compareUpperToLower,+    minBounds,+    maxBounds,+    minBoundsIntersection,+    maxBoundsIntersection,+    insertionSort,+    invertBound,+    isEmptySpan,+    removeEmptySpans,+    boundsOverlapType,+    orOverlapType,+    pointJoinType,+    boundCmp,+    boundIsBetween,+    singletonInSpan,+    againstLowerBound,+    againstUpperBound,+    lowestValueInLowerBound,+    highestValueInUpperBound,+    boundValue,+    boundValueNormalized,+    boundIsInclusive,++    -- * Comparison functions+    inRange,+    inRanges,+    aboveRange,+    aboveRanges,+    belowRange,+    belowRanges,+    rangesOverlap,+    rangesAdjoin,++    -- * Set operations+    mergeRanges,+    union,+    intersection,+    difference,+    invert,++    -- * Enumerable methods+    fromRanges,+    joinRanges,++    -- * Data types+    Bound (..),+    AnyRangeFor (..),+    Range (..),+    AnyRange,+    AnyRangeConstraint,+    WithLowerBound (..),+    WithUpperBound (..),+    WithAllBounds,+  )+where++import qualified Data.Range.Typed.Algebra as Alg+import Data.Range.Typed.Data+import Data.Range.Typed.Operators+import Data.Range.Typed.RangeInternal+import Data.Range.Typed.Util++-- | Performs a set union between the two input ranges and returns the resultant set of+-- ranges.+--+-- For example:+--+-- >>> union [anyRange $ 1 +=+ 10] [anyRange $ 5 +=+ (15 :: Integer)]+-- [1 +=+ 15]+-- (0.00 secs, 587,152 bytes)+union :: (Ord a) => [AnyRange a] -> [AnyRange a] -> [AnyRange 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 [anyRange $ 1 +=* 10] [anyRange $ 5 +=+ (15 :: Integer)]+-- [5 +=* 10]+-- (0.00 secs, 584,616 bytes)+intersection :: (Ord a) => [AnyRange a] -> [AnyRange a] -> [AnyRange 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 [anyRange $ 1 +=+ 10] [anyRange $ 5 +=+ (15 :: Integer)]+-- [1 +=* 5]+-- (0.00 secs, 590,424 bytes)+difference :: (Ord a) => [AnyRange a] -> [AnyRange a] -> [AnyRange 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 [anyRange $ 1 +=* 10, anyRange $ 15 *=+ (20 :: Integer)]+-- [ube 1,10 +=+ 15,lbe 20]+-- (0.00 secs, 623,456 bytes)+invert :: (Ord a) => [AnyRange a] -> [AnyRange 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 l0 h0 a -> Range l1 h1 a -> Bool+rangesOverlap a b = Overlap == rangesOverlapType a b++rangesOverlapType :: (Ord a) => Range l0 h0 a -> Range l1 h1 a -> OverlapType+rangesOverlapType (SingletonRange a) x = rangesOverlapType (SpanRange b b) x+  where+    b = InclusiveBound a+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 EmptyRange EmptyRange = Overlap+rangesOverlapType EmptyRange _ = Separate+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 l0 h0 a -> Range l1 h1 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 l h a -> a -> Bool+inRange (SingletonRange a) value = value == a+inRange (SpanRange x y) value = Overlap == boundIsBetween (InclusiveBound value) (x, y)+inRange (LowerBoundRange lower) value = Overlap == againstLowerBound (InclusiveBound value) lower+inRange (UpperBoundRange upper) value = Overlap == againstUpperBound (InclusiveBound value) upper+inRange InfiniteRange _ = True+inRange EmptyRange _ = False++-- | 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) => [AnyRange a] -> a -> Bool+inRanges rs a = any (withRange (`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 l h a -> a -> Bool+aboveRange (SingletonRange a) value = value > a+aboveRange (SpanRange _ y) value = Overlap == againstLowerBound (InclusiveBound value) (invertBound y)+aboveRange (LowerBoundRange _) _ = False+aboveRange (UpperBoundRange upper) value = Overlap == againstLowerBound (InclusiveBound value) (invertBound upper)+aboveRange InfiniteRange _ = False+aboveRange EmptyRange _ = True++-- | Checks if the value provided is above all of the ranges provided.+aboveRanges :: (Ord a) => [AnyRange a] -> a -> Bool+aboveRanges rs a = all (withRange (`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 l h a -> a -> Bool+belowRange (SingletonRange a) value = value < a+belowRange (SpanRange x _) value = Overlap == againstUpperBound (InclusiveBound value) (invertBound x)+belowRange (LowerBoundRange lower) value = Overlap == againstUpperBound (InclusiveBound value) (invertBound lower)+belowRange (UpperBoundRange _) _ = False+belowRange InfiniteRange _ = False+belowRange EmptyRange _ = True++-- | Checks if the value provided is below all of the ranges provided.+belowRanges :: (Ord a) => [AnyRange a] -> a -> Bool+belowRanges rs a = all (withRange (`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 [anyRange $ lbi 12, anyRange $ 1 +=+ 10, anyRange $ 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) => [AnyRange a] -> [AnyRange 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 $ [anyRange $ 1 +=+ (10 :: Integer), anyRange $ 20 +=+ 30]+-- [1,20,2,21,3]+-- (0.01 secs, 566,016 bytes)+--+-- An infinite range:+--+-- >>> take 5 . fromRanges $ [anyRange (inf :: Range Integer)]+-- [0,1,-1,2,-2]+-- (0.00 secs, 566,752 bytes)+fromRanges :: forall a. (Ord a, Enum a) => [AnyRange a] -> [a]+fromRanges = takeEvenly . fmap (withRange fromRange) . mergeRanges+  where+    fromRange :: Range l h a -> [a]+    fromRange =+      \case+        EmptyRange -> []+        SingletonRange x -> [x]+        SpanRange a b -> [boundValueNormalized succ a .. boundValueNormalized pred b]+        LowerBoundRange x -> iterate succ $ boundValueNormalized succ x+        UpperBoundRange x -> iterate pred $ boundValueNormalized 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 [anyRange $ 1 +=+ 5, anyRange $ 6 +=+ 10] :: [AnyRange 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 [anyRange $ 1.5 +=+ 5.5, anyRange $ 6.5 +=+ 10.5] :: [AnyRange 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 [anyRange $ 1 +=+ 5, anyRange $ 6 +=+ 10] :: [AnyRange 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) => [AnyRange a] -> [AnyRange a]+joinRanges = exportRangeMerge . joinRM . loadRanges

@@ -0,0 +1,87 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- | Internally the range library converts your ranges into an internal+-- efficient representation of multiple ranges. When you do multiple unions and+-- intersections in a row converting to and from that data structure becomes+-- extra work that is not required. To amortize those costs away the @RangeExpr@+-- algebra exists. You can specify a tree of operations in advance and then+-- evaluate them all at once. This is not only useful for efficiency but for+-- parsing too. Build up @RangeExpr@'s whenever you wish to perform multiple+-- operations in a row, and evaluate it in one step to be as efficient as possible.+--+-- __Note:__ This module is based on F-Algebras to do much of the heavy conceptual+-- lifting. If you have never seen F-Algebras before then I highly recommend reading+-- through <https://www.schoolofhaskell.com/user/bartosz/understanding-algebras this introductory content>+-- from the School of Haskell.+--+-- == Examples+--+-- A simple example of using this module would look like this:+--+-- >>> import qualified Data.Range.Algebra as A+-- (A.eval . A.invert $ A.const [anyRange $ singleton 5]) :: [AnyRange Integer]+-- [LowerBoundRange 6,UpperBoundRange 4]+-- (0.01 secs, 597,656 bytes)+--+-- You can also use this module to evaluate range predicates.+module Data.Range.Typed.Algebra+  ( RangeExpr,++    -- ** Operations+    const,+    invert,+    union,+    intersection,+    difference,++    -- ** Evaluation+    Algebra,+    RangeAlgebra (..),+  )+where++import Control.Monad.Free+import Data.Range.Typed.Algebra.Internal+import Data.Range.Typed.Algebra.Predicate+import Data.Range.Typed.Algebra.Range+import Data.Range.Typed.Data+import Prelude hiding (const)++-- | Lifts the input value as a constant into an expression.+const :: a -> RangeExpr a+const = RangeExpr . Pure++-- | Returns an expression that represents the inverse of the input expression.+invert :: RangeExpr a -> RangeExpr a+invert = RangeExpr . Free . Invert . getFree++-- | Returns an expression that represents the set union of the input expressions.+union :: RangeExpr a -> RangeExpr a -> RangeExpr a+union a b = RangeExpr . Free $ Union (getFree a) (getFree b)++-- | Returns an expression that represents the set intersection of the input expressions.+intersection :: RangeExpr a -> RangeExpr a -> RangeExpr a+intersection a b = RangeExpr . Free $ Intersection (getFree a) (getFree b)++-- | Returns an expression that represents the set difference of the input expressions.+difference :: RangeExpr a -> RangeExpr a -> RangeExpr a+difference a b = RangeExpr . Free $ Difference (getFree a) (getFree b)++-- | Represents the fact that there exists an algebra for the given representation+-- of a range, so that a range expression of the same type can be evaluated, yielding+-- that representation.+class RangeAlgebra a where+  -- | This function is used to convert your built expressions into ranges.+  eval :: Algebra RangeExpr a++-- | 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) => RangeAlgebra [AnyRange a] where+  eval = iter rangeAlgebra . getFree++-- | Multiple ranges represented by a predicate function, indicating membership+-- of a point in one of the ranges.+instance RangeAlgebra (a -> Bool) where+  eval = iter predicateAlgebra . getFree

@@ -0,0 +1,57 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}++module Data.Range.Typed.Algebra.Internal where++import Control.Monad.Free+import Data.Functor.Classes+import Data.Range.Typed.RangeInternal+import Prelude hiding (const)++data RangeExprF r+  = Invert r+  | Union r r+  | Intersection r r+  | Difference r r+  deriving (Show, Eq, Functor)++instance Eq1 RangeExprF where+  liftEq eq (Invert a) (Invert b) = eq a b+  liftEq eq (Union a c) (Union b d) = eq a b && eq c d+  liftEq eq (Intersection a c) (Intersection b d) = eq a b && eq c d+  liftEq eq (Difference a c) (Difference b d) = eq a b && eq c d+  liftEq _ _ _ = False++instance Show1 RangeExprF where+  liftShowsPrec showPrec _ p =+    \case+      Invert x -> showString "not " . showParen True (showPrec (p + 1) x)+      Union a b ->+        showPrec (p + 1) a+          . showString " \\/ "+          . showPrec (p + 1) b+      Intersection a b ->+        showPrec (p + 1) a+          . showString " /\\ "+          . showPrec (p + 1) b+      Difference a b ->+        showPrec (p + 1) a+          . showString " - "+          . showPrec (p + 1) b++newtype RangeExpr a = RangeExpr {getFree :: Free RangeExprF a}+  deriving (Show, Eq, Functor)++-- | This is an F-Algebra. You don't need to know what this is in order to be able+-- to use this module, but, if you are interested you can+-- <https://www.schoolofhaskell.com/user/bartosz/understanding-algebras read more on School of Haskell>.+type Algebra f a = f a -> a++rangeMergeAlgebra :: (Ord a) => Algebra RangeExprF (RangeMerge a)+rangeMergeAlgebra =+  \case+    Invert a -> invertRM a+    Union a b -> a `unionRangeMerges` b+    Intersection a b -> a `intersectionRangeMerges` b+    Difference a b -> a `intersectionRangeMerges` invertRM b

@@ -0,0 +1,16 @@+{-# LANGUAGE LambdaCase #-}++module Data.Range.Typed.Algebra.Predicate where++import Control.Applicative+import Data.Range.Typed.Algebra.Internal++predicateAlgebra :: Algebra RangeExprF (a -> Bool)+predicateAlgebra =+  \case+    Invert f -> liftA not f+    Union f g -> liftA2 (||) f g+    Intersection f g -> liftA2 (&&) f g+    Difference f g -> liftA2 (&&~) f g+  where+    (&&~) a b = a && not b

@@ -0,0 +1,9 @@+module Data.Range.Typed.Algebra.Range where++import Control.Monad.Free+import Data.Range.Typed.Algebra.Internal+import Data.Range.Typed.Data+import Data.Range.Typed.RangeInternal (exportRangeMerge, loadRanges)++rangeAlgebra :: (Ord a) => Algebra RangeExprF [AnyRange a]+rangeAlgebra = exportRangeMerge . iter rangeMergeAlgebra . Free . fmap (Pure . loadRanges)

@@ -0,0 +1,172 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}++-- | The Data module for common data types within the code.+module Data.Range.Typed.Data where++import Data.Kind+import Optics.Getter (view)+import Optics.Lens (Lens', lens)+import Optics.Setter (set)++data OverlapType = Separate | Overlap | Adjoin+  deriving (Eq, Show)++-- | Represents a bound, with exclusiveness.+data Bound a+  = -- | The value should be included in the bound.+    InclusiveBound a+  | -- | The value should be excluded in the bound.+    ExclusiveBound a+  deriving stock (Eq, Show, Functor)++-- | All kinds of ranges.+data Range (hasLowerBound :: Bool) (hasUpperBound :: Bool) (a :: Type) where+  -- | A single element. It is equivalent to @SpanRange (InclusiveBound a) (InclusiveBound a)@.+  SingletonRange :: a -> Range 'True 'True a+  -- | A span of elements. Make sure lower bound <= upper bound.+  SpanRange :: Bound a -> Bound a -> Range 'True 'True a+  -- | A range with a finite lower bound and an infinite upper bound.+  LowerBoundRange :: Bound a -> Range 'True 'False a+  -- | A range with an infinite lower bound and a finite upper bound.+  UpperBoundRange :: Bound a -> Range 'False 'True a+  -- | An infinite range.+  InfiniteRange :: Range 'False 'False a+  -- | An empty range.+  EmptyRange :: Range 'False 'False a++deriving stock instance (Eq a) => Eq (Range l r a)++deriving stock instance Functor (Range l r)++instance (Show a) => Show (Range r l a) where+  showsPrec i =+    \case+      SingletonRange a -> (<>) "singleton " . showsPrec i a+      SpanRange lBound rBound ->+        let s l symbol r = showsPrec i l . (<>) symbol . showsPrec i r+         in case (lBound, rBound) of+              (InclusiveBound l, InclusiveBound r) -> s l " +=+ " r+              (InclusiveBound l, ExclusiveBound r) -> s l " +=* " r+              (ExclusiveBound l, InclusiveBound r) -> s l " *=+ " r+              (ExclusiveBound l, ExclusiveBound r) -> s l " *=* " r+      (LowerBoundRange (InclusiveBound a)) -> (<>) "lbi " . showsPrec i a+      (LowerBoundRange (ExclusiveBound a)) -> (<>) "lbe " . showsPrec i a+      (UpperBoundRange (InclusiveBound a)) -> (<>) "ubi " . showsPrec i a+      (UpperBoundRange (ExclusiveBound a)) -> (<>) "ube " . showsPrec i a+      InfiniteRange -> (<>) "inf"+      EmptyRange -> (<>) "empty"++type AnyRange = AnyRangeFor AnyRangeConstraint++class AnyRangeConstraint (range :: Type -> Type)++instance AnyRangeConstraint (Range l r)++data AnyRangeFor (c :: (Type -> Type) -> Constraint) a+  = forall hasLowerBound hasUpperBound.+    (c (Range hasLowerBound hasUpperBound)) =>+    AnyRangeFor (Range hasLowerBound hasUpperBound a)++instance (Show a) => Show (AnyRangeFor c a) where+  showsPrec i (AnyRangeFor range) =+    showsPrec i range++instance (Eq a) => Eq (AnyRangeFor c a) where+  AnyRangeFor lower == AnyRangeFor upper =+    case (lower, upper) of+      (SingletonRange l, SingletonRange r) -> r == l+      (SpanRange ll lr, SpanRange rl rr) -> rl == ll && lr == rr+      (LowerBoundRange l, LowerBoundRange r) -> r == l+      (UpperBoundRange l, UpperBoundRange r) -> r == l+      (InfiniteRange, InfiniteRange) -> True+      (EmptyRange, EmptyRange) -> True+      _ -> False++instance Functor (AnyRangeFor c) where+  fmap i (AnyRangeFor range) =+    AnyRangeFor $ fmap i range++-- | `Range` has a lower bound+class WithLowerBound range where+  -- | Changing `Range`'s lower bound (preserving the constructor)+  lowerBound :: Lens' (range a) (Bound a)++instance WithLowerBound (Range 'True hasUpperBound) where+  lowerBound = lens g s+    where+      g :: Range 'True hasUpperBound a -> Bound a+      g =+        \case+          SingletonRange a -> InclusiveBound a+          SpanRange x _ -> x+          LowerBoundRange x -> x+      s :: Range 'True hasUpperBound a -> Bound a -> Range 'True hasUpperBound a+      s range y =+        case range of+          SingletonRange _ ->+            SingletonRange $+              case y of+                InclusiveBound y' -> y'+                ExclusiveBound y' -> y'+          SpanRange _ x -> SpanRange y x+          LowerBoundRange _ -> LowerBoundRange y++instance WithLowerBound (AnyRangeFor WithLowerBound) where+  lowerBound =+    lens+      (\(AnyRangeFor range) -> view lowerBound range)+      (\(AnyRangeFor range) bound -> AnyRangeFor $ set lowerBound bound range)++instance WithLowerBound (AnyRangeFor WithAllBounds) where+  lowerBound =+    lens+      (\(AnyRangeFor range) -> view lowerBound range)+      (\(AnyRangeFor range) bound -> AnyRangeFor $ set lowerBound bound range)++-- | `Range` has a upper bound+class WithUpperBound range where+  -- | Changing `Range`'s upper bound (preserving the constructor)+  upperBound :: Lens' (range a) (Bound a)++instance WithUpperBound (Range hasLowerBound 'True) where+  upperBound = lens g s+    where+      g :: Range hasLowerBound 'True a -> Bound a+      g =+        \case+          SingletonRange a -> InclusiveBound a+          SpanRange x _ -> x+          UpperBoundRange x -> x+      s :: Range hasLowerBound 'True a -> Bound a -> Range hasLowerBound 'True a+      s range y =+        case range of+          SingletonRange _ ->+            SingletonRange $+              case y of+                InclusiveBound y' -> y'+                ExclusiveBound y' -> y'+          SpanRange x _ -> SpanRange x y+          UpperBoundRange _ -> UpperBoundRange y++instance WithUpperBound (AnyRangeFor WithUpperBound) where+  upperBound =+    lens+      (\(AnyRangeFor range) -> view upperBound range)+      (\(AnyRangeFor range) bound -> AnyRangeFor $ set upperBound bound range)++instance WithUpperBound (AnyRangeFor WithAllBounds) where+  upperBound =+    lens+      (\(AnyRangeFor range) -> view upperBound range)+      (\(AnyRangeFor range) bound -> AnyRangeFor $ set upperBound bound range)++class (WithLowerBound a, WithUpperBound a) => WithAllBounds (a :: Type -> Type)++instance (WithLowerBound a, WithUpperBound a) => WithAllBounds a

@@ -0,0 +1,77 @@+{-# LANGUAGE RankNTypes #-}++module Data.Range.Typed.Operators where++import Data.Range.Typed.Data++-- | Mathematically equivalent to @[x, y]@.+--+-- @x +=+ y@ is the short version of @SpanRange (InclusiveBound x) (InclusiveBound y)@+(+=+) :: a -> a -> Range 'True 'True a+(+=+) x y = SpanRange (InclusiveBound x) (InclusiveBound y)++-- | Mathematically equivalent to @[x, y)@.+--+-- @x +=* y@ is the short version of @SpanRange (InclusiveBound x) (ExclusiveBound y)@+(+=*) :: a -> a -> Range 'True 'True a+(+=*) x y = SpanRange (InclusiveBound x) (ExclusiveBound y)++-- | Mathematically equivalent to @(x, y]@.+--+-- @x *=+ y@ is the short version of @SpanRange (ExclusiveBound x) (InclusiveBound y)@+(*=+) :: a -> a -> Range 'True 'True a+(*=+) x y = SpanRange (ExclusiveBound x) (InclusiveBound y)++-- | Mathematically equivalent to @(x, y)@.+--+-- @x *=* y@ is the short version of @SpanRange (ExclusiveBound x) (ExclusiveBound y)@+(*=*) :: a -> a -> Range 'True 'True a+(*=*) x y = SpanRange (ExclusiveBound x) (ExclusiveBound y)++-- | Mathematically equivalent to @[x, Infinity)@.+--+-- @lbi x@ is the short version of @LowerBoundRange (InclusiveBound x)@+lbi :: a -> Range 'True 'False a+lbi = LowerBoundRange . InclusiveBound++-- | Mathematically equivalent to @(x, Infinity)@.+--+-- @lbe x@ is the short version of @LowerBoundRange (ExclusiveBound x)@+lbe :: a -> Range 'True 'False a+lbe = LowerBoundRange . ExclusiveBound++-- | Mathematically equivalent to @(Infinity, x]@.+--+-- @ubi x@ is the short version of @UpperBoundRange (InclusiveBound x)@+ubi :: a -> Range 'False 'True a+ubi = UpperBoundRange . InclusiveBound++-- | Mathematically equivalent to @(Infinity, x)@.+--+-- @ube x@ is the short version of @UpperBoundRange (ExclusiveBound x)@+ube :: a -> Range 'False 'True a+ube = UpperBoundRange . ExclusiveBound++-- | Shorthand for the `InfiniteRange`+inf :: Range 'False 'False a+inf = InfiniteRange++-- | Shorthand for the `EmptyRange`+empty :: Range 'False 'False a+empty = EmptyRange++-- | Shorthand for the `SingletonRange`+singleton :: a -> Range 'True 'True a+singleton = SingletonRange++-- | Shorthand for the `AnyRangeFor`+anyRange :: forall a l h. Range l h a -> AnyRange a+anyRange = AnyRangeFor++-- | Shorthand for the `AnyRangeFor`+anyRangeFor :: forall c a l h. (c (Range l h)) => Range l h a -> AnyRangeFor c a+anyRangeFor = AnyRangeFor++-- | Apply a function over `AnyRangeFor`+withRange :: (forall l h. (c (Range l h)) => Range l h a -> b) -> AnyRangeFor c a -> b+withRange f (AnyRangeFor range) = f range

@@ -0,0 +1,100 @@+{-# LANGUAGE FlexibleContexts #-}++-- | This package provides a simple range parser.+--+-- This range parser was designed to be a useful tool for CLI programs. For example, by+-- default, this example depicts how the parser works:+--+-- >>> parseRanges "-5,8-10,13-15,20-" :: Either ParseError [AnyRange Integer]+-- Right [UpperBoundRange 5,SpanRange 8 10,SpanRange 13 15,LowerBoundRange 20]+-- (0.01 secs, 681,792 bytes)+--+-- 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.+--+-- To handle more complex parsing cases it is recommended that you use the ranges library+-- in conjunction with parsec or Alex/Happy and convert the versions that you find into+-- ranges.+module Data.Range.Typed.Parser+  ( parseRanges,+    customParseRanges,+    RangeParserArgs (..),+    defaultArgs,+    ranges,+    ParseError,+  )+where++import Data.Range.Typed+import Text.Parsec+import Text.Parsec.String++-- | These are the arguments that will be used when parsing a string as a range.+data RangeParserArgs = Args+  { -- | A separator that represents a union.+    unionSeparator :: String,+    -- | A separator that separates the two halves of a range.+    rangeSeparator :: String,+    -- | A separator that implies an unbounded range.+    wildcardSymbol :: String+  }+  deriving (Show)++-- | These are the default arguments that are used by the parser. Please feel free to use+-- the default arguments for you own parser and modify it from the defaults at will.+defaultArgs :: RangeParserArgs+defaultArgs =+  Args+    { unionSeparator = ",",+      rangeSeparator = "-",+      wildcardSymbol = "*"+    }++-- | Given a string, this function will either return a parse error back to the user or the+-- list of ranges that are represented by the parsed string. Very useful for CLI programs+-- that need to load ranges from a single-line string.+parseRanges :: (Read a) => String -> Either ParseError [AnyRange a]+parseRanges = parse (ranges defaultArgs) "(range parser)"++-- | If you disagree with the default characters for separating ranges then this function can+-- be used to customise them, up to a point.+customParseRanges :: (Read a) => RangeParserArgs -> String -> Either ParseError [AnyRange a]+customParseRanges args = parse (ranges args) "(range parser)"++string_ :: (Stream s m Char) => String -> ParsecT s u m ()+string_ x = string x >> return ()++-- | Given the parser arguments this returns a parsec parser that is capable of parsing a list of+-- ranges.+ranges :: (Read a) => RangeParserArgs -> Parser [AnyRange a]+ranges args = range `sepBy` (string $ unionSeparator args)+  where+    range :: (Read a) => Parser (AnyRange a)+    range =+      choice+        [ infiniteRange,+          spanRange,+          singletonRange+        ]++    infiniteRange :: (Read a) => Parser (AnyRange a)+    infiniteRange = do+      string_ $ wildcardSymbol args+      return $ anyRange InfiniteRange++    spanRange :: (Read a) => Parser (AnyRange a)+    spanRange = try $ do+      first <- readSection+      string_ $ rangeSeparator args+      second <- readSection+      case (first, second) of+        (Just x, Just y) -> return $ anyRange $ SpanRange (InclusiveBound x) (InclusiveBound y)+        (Just x, _) -> return $ anyRange $ LowerBoundRange (InclusiveBound x)+        (_, Just y) -> return $ anyRange $ UpperBoundRange (InclusiveBound y)+        _ -> parserFail ("Range should have a number on one end: " ++ rangeSeparator args)++    singletonRange :: (Read a) => Parser (AnyRange a)+    singletonRange = fmap (anyRange . SingletonRange . read) $ many1 digit++readSection :: (Read a) => Parser (Maybe a)+readSection = fmap (fmap read) $ optionMaybe (many1 digit)

@@ -0,0 +1,278 @@+{-# LANGUAGE LambdaCase #-}++module Data.Range.Typed.RangeInternal where++import Control.Monad (guard)+import Data.Functor (($>))+import Data.Maybe (catMaybes, mapMaybe)+import Data.Range.Typed.Data+import Data.Range.Typed.Spans+import Data.Range.Typed.Util++{-+ - The following assumptions must be maintained at the beginning of these internal+ - functions so that we can reason about what we are given.+ -+ - RangeMerge assumptions:+ - * The span ranges will never overlap the bounds.+ - * The span ranges are always sorted in ascending order by the first element.+ - * The lower and upper bounds never overlap in such a way to make it an infinite range.+ -}+data RangeMerge a+  = RM+      { largestLowerBound :: Maybe (Bound a),+        largestUpperBound :: Maybe (Bound a),+        spanRanges :: [(Bound a, Bound a)]+      }+  | IRM+  | ERM+  deriving (Show, Eq)++emptyRangeMerge :: RangeMerge a+emptyRangeMerge = RM Nothing Nothing []++storeRange :: (Ord a) => AnyRangeFor c a -> RangeMerge a+storeRange (AnyRangeFor range) =+  case range of+    InfiniteRange -> IRM+    EmptyRange -> ERM+    LowerBoundRange lower -> emptyRangeMerge {largestLowerBound = Just lower}+    UpperBoundRange upper -> emptyRangeMerge {largestUpperBound = Just upper}+    SpanRange x y+      | boundValue x == boundValue y && pointJoinType x y == Separate -> emptyRangeMerge+      | otherwise -> emptyRangeMerge {spanRanges = [(minBounds x y, maxBounds x y)]}+    SingletonRange x -> emptyRangeMerge {spanRanges = [(InclusiveBound x, InclusiveBound x)]}++storeRanges :: (Ord a) => RangeMerge a -> [AnyRangeFor c a] -> RangeMerge a+storeRanges = foldr (unionRangeMerges . storeRange)++loadRanges :: (Ord a) => [AnyRangeFor c a] -> RangeMerge a+loadRanges = storeRanges emptyRangeMerge+{-# INLINE [0] loadRanges #-}++exportRangeMerge :: (Eq a) => RangeMerge a -> [AnyRange a]+exportRangeMerge =+  \case+    IRM -> [AnyRangeFor InfiniteRange]+    ERM -> [AnyRangeFor EmptyRange]+    RM lb up spans ->+      let putLowerBound :: Maybe (Bound a) -> [AnyRange a]+          putLowerBound = maybe [] (return . AnyRangeFor . LowerBoundRange)+          putUpperBound :: Maybe (Bound a) -> [AnyRange a]+          putUpperBound = maybe [] (return . AnyRangeFor . UpperBoundRange)+          putSpans = map simplifySpan+          simplifySpan (x, y) =+            if x == y && pointJoinType x y /= Separate+              then AnyRangeFor $ SingletonRange $ boundValue x+              else AnyRangeFor $ SpanRange x y+       in putUpperBound up <> putSpans spans <> putLowerBound lb++{-# 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+  where+    newSpans = intersectSpans (spanRanges one) (spanRanges two)++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 = mapMaybe (fix lower) xs++fixLower :: (Ord a) => Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)+fixLower lower (x, y) = do+  guard (boundValue lower <= boundValue y)+  return (maxBoundsIntersection lower x, y)++fixUpper :: (Ord a) => Bound a -> (Bound a, Bound a) -> Maybe (Bound a, Bound a)+fixUpper upper (x, y) = do+  guard (boundValue x <= boundValue upper)+  return (x, minBoundsIntersection y upper)++intersectionRangeMerges :: (Ord a) => RangeMerge a -> RangeMerge a -> RangeMerge a+intersectionRangeMerges ERM _ = ERM+intersectionRangeMerges _ ERM = ERM+intersectionRangeMerges IRM two = two+intersectionRangeMerges one IRM = one+intersectionRangeMerges one two =+  RM+    { largestLowerBound = newLowerBound,+      largestUpperBound = newUpperBound,+      spanRanges = unionSpans sortedResults+    }+  where+    lowerOneSpans = intersectWith fixLower (largestLowerBound one) (spanRanges two)+    lowerTwoSpans = intersectWith fixLower (largestLowerBound two) (spanRanges one)+    upperOneSpans = intersectWith fixUpper (largestUpperBound one) (spanRanges two)+    upperTwoSpans = intersectWith fixUpper (largestUpperBound two) (spanRanges one)+    intersectedSpans = intersectSpans (spanRanges one) (spanRanges two)++    sortedResults =+      removeEmptySpans $+        foldr1+          insertionSortSpans+          [ lowerOneSpans,+            lowerTwoSpans,+            upperOneSpans,+            upperTwoSpans,+            intersectedSpans,+            calculateBoundOverlap one two+          ]++    newLowerBound = calculateNewBound largestLowerBound maxBoundsIntersection one two+    newUpperBound = calculateNewBound largestUpperBound minBoundsIntersection one two++    calculateNewBound ::+      (Ord a) =>+      (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) => RangeMerge a -> RangeMerge a -> [(Bound a, Bound a)]+calculateBoundOverlap one two = catMaybes [oneWay, secondWay]+  where+    oneWay = do+      x <- largestLowerBound one+      y <- largestUpperBound two+      guard (compareLower y x /= LT)+      return (x, y)++    secondWay = do+      x <- largestLowerBound two+      y <- largestUpperBound one+      guard (compareLower y x /= LT)+      return (x, y)++unionRangeMerges :: (Ord a) => RangeMerge a -> RangeMerge a -> RangeMerge a+unionRangeMerges ERM one = one+unionRangeMerges one ERM = one+unionRangeMerges IRM _ = IRM+unionRangeMerges _ IRM = IRM+unionRangeMerges one two = infiniteCheck filterTwo+  where+    filterOne = foldr filterLowerBound boundedRM (unionSpans sortedSpans)+    filterTwo = foldr filterUpperBound (filterOne {spanRanges = []}) (spanRanges filterOne)++    infiniteCheck :: (Ord a) => RangeMerge a -> RangeMerge a+    infiniteCheck IRM = IRM+    infiniteCheck rm@(RM (Just lower) (Just upper) _) =+      if compareUpperToLower upper lower /= LT+        then IRM+        else rm+    infiniteCheck rm = rm++    newLowerBound = calculateNewBound largestLowerBound minBounds one two+    newUpperBound = calculateNewBound largestUpperBound maxBounds one two++    sortedSpans = insertionSortSpans (spanRanges one) (spanRanges two)++    boundedRM =+      RM+        { largestLowerBound = newLowerBound,+          largestUpperBound = newUpperBound,+          spanRanges = []+        }++    calculateNewBound ::+      (Ord a) =>+      (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) => (Bound a, Bound a) -> RangeMerge a -> RangeMerge a+filterLowerBound _ ERM = ERM+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 $ minBounds lowestBound lower}++filterUpperBound :: (Ord a) => (Bound a, Bound a) -> RangeMerge a -> RangeMerge a+filterUpperBound _ ERM = ERM+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 $ maxBounds upperBound' upper}++invertRM :: (Ord a) => RangeMerge a -> RangeMerge a+invertRM ERM = IRM+invertRM IRM = emptyRangeMerge+invertRM (RM Nothing Nothing []) = IRM+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 = invertBound $ snd $ last $ spanRanges rm+    newUpperValue = invertBound $ fst $ head $ spanRanges rm++    newUpperBound = case largestUpperBound rm of+      Just _ -> Nothing+      Nothing -> Just newUpperValue++    newLowerBound = case largestLowerBound rm of+      Just _ -> Nothing+      Nothing -> Just newLowerValue++    upperSpan = case largestUpperBound rm of+      Nothing -> []+      Just upper -> [(invertBound upper, newUpperValue)]+    lowerSpan = case largestLowerBound rm of+      Nothing -> []+      Just lower -> [(newLowerValue, invertBound lower)]++    betweenSpans = invertSpans $ spanRanges rm++joinRM :: (Eq a, Enum a) => RangeMerge a -> RangeMerge a+joinRM o@(RM _ _ []) = o+joinRM rm = RM lower higher spansAfterHigher+  where+    joinedSpans = joinSpans $ spanRanges rm++    (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++    (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++updateBound :: Bound a -> a -> Bound a+updateBound = ($>)++unmergeRM :: RangeMerge a -> [RangeMerge a]+unmergeRM ERM = [ERM]+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

@@ -0,0 +1,110 @@+-- | This module provides a simpler interface than the 'Data.Range' module, allowing you to work with+-- multiple ranges at the same time.+--+-- One of the main advantages of this module is that it implements 'Monoid' for 'Ranges' which lets you+-- write code like:+module Data.Range.Typed.Ranges+  ( -- * Range creation+    (+=+),+    (+=*),+    (*=+),+    (*=*),+    lbi,+    lbe,+    ubi,+    ube,+    inf,++    -- * Comparison functions+    inRanges,+    aboveRanges,+    belowRanges,++    -- * Set operations+    union,+    intersection,+    difference,+    invert,++    -- * Enumerable methods+    fromRanges,+    joinRanges,++    -- * Data types+    Ranges (..),+  )+where++import qualified Data.Range.Typed as R++-- TODO Can we make this use a Range Algebra internally ?+newtype Ranges a = Ranges {unRanges :: [R.AnyRange a]}++instance (Show a) => Show (Ranges a) where+  showsPrec i (Ranges xs) = (<>) "Ranges " . showsPrec i xs++instance (Ord a) => Semigroup (Ranges a) where+  (<>) (Ranges a) (Ranges b) = Ranges . R.mergeRanges $ a <> b++instance (Ord a) => Monoid (Ranges a) where+  mempty = Ranges []+  mconcat = Ranges . R.mergeRanges . concatMap unRanges++instance Functor Ranges where+  fmap f (Ranges xs) = Ranges . fmap (fmap f) $ xs++(+=+) :: a -> a -> Ranges a+(+=+) a b = Ranges $ pure $ R.anyRange $ (R.+=+) a b++(+=*) :: a -> a -> Ranges a+(+=*) a b = Ranges $ pure $ R.anyRange $ (R.+=*) a b++(*=+) :: a -> a -> Ranges a+(*=+) a b = Ranges $ pure $ R.anyRange $ (R.*=+) a b++(*=*) :: a -> a -> Ranges a+(*=*) a b = Ranges $ pure $ R.anyRange $ (R.*=*) a b++lbi :: a -> Ranges a+lbi = Ranges . pure . R.anyRange . R.lbi++lbe :: a -> Ranges a+lbe = Ranges . pure . R.anyRange . R.lbe++ubi :: a -> Ranges a+ubi = Ranges . pure . R.anyRange . R.ubi++ube :: a -> Ranges a+ube = Ranges . pure . R.anyRange . R.ube++inf :: Ranges a+inf = Ranges [R.anyRange R.inf]++inRanges :: (Ord a) => Ranges a -> a -> Bool+inRanges (Ranges xs) = R.inRanges xs++-- | Checks if the value provided is above all of the ranges provided.+aboveRanges :: (Ord a) => Ranges a -> a -> Bool+aboveRanges (Ranges xs) = R.aboveRanges xs++-- | Checks if the value provided is below all of the ranges provided.+belowRanges :: (Ord a) => Ranges a -> a -> Bool+belowRanges (Ranges rs) = R.belowRanges rs++union :: (Ord a) => Ranges a -> Ranges a -> Ranges a+union (Ranges a) (Ranges b) = Ranges $ R.union a b++intersection :: (Ord a) => Ranges a -> Ranges a -> Ranges a+intersection (Ranges a) (Ranges b) = Ranges $ R.intersection a b++difference :: (Ord a) => Ranges a -> Ranges a -> Ranges a+difference (Ranges a) (Ranges b) = Ranges $ R.difference a b++invert :: (Ord a) => Ranges a -> Ranges a+invert = Ranges . R.invert . unRanges++fromRanges :: (Ord a, Enum a) => Ranges a -> [a]+fromRanges = R.fromRanges . unRanges++joinRanges :: (Ord a, Enum a) => Ranges a -> Ranges a+joinRanges = Ranges . R.joinRanges . unRanges

@@ -0,0 +1,50 @@+-- This module contains every function that purely performs operations on spans.+module Data.Range.Typed.Spans where++import Data.Range.Typed.Data+import Data.Range.Typed.Util++-- Assume that both inputs are sorted spans+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) => (Bound a, Bound a) -> (Bound a, Bound a) -> Ordering+spanCmp x@(_, xHighValue) y@(yLowValue, _) =+  if boundsOverlapType x y /= Separate+    then EQ+    else if boundValue xHighValue <= boundValue yLowValue then LT else GT++intersectSpans :: (Ord a) => [(Bound a, Bound a)] -> [(Bound a, Bound a)] -> [(Bound a, Bound a)]+intersectSpans (x@(xlow, xup) : xs) (y@(ylow, yup) : ys) =+  case spanCmp x y of+    EQ -> if not (isEmptySpan intersectedSpan) then intersectedSpan : equalNext else equalNext+    LT -> intersectSpans xs (y : ys)+    GT -> intersectSpans (x : xs) ys+  where+    intersectedSpan = (maxBoundsIntersection xlow ylow, minBoundsIntersection xup yup)++    lessThanNext = intersectSpans xs (y : ys)+    greaterThanNext = intersectSpans (x : xs) ys+    equalNext = if boundValue xup < boundValue yup then lessThanNext else greaterThanNext+intersectSpans _ _ = []++-- Assume that you are given a sorted list of spans+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) => [(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 :: [(Bound a, Bound a)] -> [(Bound a, Bound a)]+invertSpans ((_, x) : s@(y, _) : xs) = (invertBound x, invertBound y) : invertSpans (s : xs)+invertSpans _ = []

@@ -0,0 +1,218 @@+{-# LANGUAGE LambdaCase #-}++module Data.Range.Typed.Util where++import Data.Maybe (mapMaybe)+import Data.Range.Typed.Data+import Optics.Lens (Lens', lens)++-- 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 a b+  | a == b = EQ+  | boundValue a == boundValue b = if boundIsInclusive a then LT else GT+  | boundValue a < boundValue b = LT+  | otherwise = GT++compareHigher :: (Ord a) => Bound a -> Bound a -> Ordering+compareHigher a b+  | a == b = EQ+  | boundValue a == boundValue b = if boundIsInclusive a then GT else LT+  | boundValue a < boundValue b = LT+  | otherwise = GT++compareLowerIntersection :: (Ord a) => Bound a -> Bound a -> Ordering+compareLowerIntersection a b+  | a == b = EQ+  | boundValue a == boundValue b = if boundIsInclusive a then GT else LT+  | boundValue a < boundValue b = LT+  | otherwise = GT++compareHigherIntersection :: (Ord a) => Bound a -> Bound a -> Ordering+compareHigherIntersection a b+  | a == b = EQ+  | boundValue a == boundValue b = if boundIsInclusive a then LT else GT+  | boundValue a < boundValue b = LT+  | otherwise = GT++compareUpperToLower :: (Ord a) => Bound a -> Bound a -> Ordering+compareUpperToLower upper lower+  | boundValue upper == boundValue lower = if boundIsInclusive upper || boundIsInclusive lower then EQ else LT+  | boundValue upper < boundValue 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 = go+  where+    go (f : fs) (s : ss) = case comp f s of+      LT -> f : go fs (s : ss)+      EQ -> f : s : go fs ss+      GT -> s : go (f : fs) ss+    go [] z = z+    go z [] = z++invertBound :: Bound a -> Bound a+invertBound (InclusiveBound x) = ExclusiveBound x+invertBound (ExclusiveBound x) = InclusiveBound x++isEmptySpan :: (Eq a) => (Bound a, Bound a) -> Bool+isEmptySpan (a, b) = boundValue a == boundValue b && (not (boundIsInclusive a) || not (boundIsInclusive b))++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@(a, b) r@(x, y)+  | isEmptySpan l || isEmptySpan r = Separate+  | boundValue a == boundValue x = Overlap+  | boundValue b == boundValue y = Overlap+  | otherwise = (a `boundIsBetween` (x, y)) `orOverlapType` (x `boundIsBetween` (a, b))++orOverlapType :: OverlapType -> OverlapType -> OverlapType+orOverlapType Overlap _ = Overlap+orOverlapType _ Overlap = Overlap+orOverlapType Adjoin _ = Adjoin+orOverlapType _ Adjoin = Adjoin+orOverlapType _ _ = Separate++pointJoinType :: Bound a -> Bound b -> OverlapType+pointJoinType (InclusiveBound _) (InclusiveBound _) = Overlap+pointJoinType (ExclusiveBound _) (ExclusiveBound _) = 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 a (x, y)+  | boundIsBetween a (x, y) /= Separate = EQ+  | boundValue a <= boundValue x = LT+  | otherwise = GT++-- TODO replace everywhere with boundsOverlapType+boundIsBetween :: (Ord a) => Bound a -> (Bound a, Bound a) -> OverlapType+boundIsBetween a (x, y)+  | boundValue x > boundValue a = Separate+  | boundValue x == boundValue a = pointJoinType a x+  | boundValue a < boundValue y = Overlap+  | boundValue a == boundValue y = pointJoinType a y+  | otherwise = Separate++singletonInSpan :: (Ord a) => a -> (Bound a, Bound a) -> OverlapType+singletonInSpan a = boundIsBetween $ InclusiveBound a++againstLowerBound :: (Ord a) => Bound a -> Bound a -> OverlapType+againstLowerBound a lower+  | boundValue lower == boundValue a = pointJoinType a lower+  | boundValue lower < boundValue a = Overlap+  | otherwise = Separate++againstUpperBound :: (Ord a) => Bound a -> Bound a -> OverlapType+againstUpperBound a upper+  | boundValue upper == boundValue a = pointJoinType a upper+  | boundValue a < boundValue upper = Overlap+  | otherwise = Separate++takeEvenly :: [[a]] -> [a]+takeEvenly [] = []+takeEvenly xss = mapMaybe safeHead xss <> takeEvenly (filter (not . null) $ map tail xss)++safeHead :: [a] -> Maybe a+safeHead [] = Nothing+safeHead (x : _) = Just x++pairs :: [a] -> [(a, a)]+pairs [] = []+pairs xs = zip xs (tail xs)++lowestValueInLowerBound :: (Enum a) => Bound a -> a+lowestValueInLowerBound = boundValueNormalized succ++highestValueInUpperBound :: (Enum a) => Bound a -> a+highestValueInUpperBound = boundValueNormalized pred++boundValue :: Bound a -> a+boundValue =+  \case+    InclusiveBound a -> a+    ExclusiveBound a -> a++boundValueNormalized :: (a -> a) -> Bound a -> a+boundValueNormalized normalize =+  \case+    InclusiveBound a -> a+    ExclusiveBound a -> normalize a++boundIsInclusive :: Bound a -> Bool+boundIsInclusive =+  \case+    InclusiveBound _ -> True+    ExclusiveBound _ -> False++-- | Changing `Range`'s lower bound (possibly changing the constructor)+lowerBoundUnstable :: Lens' (AnyRange a) (Maybe (Bound a))+lowerBoundUnstable = lens (\(AnyRangeFor range) -> g range) (\(AnyRangeFor range) -> s range)+  where+    g :: Range hasLowerBound hasUpperBound a -> Maybe (Bound a)+    g =+      \case+        SingletonRange a -> Just $ InclusiveBound a+        SpanRange x _ -> Just x+        LowerBoundRange x -> Just x+        UpperBoundRange _ -> Nothing+        InfiniteRange -> Nothing+        EmptyRange -> Nothing+    s :: Range hasLowerBound hasUpperBound a -> Maybe (Bound a) -> AnyRange a+    s =+      \case+        SingletonRange _ ->+          \case+            Just (InclusiveBound y) -> AnyRangeFor $ SingletonRange y+            Just (ExclusiveBound y) -> AnyRangeFor $ SingletonRange y+            Nothing -> AnyRangeFor EmptyRange+        SpanRange _ x -> maybe (AnyRangeFor $ UpperBoundRange x) (AnyRangeFor . (`SpanRange` x))+        LowerBoundRange _ -> maybe (AnyRangeFor InfiniteRange) (AnyRangeFor . LowerBoundRange)+        UpperBoundRange x -> maybe (AnyRangeFor $ UpperBoundRange x) (AnyRangeFor . (`SpanRange` x))+        InfiniteRange -> maybe (AnyRangeFor InfiniteRange) (AnyRangeFor . LowerBoundRange)+        EmptyRange -> const $ AnyRangeFor EmptyRange++-- | Changing `Range`'s upper bound (possibly changing the constructor)+upperBoundUnstable :: Lens' (AnyRange a) (Maybe (Bound a))+upperBoundUnstable = lens (\(AnyRangeFor range) -> g range) (\(AnyRangeFor range) -> s range)+  where+    g :: Range hasLowerBound hasUpperBound a -> Maybe (Bound a)+    g =+      \case+        SingletonRange a -> Just $ InclusiveBound a+        SpanRange _ x -> Just x+        UpperBoundRange x -> Just x+        LowerBoundRange _ -> Nothing+        InfiniteRange -> Nothing+        EmptyRange -> Nothing+    s :: Range hasLowerBound hasUpperBound a -> Maybe (Bound a) -> AnyRange a+    s =+      \case+        SingletonRange _ ->+          \case+            Just (InclusiveBound y) -> AnyRangeFor $ SingletonRange y+            Just (ExclusiveBound y) -> AnyRangeFor $ SingletonRange y+            Nothing -> AnyRangeFor EmptyRange+        SpanRange x _ -> maybe (AnyRangeFor $ UpperBoundRange x) (AnyRangeFor . SpanRange x)+        UpperBoundRange _ -> maybe (AnyRangeFor InfiniteRange) (AnyRangeFor . UpperBoundRange)+        LowerBoundRange x -> maybe (AnyRangeFor $ LowerBoundRange x) (AnyRangeFor . SpanRange x)+        InfiniteRange -> maybe (AnyRangeFor InfiniteRange) (AnyRangeFor . UpperBoundRange)+        EmptyRange -> const $ AnyRangeFor EmptyRange

@@ -0,0 +1,20 @@+Copyright (c) 2013 Robert Massaioli <robertmassaioli@gmail.com>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,131 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- This is only okay in test classes++module Main where++import Control.Applicative ((<$>), (<*>))+import Data.Range.Typed+import qualified Data.Range.Typed.Algebra as Alg+import System.Random+import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck+import Test.RangeMerge++newtype UnequalPair a = UnequalPair (a, a)+  deriving newtype (Show)++instance (Integral a, Num a, Eq a) => Arbitrary (UnequalPair a) where+  arbitrary = do+    first <- arbitrarySizedIntegral+    second <- arbitrarySizedIntegral `suchThat` (/= first)+    return $ UnequalPair (first, second)++prop_singleton_in_range :: Integer -> Bool+prop_singleton_in_range a = inRange (SingletonRange a) a++prop_singleton_not_in_range :: (Ord a) => UnequalPair a -> Bool+prop_singleton_not_in_range (UnequalPair (first, second)) = not $ inRange (SingletonRange first) second++data SpanContains a = SpanContains (a, a) a+  deriving (Show)++instance (Num a, Integral a, Ord a, Random a) => Arbitrary (SpanContains a) where+  arbitrary = do+    begin <- arbitrarySizedIntegral+    end <- arbitrarySizedIntegral `suchThat` (>= begin)+    middle <- choose (begin, end)+    return $ SpanContains (begin, end) middle++prop_span_contains :: SpanContains Integer -> Bool+prop_span_contains (SpanContains (begin, end) middle) = inRange (SpanRange (InclusiveBound begin) (InclusiveBound end)) middle++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 @Int,+      testProperty "spans contain values in their middles" prop_span_contains,+      testProperty "infinite ranges contain everything" prop_infinite_range_contains_everything+    ]++instance (Num a, Integral a, Ord a, Enum a) => Arbitrary (AnyRange a) where+  arbitrary =+    oneof+      [ anyRange <$> generateSingleton,+        anyRange <$> generateEmpty,+        anyRange <$> generateSpan,+        anyRange <$> generateLowerBound,+        anyRange <$> generateUpperBound,+        anyRange <$> generateInfiniteRange+      ]+    where+      generateEmpty = return EmptyRange+      generateInfiniteRange = return InfiniteRange+      generateSingleton = SingletonRange <$> arbitrarySizedIntegral+      generateSpan = do+        first <- arbitrarySizedIntegral+        second <- arbitrarySizedIntegral `suchThat` (> first)+        return $ first +=+ second+      generateLowerBound = lbi <$> arbitrarySizedIntegral+      generateUpperBound = ubi <$> arbitrarySizedIntegral++-- an intersection of a value followed by a union of that value should be the identity.+-- This is false. An intersection of a value followed by a union of that value should be+-- the value itself.+-- (1, 3) union (3, 4) => (1, 4)+-- (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, [AnyRange 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+    ]++instance (Num a, Integral a, Ord a, Enum a) => Arbitrary (Alg.RangeExpr [AnyRange a]) where+  arbitrary =+    frequency+      [ (3, Alg.const <$> arbitrary),+        (1, Alg.invert <$> arbitrary),+        (1, Alg.union <$> arbitrary <*> arbitrary),+        (1, Alg.intersection <$> arbitrary <*> arbitrary),+        (1, Alg.difference <$> arbitrary <*> arbitrary)+      ]++prop_equivalence_eval_and_evalPredicate :: ([Integer], Alg.RangeExpr [AnyRange 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++test_algebra_equivalence :: Test+test_algebra_equivalence =+  testGroup+    "algebra equivalence"+    [ testProperty "eval and evalPredicate" prop_equivalence_eval_and_evalPredicate+    ]++tests :: [Test]+tests =+  [ tests_inRange,+    test_ranges_invert,+    test_algebra_equivalence+  ]+    ++ rangeMergeTestCases++main :: IO ()+main = defaultMain tests

@@ -0,0 +1,138 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- This is only okay in test classes++module Test.RangeMerge+  ( rangeMergeTestCases,+  )+where++import Data.List (subsequences)+import Data.Maybe (fromMaybe)+import Data.Range.Typed.Data+import Data.Range.Typed.RangeInternal+import Data.Range.Typed.Util+import System.Random+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck++instance (Num a, Integral a, Ord a, Random a) => Arbitrary (RangeMerge a) where+  shrink = fmap (foldr unionRangeMerges emptyRangeMerge) . init . subsequences . unmergeRM++  arbitrary = do+    upper <- maybeNumber+    possibleSpanStart <- arbitrarySizedIntegral+    spans <- generateSpanList (fromMaybe possibleSpanStart upper)+    lower <-+      oneof+        [ Just . (+) (maxMaybe (boundValue . snd <$> lastMaybe spans) $ maxMaybe upper possibleSpanStart) <$> choose (2, 100),+          return Nothing+        ]+    return+      RM+        { largestUpperBound = InclusiveBound <$> upper,+          largestLowerBound = InclusiveBound <$> lower,+          spanRanges = spans+        }+    where+      maybeNumber = oneof [Just <$> arbitrarySizedIntegral, return Nothing]++      lastMaybe :: [a] -> Maybe a+      lastMaybe [] = Nothing+      lastMaybe xs = Just . last $ xs++      maxMaybe :: (Ord a) => Maybe a -> a -> a+      maxMaybe Nothing x = x+      maxMaybe (Just y) x = max x y++      generateSpanList :: (Num a, Ord a, Random a) => a -> Gen [(Bound a, Bound a)]+      generateSpanList start = do+        count <- choose (0, 10)+        helper count start+        where+          genBound x = oneof [return $ InclusiveBound x, return $ ExclusiveBound x]+          helper :: (Num a, Ord a, Random a) => Integer -> a -> Gen [(Bound a, Bound a)]+          helper 0 _ = return []+          helper x hStart = do+            first <- (+ hStart) <$> choose (2, 100)+            second <- (+ first) <$> choose (2, 100)+            firstBound <- genBound first+            secondBound <- genBound second+            remainder <- helper (x - 1) second+            return $ (firstBound, secondBound) : remainder++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+    ]++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+    ]++prop_union_with_empty_is_self :: RangeMerge Integer -> Bool+prop_union_with_empty_is_self rm = (rm `unionRangeMerges` emptyRangeMerge) == rm++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+    ]++prop_intersection_with_empty_is_empty :: RangeMerge Integer -> Bool+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 =+  (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+    ]++prop_demorgans_law_one :: (RangeMerge Integer, RangeMerge Integer) -> Bool+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) =+  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_unionRM,+    test_intersectionRM,+    test_complex_laws+  ]

@@ -0,0 +1,79 @@+cabal-version: 3.0+name: typed-range+version: 0.1.0.0+synopsis: An efficient and versatile typed range library.+description: The range library alows the use of performant and versatile ranges in your code.+             It supports bounded and unbounded ranges, ranges in a nested manner (like library+             versions), an efficient algebra of range computation and even a simplified interface+             for ranges for the common cases. This library is far more efficient than using the+             default Data.List functions to approximate range behaviour. Performance is the major+             value offering of this library.++             If this is your first time using this library it is highly recommended that you start+             with "Data.Range.Typed"; it contains the basics of this library that meet most use+             cases.+homepage: https://github.com/blackheaven/typed-range+license: MIT+license-file: LICENSE+author: Gautier DI FOLCO+maintainer: gautier.difolco@gmail.com+category: Data+build-type: Simple+++library+  default-language: Haskell2010++  other-modules:+      Paths_typed_range++  autogen-modules:+      Paths_typed_range++  exposed-modules:+      Data.Range.Typed+    , Data.Range.Typed.Ranges+    , Data.Range.Typed.Parser+    , Data.Range.Typed.Algebra++  other-modules:+      Data.Range.Typed.Data+    , Data.Range.Typed.Operators+    , Data.Range.Typed.RangeInternal+    , Data.Range.Typed.Spans+    , Data.Range.Typed.Util+    , Data.Range.Typed.Algebra.Internal+    , Data.Range.Typed.Algebra.Range+    , Data.Range.Typed.Algebra.Predicate++  build-depends:+      base >= 4.10 && < 5+    , free >= 4.12+    , optics-core >= 0.3+    , parsec >= 3++  default-extensions:+      DataKinds+      GADTs++  ghc-options: -Wall+++test-suite spec+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  main-is: Test/Range.hs+  other-modules: Test.RangeMerge+  build-depends:+     base >= 4.5 && < 5+   , Cabal >= 3.0+   , QuickCheck >= 2.4.0.1 && < 3+   , test-framework-quickcheck2 >= 0.2 && < 0.4+   , test-framework >= 0.4 && < 0.9+   , free >= 4.12+   , random >= 1.0+   , typed-range+  ghc-options: -rtsopts -Wall -fno-enable-rewrite-rules+  default-extensions:+      DataKinds+      GADTs