range (empty) → 0.1.0.0

raw patch · 13 files changed

+887/−0 lines, 13 filesdep +Cabaldep +QuickCheckdep +basesetup-changed

Dependencies added: Cabal, QuickCheck, base, parsec, random, test-framework, test-framework-quickcheck2

Files

• Data/Range/Data.hs +27/−0
• Data/Range/NestedRange.hs +27/−0
• Data/Range/Parser.hs +80/−0
• Data/Range/Range.hs +88/−0
• Data/Range/RangeInternal.hs +319/−0
• Data/Range/RangeTree.hs +21/−0
• Data/Range/RangeTreeInternal.hs +14/−0
• Data/Range/Spans.hs +57/−0
• Data/Range/Util.hs +27/−0
• LICENSE +20/−0
• Setup.hs +2/−0
• Test/Range.hs +124/−0
• range.cabal +81/−0

@@ -0,0 +1,27 @@+-- | The Data module for common data types within the code.+module Data.Range.Data where++-- | 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)++-- | 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.++-- | 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.

@@ -0,0 +1,27 @@+-- | Nested Ranges are common in practical usage. They appear in such forms as library+-- version numbers ("Version 1.4.5.6" for example). And 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 where++import Data.Range.Range++-- | The Nested Range is a structure that in a nested form of many ranges where there can+-- be multiple ranges at every level.+data NestedRange a = NestedRange [[Range a]]+++-- 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.+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

@@ -0,0 +1,80 @@+{-# LANGUAGE FlexibleContexts #-}++-- | It should not be unexpected that you will be given a string representation of some+-- ranges and you will need to parse them so that you can then do some further processing.+-- This parser exists in order to make the most common forms of range strings easy to+-- parse. It does not cover all cases however but you should not be too worried about+-- that because you should be able to write your own parser using parsec or Alex/Happy and+-- then you can convert everything that you parse into a RangeTree object for easier+-- processing.+module Data.Range.Parser +   ( parseRanges+   , ranges+   , RangeParserArgs(..)+   , defaultArgs+   ) where++import Text.Parsec+import Text.Parsec.String++import Data.Range.Range++-- | The arguments that are used, and can be modified, while parsing a standard range+-- string.+data RangeParserArgs = Args +   { unionSeparator :: String -- ^ A separator that represents a union.+   , rangeSeparator :: String -- ^ A separator that separates the two halves of a range.+   , wildcardSymbol :: String -- ^ A separator that implies an unbounded range.+   }+   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.+parseRanges :: (Read a) => String -> Either ParseError [Range a]+parseRanges = parse (ranges defaultArgs) "(range parser)"++string_ :: Stream s m Char => String -> ParsecT s u m ()+string_ x = string x >> return ()++-- | Given the parser arguments this returns a parser that is capable of parsing a list of+-- ranges.+ranges :: (Read a) => RangeParserArgs -> Parser [Range a]+ranges args = range `sepBy` (string $ unionSeparator args)+   where +      range :: (Read a) => Parser (Range a)+      range = choice +         [ infiniteRange+         , spanRange+         , singletonRange+         ]++      infiniteRange :: (Read a) => Parser (Range a)+      infiniteRange = do+         string_ $ wildcardSymbol args+         return InfiniteRange++      spanRange :: (Read a) => Parser (Range a)+      spanRange = try $ do+         first <- readSection+         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+            _                 -> parserFail ("Range should have a number on one end: " ++ rangeSeparator args)++      singletonRange :: (Read a) => Parser (Range a)+      singletonRange = fmap (SingletonRange . read) $ many1 digit++readSection :: (Read a) => Parser (Maybe a)+readSection = fmap (fmap read) $ optionMaybe (many1 digit)

@@ -0,0 +1,88 @@+-- | This entire library is concerned with ranges and this module implements the absolute+-- basic range functions.+module Data.Range.Range (+      Range(..),+      inRange,+      inRanges,+      rangesOverlap,+      mergeRanges,+      invert,+      union,+      intersection,+      fromRanges+   ) where++import Data.Range.Data+import Data.Range.RangeInternal+import Data.Range.Util++-- | Performs a set union between the two input ranges and returns the resultant set of+-- ranges.+union :: (Ord a, Enum a) => [Range a] -> [Range a] -> [Range a]+union a b = exportRangeMerge $ unionRangeMerges (loadRanges a) (loadRanges b)++-- | Performs a set intersection between the two input ranges and returns the resultant set of+-- ranges.+intersection :: (Ord a, Enum a) => [Range a] -> [Range a] -> [Range a]+intersection a b = exportRangeMerge $ intersectionRangeMerges (loadRanges a) (loadRanges b)++-- | An inversion function, given a set of ranges it returns the inverse set of ranges.+invert :: (Ord a, Enum a) => [Range a] -> [Range a]+invert = exportRangeMerge . invertRM . loadRanges++-- | 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.+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 ranges value = any (flip inRange value) ranges++-- | When you create a range there may be overlaps in your ranges. However, for the sake+-- of efficiency you probably want the list of ranges with no overlaps. The mergeRanges+-- function takes a set of ranges and returns the same set specified by the minimum number+-- of Range objects. A useful function for cleaning up your ranges. Please note that, if+-- you use any of the other operations on sets of ranges like invert, union and+-- intersection then this is automatically done for you. Which means that a function like+-- this is redundant: mergeRanges . intersection+mergeRanges :: (Ord a, Enum a) => [Range a] -> [Range a]+mergeRanges = exportRangeMerge . loadRanges++-- | A set of ranges represents a collection of real values without actually instantiating+-- those values. This allows you to have infinite ranges. However, sometimes you wish to+-- actually 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.+fromRanges :: (Ord a, Enum a) => [Range a] -> [a]+fromRanges = concatMap fromRange+   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

@@ -0,0 +1,319 @@+module Data.Range.RangeInternal where++import Data.Maybe (catMaybes)+--import Data.Ord (comparing)++import Data.Range.Data+import Data.Range.Spans+import Data.Range.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 a+   , largestUpperBound :: Maybe a+   , spanRanges :: [(a, a)]+   }+   | IRM+   deriving (Show, Eq)++emptyRangeMerge :: RangeMerge a+emptyRangeMerge = RM Nothing Nothing []++storeRange :: (Ord a) => Range a -> RangeMerge a+storeRange InfiniteRange = IRM+storeRange (LowerBoundRange lower) = emptyRangeMerge { largestLowerBound = Just lower }+storeRange (UpperBoundRange upper) = emptyRangeMerge { largestUpperBound = Just upper }+storeRange (SpanRange x y) = emptyRangeMerge { spanRanges = [(min x y, max x y)] }+storeRange (SingletonRange x) = emptyRangeMerge { spanRanges = [(x, x)] }++storeRanges :: (Ord a, Enum 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 = storeRanges emptyRangeMerge++exportRangeMerge :: (Ord a, Enum a) => RangeMerge a -> [Range a]+exportRangeMerge IRM = [InfiniteRange]+exportRangeMerge rm = putAll rm+   where+      putAll IRM = [InfiniteRange]+      putAll (RM lb up spans) = +         putLowerBound lb ++ putUpperBound up ++ putSpans spans++      putLowerBound = maybe [] (return . LowerBoundRange)+      putUpperBound = maybe [] (return . UpperBoundRange)+      putSpans = map simplifySpan++      simplifySpan (x, y) = if x == y+         then SingletonRange x+         else SpanRange x y++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) => (a -> (a, a) -> Maybe (a, a)) -> Maybe a -> [(a, a)] -> [(a, 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++fixUpper :: (Ord a) => a -> (a, a) -> Maybe (a, a)+fixUpper upper (x, y) = if x <= upper+   then Just (x, min y upper)+   else Nothing++intersectionRangeMerges :: (Ord a, Enum 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+   }+   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 = foldr1 insertionSortSpans +         [ lowerOneSpans+         , lowerTwoSpans+         , upperOneSpans+         , upperTwoSpans+         , intersectedSpans+         , calculateBoundOverlap one two+         ]++      joinedSpans = joinSpans . unionSpans $ sortedResults++      newLowerBound = calculateNewBound largestLowerBound max one two+      newUpperBound = calculateNewBound largestUpperBound min 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+         (Just x, Just y) -> Just $ comp x y+         (_, Nothing) -> Nothing+         (Nothing, _) -> Nothing++calculateBoundOverlap :: (Ord a, Enum a) => RangeMerge a -> RangeMerge a -> [(a, 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++      secondWay = case (largestLowerBound two, largestUpperBound one) of+         (Just x, Just y) -> if y >= x +            then Just (x, y)+            else Nothing+         _ -> Nothing+      +unionRangeMerges :: (Ord a, Enum a) => RangeMerge a -> RangeMerge a -> RangeMerge a+unionRangeMerges IRM _ = IRM+unionRangeMerges _ IRM = IRM+unionRangeMerges one two = infiniteCheck filterTwo+   where+      filterOne = foldr filterLowerBound boundedRM joinedSpans+      filterTwo = foldr filterUpperBound (filterOne { spanRanges = [] }) (spanRanges filterOne)+      +      infiniteCheck :: (Ord a, Enum a) => RangeMerge a -> RangeMerge a+      infiniteCheck IRM = IRM+      infiniteCheck rm@(RM (Just x) (Just y) _) = if x <= succ y +         then IRM+         else rm+      infiniteCheck rm = rm++      newLowerBound = calculateNewBound largestLowerBound min one two+      newUpperBound = calculateNewBound largestUpperBound max one two++      sortedSpans = insertionSortSpans (spanRanges one) (spanRanges two)+      joinedSpans = joinSpans . unionSpans $ sortedSpans++      boundedRM = RM+         { largestLowerBound = newLowerBound+         , largestUpperBound = newUpperBound+         , spanRanges = []+         }++      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+         (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 _ 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 }++filterUpperBound :: (Ord a, Enum a) => (a, 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++invertRM :: (Ord a, Enum 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 = RM+   { largestUpperBound = newUpperBound+   , largestLowerBound = newLowerBound+   , spanRanges = upperSpan ++ betweenSpans ++ lowerSpan+   }+   where+      newLowerValue = succ . snd . last . spanRanges $ rm+      newUpperValue = pred . 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 -> [(succ upper, newUpperValue)]+      lowerSpan = case largestLowerBound rm of+         Nothing -> []+         Just lower -> [(newLowerValue, pred 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+   where +      spans = spanRanges rm+      intersectedSpans = catMaybes $ map (intersectCompareSpan sp) spans++      largestSpan :: Ord a => [(a, a)] -> [(a, a)]+      largestSpan [] = []+      largestSpan xs = (foldr1 (\(l, m) (x, y) -> (min l x, max m y)) xs) : []++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+-}++-- 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++intersectionRange (SingletonRange value) rm = intersectionRange (SpanRange value value) rm+-}

@@ -0,0 +1,21 @@+-- | Internally the range library converts your ranges into an internal representation of+-- multiple ranges that I call a RangeMerge. 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 RangeTree structure 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. Use RangeTree's whenever you wish to perform+-- multiple operations in a row and wish for it to be as efficient as possible.+module Data.Range.RangeTree +   ( evaluate+   , RangeTree(..)+   , RangeOperation(..)+   ) where++import Data.Range.Data+import Data.Range.RangeInternal+import Data.Range.RangeTreeInternal++-- | 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 = exportRangeMerge . evaluateRangeTree 

@@ -0,0 +1,14 @@+module Data.Range.RangeTreeInternal where++import Data.Range.Data+import Data.Range.RangeInternal++evaluateRangeTree :: (Ord a, Enum a) => RangeTree a -> RangeMerge a+evaluateRangeTree (RangeNode operation left right) = case operation of+   RangeUnion -> leftEval `unionRangeMerges` rightEval+   RangeIntersection -> leftEval `intersectionRangeMerges` rightEval+   where+      leftEval = evaluateRangeTree left +      rightEval = evaluateRangeTree right+evaluateRangeTree (RangeNodeInvert node) = invertRM . evaluateRangeTree $ node+evaluateRangeTree (RangeLeaf ranges) = loadRanges ranges

@@ -0,0 +1,57 @@+-- 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+   +-- Assume that both inputs are sorted spans+insertionSortSpans :: (Ord a) => [(a, a)] -> [(a, a)] -> [(a, a)]+insertionSortSpans = insertionSort (comparing fst)++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++intersectSpans :: (Ord a) => [(a, a)] -> [(a, a)] -> [(a, a)]+intersectSpans (x@(xlow, xup) : xs) (y@(ylow, yup) : 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+      LT -> intersectSpans xs (y : ys)+      GT -> intersectSpans (x : xs) ys+intersectSpans _ _ = []++insertSpan :: Ord a => (a, b) -> [(a, b)] -> [(a, b)]+insertSpan = insertBy (comparing fst)++sortSpans :: (Ord a) => [(a, a)] -> [(a, a)]+sortSpans = sortBy (comparing fst)++-- 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+      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)+   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 _ = []++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)

@@ -0,0 +1,27 @@+module Data.Range.Util where++-- 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]+insertionSort comp xs ys = go xs ys+   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++isBetween :: (Ord a) => a -> (a, a) -> Bool+isBetween a (x, y) = (x <= a) && (a <= y)++takeEvenly :: [a] -> [a] -> [a]+takeEvenly (a : as) (b : bs) = a : b : takeEvenly as bs+takeEvenly xs [] = xs+takeEvenly [] xs = xs+   +pairs :: [a] -> [(a, a)]+pairs [] = []+pairs xs = zip xs (tail xs)

@@ -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,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,124 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- This is only okay in test classes++module Main where++import Test.Framework (defaultMain, testGroup)+import Test.QuickCheck+import Test.Framework.Providers.QuickCheck2++import Control.Monad (liftM)+import System.Random++import Data.Range.Range++import Test.RangeMerge++data UnequalPair a = UnequalPair (a, a)+   deriving (Show)++instance (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, 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 begin end) middle++prop_infinite_range_contains_everything :: Integer -> Bool+prop_infinite_range_contains_everything = inRange InfiniteRange++tests_inRange = testGroup "inRange Function"+   [ testProperty "equal singletons in range" prop_singleton_in_range+   , testProperty "unequal singletons not in range" prop_singleton_not_in_range+   , testProperty "spans contain values in their middles" prop_span_contains+   , testProperty "infinite ranges contain everything" prop_infinite_range_contains_everything+   ]++instance (Num a, Ord a, Enum a) => Arbitrary (Range a) where+   arbitrary = oneof +      [ generateSingleton+      , generateSpan+      , generateLowerBound+      , generateUpperBound+      , generateInfiniteRange+      ]+      where+         generateSingleton = liftM SingletonRange arbitrarySizedIntegral+         generateSpan = do+            first <- arbitrarySizedIntegral +            second <- arbitrarySizedIntegral `suchThat` (> first)+            return $ SpanRange first second+         generateLowerBound = liftM LowerBoundRange arbitrarySizedIntegral+         generateUpperBound = liftM UpperBoundRange arbitrarySizedIntegral+         generateInfiniteRange :: Gen (Range a)+         generateInfiniteRange = return InfiniteRange++-- 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, [Range Integer]) -> Bool+prop_in_range_out_of_range_after_invert (point, ranges) = +   (inRanges ranges point) /= (inRanges (invert ranges) point)++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+   ]++prop_elements_before_union_or_true :: ([Integer], [Range Integer], [Range Integer]) -> Bool+prop_elements_before_union_or_true (points, a, b) = actual == expected+   where+      before_a = map (inRanges a) points+      before_b = map (inRanges b) points+      unionRanges = a `union` b+      actual = map (inRanges unionRanges) points+      expected = zipWith (||) before_a before_b++prop_elements_before_intersection_and_true :: ([Integer], [Range Integer], [Range Integer]) -> Bool+prop_elements_before_intersection_and_true (points, a, b) = actual == expected+   where+      before_a = map (inRanges a) points+      before_b = map (inRanges b) points+      intersectedRanges = a `intersection` b+      actual = map (inRanges intersectedRanges) points+      expected = zipWith (&&) before_a before_b++test_union = testGroup "union function properties"+   [ testProperty "Unions from before OR together and continue to work" prop_elements_before_union_or_true+   ]++test_intersection = testGroup "intersection function properties"+   [ testProperty "Intersection before AND's to after" prop_elements_before_intersection_and_true+   ]++--tests :: [Test]+tests = +   [ tests_inRange +   , test_ranges_invert+   , test_union+   , test_intersection+   ]+   ++ rangeMergeTestCases++main = defaultMain tests

@@ -0,0 +1,81 @@+-- Initial range.cabal generated by cabal init.  For further documentation,+--  see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                range++-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            This has a bunch of code for specifying and managing ranges in your code.++-- A longer description of the package.+description:         range is built to allow you to use ranges in your code quickly and+                     efficiently. There are many occasions where you will want to check if+                     certain values are within a range and this library will make it+                     trivial for you to do so. It also attempts to do so in the most+                     efficient way possible.++-- The license under which the package is released.+license:             MIT++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              Robert Massaioli++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer:          robertmassaioli@gmail.com++-- A copyright notice.+-- copyright:           ++category:            Data++build-type:          Simple++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.8+++library+  -- Modules exported by the library.+  exposed-modules:    Data.Range.Range+                      , Data.Range.NestedRange+                      , Data.Range.RangeTree+                      , Data.Range.Parser+  +  -- Modules included in this library but not exported.+  other-modules:  Data.Range.Data+                  , Data.Range.RangeInternal+                  , Data.Range.RangeTreeInternal+                  , Data.Range.Spans+                  , Data.Range.Util++  +  -- Other library packages from which modules are imported.+  build-depends:  base >= 4.5 && < 5+                  , parsec >= 3++  ghc-options: -Wall+   +  +Test-Suite test-range+   type:       exitcode-stdio-1.0+   main-is: Test/Range.hs+   build-depends: +      base ==4.5.*+      , Cabal >= 1.14+      , QuickCheck >= 2.4.0.1 && < 2.6+      , test-framework-quickcheck2 >= 0.2 && < 0.4+      , test-framework >= 0.4 && < 0.9+      , random >= 1.0+   ghc-options: -rtsopts -Wall