range 0.3.1.0 → 0.3.2.0

raw patch · 8 files changed

+791/−33 lines, 8 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• Data/Range/Data.hs +2/−2
• Data/Range/Ord.hs +141/−0
• Test/Generators.hs +39/−0
• Test/Range.hs +7/−30
• Test/RangeLaws.hs +178/−0
• Test/RangeOrd.hs +226/−0
• Test/RangeParser.hs +190/−0
• range.cabal +8/−1

@@ -16,7 +16,7 @@ data BoundType    = Inclusive -- ^ The value at the boundary should be included in the bound.    | Exclusive -- ^ The value at the boundary should be excluded in the bound.-   deriving (Eq, Show, Generic)+   deriving (Eq, Ord, Show, Generic)  instance NFData BoundType @@ -25,7 +25,7 @@ data Bound a = Bound    { boundValue :: a          -- ^ The value at the edge of this bound.    , boundType :: BoundType   -- ^ The type of bound. Should be 'Inclusive' or 'Exclusive'.-   } deriving (Eq, Show, Generic)+   } deriving (Eq, Ord, Show, Generic)  instance NFData a => NFData (Bound a) 

@@ -0,0 +1,141 @@+{-# LANGUAGE Safe #-}++-- | Ordering newtypes for 'Range'.+--+-- 'Range' deliberately has no 'Ord' instance because there is no single+-- natural ordering — the right choice depends on the use case. This module+-- provides two explicit wrappers:+--+-- * 'KeyRange' — a consistent structural ordering, suitable for use as a+--   'Data.Map.Map' key or in a 'Data.Set.Set'.+--+-- * 'SortedRange' — a positional ordering by location on the number line,+--   suitable for sorting ranges for display.+--+-- == Example: Map keyed on ranges+--+-- @+-- import Data.Range.Ord (KeyRange(..))+-- import qualified Data.Map.Strict as Map+--+-- type RuleMap = Map (KeyRange Integer) String+--+-- rules :: RuleMap+-- rules = Map.fromList+--   [ (KeyRange (1 +=+ 10),  \"low\")+--   , (KeyRange (11 +=+ 50), \"medium\")+--   , (KeyRange (lbi 51),    \"high\")+--   ]+-- @+--+-- == Example: sorting ranges by position+--+-- @+-- import Data.Range.Ord (SortedRange(..))+-- import Data.List (sortOn)+--+-- displayRanges :: Ord a => [Range a] -> [Range a]+-- displayRanges = sortOn SortedRange+-- @+module Data.Range.Ord+   ( KeyRange(..)+   , SortedRange(..)+   ) where++import Data.Range.Data+import Data.Range.Util (compareLower, compareHigher)++-- ---------------------------------------------------------------------------+-- KeyRange: structural ordering+-- ---------------------------------------------------------------------------++-- | Wraps 'Range' with a structural 'Ord' instance, suitable for use as a+-- 'Data.Map.Map' key or in a 'Data.Set.Set'.+--+-- Constructor order: @SingletonRange < SpanRange < LowerBoundRange <+-- UpperBoundRange < InfiniteRange@. Fields within the same constructor are+-- compared lexicographically.+--+-- This ordering is not semantically meaningful on the number line —+-- @SingletonRange 5@ and @SpanRange (Bound 5 Inclusive) (Bound 5 Inclusive)@+-- are considered distinct. It is only appropriate where any consistent total+-- order will do.+newtype KeyRange a = KeyRange { unKeyRange :: Range a }+   deriving (Eq, Show)++constructorRank :: Range a -> Int+constructorRank (SingletonRange _)  = 0+constructorRank (SpanRange _ _)     = 1+constructorRank (LowerBoundRange _) = 2+constructorRank (UpperBoundRange _) = 3+constructorRank InfiniteRange       = 4++compareRangeFields :: Ord a => Range a -> Range a -> Ordering+compareRangeFields (SingletonRange a)  (SingletonRange b)  = compare a b+compareRangeFields (SpanRange lo1 hi1) (SpanRange lo2 hi2) =+   case compare lo1 lo2 of+      EQ -> compare hi1 hi2+      r  -> r+compareRangeFields (LowerBoundRange a) (LowerBoundRange b) = compare a b+compareRangeFields (UpperBoundRange a) (UpperBoundRange b) = compare a b+compareRangeFields InfiniteRange       InfiniteRange       = EQ+compareRangeFields _                   _                   = EQ++instance Ord a => Ord (KeyRange a) where+   compare (KeyRange x) (KeyRange y) =+      case compare (constructorRank x) (constructorRank y) of+         EQ -> compareRangeFields x y+         r  -> r++-- ---------------------------------------------------------------------------+-- SortedRange: positional ordering+-- ---------------------------------------------------------------------------++-- | Extended bound adding @-∞@ and @+∞@ sentinels, used internally by+-- 'SortedRange'.+data ExtBound a = NegInfinity | FiniteBound (Bound a) | PosInfinity++compareExtBound :: (Bound a -> Bound a -> Ordering) -> ExtBound a -> ExtBound a -> Ordering+compareExtBound _   NegInfinity     NegInfinity     = EQ+compareExtBound _   NegInfinity     _               = LT+compareExtBound _   _               NegInfinity     = GT+compareExtBound _   PosInfinity     PosInfinity     = EQ+compareExtBound _   PosInfinity     _               = GT+compareExtBound _   _               PosInfinity     = LT+compareExtBound cmp (FiniteBound a) (FiniteBound b) = cmp a b++lowerExtBound :: Range a -> ExtBound a+lowerExtBound (UpperBoundRange _) = NegInfinity+lowerExtBound InfiniteRange       = NegInfinity+lowerExtBound (LowerBoundRange b) = FiniteBound b+lowerExtBound (SpanRange lo _)    = FiniteBound lo+lowerExtBound (SingletonRange x)  = FiniteBound (Bound x Inclusive)++upperExtBound :: Range a -> ExtBound a+upperExtBound (LowerBoundRange _) = PosInfinity+upperExtBound InfiniteRange       = PosInfinity+upperExtBound (UpperBoundRange b) = FiniteBound b+upperExtBound (SpanRange _ hi)    = FiniteBound hi+upperExtBound (SingletonRange x)  = FiniteBound (Bound x Inclusive)++-- | Wraps 'Range' with a positional 'Ord' instance: ranges are ordered by+-- where they sit on the number line, lower bound first with upper bound as a+-- tiebreaker.+--+-- The 'Eq' instance is consistent with 'Ord': two 'SortedRange' values are+-- equal iff they have the same lower and upper bounds. This means+-- @SortedRange (SingletonRange 5)@ and+-- @SortedRange (5 +=+ 5)@ are considered equal.+newtype SortedRange a = SortedRange { unSortedRange :: Range a }++instance Show a => Show (SortedRange a) where+   show (SortedRange r) = "SortedRange (" ++ show r ++ ")"++instance Ord a => Eq (SortedRange a) where+   x == y = compare x y == EQ++instance Ord a => Ord (SortedRange a) where+   compare (SortedRange a) (SortedRange b) =+      case compareExtBound compareLower (lowerExtBound a) (lowerExtBound b) of+         EQ -> compareExtBound compareHigher (upperExtBound a) (upperExtBound b)+         r  -> r

@@ -0,0 +1,39 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- Orphan instances are acceptable in test modules++module Test.Generators where++import Test.QuickCheck+import Control.Monad (liftM)++import Data.Range+import qualified Data.Range.Algebra as Alg++instance (Num a, Integral 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 $ first +=+ second+         generateLowerBound = liftM lbi arbitrarySizedIntegral+         generateUpperBound = liftM ubi arbitrarySizedIntegral+         generateInfiniteRange :: Gen (Range a)+         generateInfiniteRange = return InfiniteRange++instance (Num a, Integral a, Ord a, Enum a) => Arbitrary (Alg.RangeExpr [Range 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)+    ]

@@ -8,14 +8,16 @@ import Test.QuickCheck import Test.Framework.Providers.QuickCheck2 -import Control.Applicative ((<$>), (<*>))-import Control.Monad (liftM) import System.Random  import Data.Range import qualified Data.Range.Algebra as Alg  import Test.RangeMerge+import Test.RangeLaws+import Test.RangeParser+import Test.RangeOrd+import Test.Generators ()  data UnequalPair a = UnequalPair (a, a)    deriving (Show)@@ -55,25 +57,6 @@    , testProperty "infinite ranges contain everything" prop_infinite_range_contains_everything    ] -instance (Num a, Integral 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 $ first +=+ second-         generateLowerBound = liftM lbi arbitrarySizedIntegral-         generateUpperBound = liftM ubi 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.@@ -89,15 +72,6 @@    [ 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 [Range 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 [Range Integer]) -> Bool prop_equivalence_eval_and_evalPredicate (points, expr) = actual == expected   where@@ -115,5 +89,8 @@    , test_algebra_equivalence    ]    ++ rangeMergeTestCases+   ++ rangeLawTestCases+   ++ rangeParserTestCases+   ++ rangeOrdTestCases  main = defaultMain tests

@@ -0,0 +1,178 @@+module Test.RangeLaws+   ( rangeLawTestCases+   ) where++import Test.Framework (Test, testGroup)+import Test.QuickCheck+import Test.Framework.Providers.QuickCheck2++import Data.Range+import Test.Generators ()++-- ---------------------------------------------------------------------------+-- Helpers+-- ---------------------------------------------------------------------------++-- Sort before comparing so that order differences don't cause false failures.+-- mergeRanges produces a canonical form, so we use it to normalise both sides.+canonical :: Ord a => [Range a] -> [Range a]+canonical = mergeRanges++eq :: (Ord a) => [Range a] -> [Range a] -> Bool+eq a b = canonical a == canonical b++-- ---------------------------------------------------------------------------+-- Idempotency+-- ---------------------------------------------------------------------------++prop_mergeRanges_idempotent :: [Range Integer] -> Bool+prop_mergeRanges_idempotent xs =+   mergeRanges (mergeRanges xs) == mergeRanges xs++prop_union_idempotent :: [Range Integer] -> Bool+prop_union_idempotent xs =+   union xs xs `eq` xs++prop_intersection_idempotent :: [Range Integer] -> Bool+prop_intersection_idempotent xs =+   intersection xs xs `eq` xs++test_idempotency :: Test+test_idempotency = testGroup "idempotency"+   [ testProperty "mergeRanges is idempotent"       prop_mergeRanges_idempotent+   , testProperty "union with self is self"          prop_union_idempotent+   , testProperty "intersection with self is self"   prop_intersection_idempotent+   ]++-- ---------------------------------------------------------------------------+-- Commutativity+-- ---------------------------------------------------------------------------++prop_union_commutative :: ([Range Integer], [Range Integer]) -> Bool+prop_union_commutative (a, b) =+   union a b `eq` union b a++prop_intersection_commutative :: ([Range Integer], [Range Integer]) -> Bool+prop_intersection_commutative (a, b) =+   intersection a b `eq` intersection b a++test_commutativity :: Test+test_commutativity = testGroup "commutativity"+   [ testProperty "union is commutative"         prop_union_commutative+   , testProperty "intersection is commutative"  prop_intersection_commutative+   ]++-- ---------------------------------------------------------------------------+-- Associativity+-- ---------------------------------------------------------------------------++prop_union_associative :: ([Range Integer], [Range Integer], [Range Integer]) -> Bool+prop_union_associative (a, b, c) =+   union (union a b) c `eq` union a (union b c)++prop_intersection_associative :: ([Range Integer], [Range Integer], [Range Integer]) -> Bool+prop_intersection_associative (a, b, c) =+   intersection (intersection a b) c `eq` intersection a (intersection b c)++test_associativity :: Test+test_associativity = testGroup "associativity"+   [ testProperty "union is associative"         prop_union_associative+   , testProperty "intersection is associative"  prop_intersection_associative+   ]++-- ---------------------------------------------------------------------------+-- Distributivity+-- ---------------------------------------------------------------------------++prop_intersection_distributes_over_union+   :: ([Range Integer], [Range Integer], [Range Integer]) -> Bool+prop_intersection_distributes_over_union (a, b, c) =+   intersection a (union b c) `eq` union (intersection a b) (intersection a c)++prop_union_distributes_over_intersection+   :: ([Range Integer], [Range Integer], [Range Integer]) -> Bool+prop_union_distributes_over_intersection (a, b, c) =+   union a (intersection b c) `eq` intersection (union a b) (union a c)++test_distributivity :: Test+test_distributivity = testGroup "distributivity"+   [ testProperty "intersection distributes over union"+         prop_intersection_distributes_over_union+   , testProperty "union distributes over intersection"+         prop_union_distributes_over_intersection+   ]++-- ---------------------------------------------------------------------------+-- Identity laws+-- ---------------------------------------------------------------------------++-- The empty range list acts as the identity for union+prop_union_identity_empty :: [Range Integer] -> Bool+prop_union_identity_empty xs =+   union xs [] `eq` xs++-- InfiniteRange acts as the identity for intersection+prop_intersection_identity_infinite :: [Range Integer] -> Bool+prop_intersection_identity_infinite xs =+   intersection xs [InfiniteRange] `eq` xs++-- Union with InfiniteRange absorbs everything+prop_union_absorb_infinite :: [Range Integer] -> Bool+prop_union_absorb_infinite xs =+   union xs [InfiniteRange] `eq` [InfiniteRange]++-- Intersection with empty absorbs everything+prop_intersection_absorb_empty :: [Range Integer] -> Bool+prop_intersection_absorb_empty xs =+   intersection xs [] `eq` []++test_identity_absorption :: Test+test_identity_absorption = testGroup "identity and absorption"+   [ testProperty "union with [] is identity"                prop_union_identity_empty+   , testProperty "intersection with InfiniteRange is identity" prop_intersection_identity_infinite+   , testProperty "union with InfiniteRange absorbs"         prop_union_absorb_infinite+   , testProperty "intersection with [] absorbs"             prop_intersection_absorb_empty+   ]++-- ---------------------------------------------------------------------------+-- Difference as intersection with complement+-- ---------------------------------------------------------------------------++prop_difference_eq_intersection_invert+   :: ([Range Integer], [Range Integer]) -> Bool+prop_difference_eq_intersection_invert (a, b) =+   difference a b `eq` intersection a (invert b)++test_difference :: Test+test_difference = testGroup "difference"+   [ testProperty "difference a b == intersection a (invert b)"+         prop_difference_eq_intersection_invert+   ]++-- ---------------------------------------------------------------------------+-- Double inversion+-- ---------------------------------------------------------------------------++prop_invert_twice_identity :: [Range Integer] -> Bool+prop_invert_twice_identity xs =+   invert (invert xs) `eq` xs++test_invert :: Test+test_invert = testGroup "invert"+   [ testProperty "inverting twice is identity"  prop_invert_twice_identity+   ]++-- ---------------------------------------------------------------------------+-- Export+-- ---------------------------------------------------------------------------++rangeLawTestCases :: [Test]+rangeLawTestCases =+   [ test_idempotency+   , test_commutativity+   , test_associativity+   , test_distributivity+   , test_identity_absorption+   , test_difference+   , test_invert+   ]

@@ -0,0 +1,226 @@+module Test.RangeOrd+   ( rangeOrdTestCases+   ) where++import Data.List (sort, sortOn)+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck++import Data.Range+import Data.Range.Ord++import Test.Generators ()++-- ---------------------------------------------------------------------------+-- Helpers+-- ---------------------------------------------------------------------------++-- Verify that compare is consistent with Eq for KeyRange+keyEqOrdConsistent :: Ord a => KeyRange a -> KeyRange a -> Bool+keyEqOrdConsistent x y = (x == y) == (compare x y == EQ)++-- Verify that compare is consistent with Eq for SortedRange+sortEqOrdConsistent :: Ord a => SortedRange a -> SortedRange a -> Bool+sortEqOrdConsistent x y = (x == y) == (compare x y == EQ)++-- ---------------------------------------------------------------------------+-- KeyRange: unit tests+-- ---------------------------------------------------------------------------++-- Constructor ordering: SingletonRange < SpanRange < LowerBoundRange <+--                       UpperBoundRange < InfiniteRange+prop_key_constructor_singleton_lt_span :: Bool+prop_key_constructor_singleton_lt_span =+   KeyRange (SingletonRange (0 :: Integer)) < KeyRange (0 +=+ 0)++prop_key_constructor_span_lt_lower :: Bool+prop_key_constructor_span_lt_lower =+   KeyRange (0 +=+ (0 :: Integer)) < KeyRange (lbi 0)++prop_key_constructor_lower_lt_upper :: Bool+prop_key_constructor_lower_lt_upper =+   KeyRange (lbi (0 :: Integer)) < KeyRange (ubi 0)++prop_key_constructor_upper_lt_infinite :: Bool+prop_key_constructor_upper_lt_infinite =+   KeyRange (ubi (0 :: Integer)) < KeyRange (inf :: Range Integer)++-- Within the same constructor, compare by fields+prop_key_singletons_by_value :: Bool+prop_key_singletons_by_value =+   KeyRange (SingletonRange (3 :: Integer)) < KeyRange (SingletonRange 5)++prop_key_spans_by_lower_first :: Bool+prop_key_spans_by_lower_first =+   KeyRange ((1 :: Integer) +=+ 10) < KeyRange (2 +=+ 10)++prop_key_spans_by_upper_on_equal_lower :: Bool+prop_key_spans_by_upper_on_equal_lower =+   KeyRange ((1 :: Integer) +=+ 5) < KeyRange (1 +=+ 10)++prop_key_lower_bounds_by_value :: Bool+prop_key_lower_bounds_by_value =+   KeyRange (lbi (1 :: Integer)) < KeyRange (lbi 2)++prop_key_upper_bounds_by_value :: Bool+prop_key_upper_bounds_by_value =+   KeyRange (ubi (1 :: Integer)) < KeyRange (ubi 2)++prop_key_infinite_eq_infinite :: Bool+prop_key_infinite_eq_infinite =+   compare (KeyRange (inf :: Range Integer)) (KeyRange inf) == EQ++test_keyrange_unit :: Test+test_keyrange_unit = testGroup "KeyRange unit"+   [ testProperty "SingletonRange < SpanRange"     prop_key_constructor_singleton_lt_span+   , testProperty "SpanRange < LowerBoundRange"    prop_key_constructor_span_lt_lower+   , testProperty "LowerBoundRange < UpperBoundRange" prop_key_constructor_lower_lt_upper+   , testProperty "UpperBoundRange < InfiniteRange" prop_key_constructor_upper_lt_infinite+   , testProperty "singletons ordered by value"    prop_key_singletons_by_value+   , testProperty "spans ordered by lower bound first" prop_key_spans_by_lower_first+   , testProperty "spans ordered by upper bound when lower equal" prop_key_spans_by_upper_on_equal_lower+   , testProperty "lower bounds ordered by value"  prop_key_lower_bounds_by_value+   , testProperty "upper bounds ordered by value"  prop_key_upper_bounds_by_value+   , testProperty "InfiniteRange equals itself"    prop_key_infinite_eq_infinite+   ]++-- ---------------------------------------------------------------------------+-- KeyRange: QuickCheck properties+-- ---------------------------------------------------------------------------++prop_key_reflexive :: Range Integer -> Bool+prop_key_reflexive r = compare (KeyRange r) (KeyRange r) == EQ++prop_key_eq_ord_consistent :: Range Integer -> Range Integer -> Bool+prop_key_eq_ord_consistent x y = keyEqOrdConsistent (KeyRange x) (KeyRange y)++prop_key_antisymmetric :: Range Integer -> Range Integer -> Bool+prop_key_antisymmetric x y =+   case compare (KeyRange x) (KeyRange y) of+      LT -> compare (KeyRange y) (KeyRange x) == GT+      GT -> compare (KeyRange y) (KeyRange x) == LT+      EQ -> compare (KeyRange y) (KeyRange x) == EQ++prop_key_set_dedup :: [Range Integer] -> Bool+prop_key_set_dedup rs =+   -- Every range we put in we can get back out; Set operations work+   let keyed = map KeyRange rs+       s     = Set.fromList keyed+   in all (`Set.member` s) keyed++prop_key_map_lookup :: Range Integer -> String -> Bool+prop_key_map_lookup r v =+   Map.lookup (KeyRange r) (Map.singleton (KeyRange r) v) == Just v++test_keyrange_properties :: Test+test_keyrange_properties = testGroup "KeyRange properties"+   [ testProperty "reflexive"                prop_key_reflexive+   , testProperty "Eq/Ord consistent"        prop_key_eq_ord_consistent+   , testProperty "antisymmetric"            prop_key_antisymmetric+   , testProperty "usable in Set"            prop_key_set_dedup+   , testProperty "usable as Map key"        prop_key_map_lookup+   ]++-- ---------------------------------------------------------------------------+-- SortedRange: unit tests+-- ---------------------------------------------------------------------------++-- Ranges with NegInfinity lower bound sort before those with a finite lower bound+prop_sorted_upper_before_span :: Bool+prop_sorted_upper_before_span =+   SortedRange (ubi (0 :: Integer)) < SortedRange (lbi 0)++prop_sorted_infinite_before_lower :: Bool+prop_sorted_infinite_before_lower =+   SortedRange (inf :: Range Integer) < SortedRange (lbi 1)++-- Spans ordered by lower bound+prop_sorted_singletons_by_value :: Bool+prop_sorted_singletons_by_value =+   SortedRange (SingletonRange (3 :: Integer)) < SortedRange (SingletonRange 5)++prop_sorted_spans_by_lower :: Bool+prop_sorted_spans_by_lower =+   SortedRange ((1 :: Integer) +=+ 10) < SortedRange (2 +=+ 10)++-- When lower bounds are equal, tiebreak by upper bound (smaller upper = comes first)+prop_sorted_tiebreak_by_upper :: Bool+prop_sorted_tiebreak_by_upper =+   SortedRange ((1 :: Integer) +=+ 5) < SortedRange (1 +=+ 10)++-- InfiniteRange and UpperBoundRange both start at -∞;+-- InfiniteRange ends at +∞ so it sorts after a finite UpperBoundRange+prop_sorted_upper_before_infinite :: Bool+prop_sorted_upper_before_infinite =+   SortedRange (ubi (0 :: Integer)) < SortedRange (inf :: Range Integer)++-- The canonical display order: UpperBoundRange, SpanRange, LowerBoundRange+prop_sorted_display_order :: Bool+prop_sorted_display_order =+   sortOn SortedRange [lbi 10, (1 :: Integer) +=+ 5, ube 0]+   == [ube 0, 1 +=+ 5, lbi 10]++-- SingletonRange 5 and 5 +=+ 5 occupy the same position so compare as EQ+prop_sorted_singleton_eq_degenerate_span :: Bool+prop_sorted_singleton_eq_degenerate_span =+   compare (SortedRange (SingletonRange (5 :: Integer)))+           (SortedRange (SpanRange (Bound 5 Inclusive) (Bound 5 Inclusive)))+   == EQ++test_sortedrange_unit :: Test+test_sortedrange_unit = testGroup "SortedRange unit"+   [ testProperty "UpperBoundRange before LowerBoundRange"  prop_sorted_upper_before_span+   , testProperty "InfiniteRange before LowerBoundRange"    prop_sorted_infinite_before_lower+   , testProperty "singletons ordered by value"             prop_sorted_singletons_by_value+   , testProperty "spans ordered by lower bound"            prop_sorted_spans_by_lower+   , testProperty "tiebreak by upper bound"                 prop_sorted_tiebreak_by_upper+   , testProperty "UpperBoundRange before InfiniteRange"    prop_sorted_upper_before_infinite+   , testProperty "sortOn gives display order"              prop_sorted_display_order+   , testProperty "singleton equals degenerate span"        prop_sorted_singleton_eq_degenerate_span+   ]++-- ---------------------------------------------------------------------------+-- SortedRange: QuickCheck properties+-- ---------------------------------------------------------------------------++prop_sorted_reflexive :: Range Integer -> Bool+prop_sorted_reflexive r = compare (SortedRange r) (SortedRange r) == EQ++prop_sorted_eq_ord_consistent :: Range Integer -> Range Integer -> Bool+prop_sorted_eq_ord_consistent x y = sortEqOrdConsistent (SortedRange x) (SortedRange y)++prop_sorted_antisymmetric :: Range Integer -> Range Integer -> Bool+prop_sorted_antisymmetric x y =+   case compare (SortedRange x) (SortedRange y) of+      LT -> compare (SortedRange y) (SortedRange x) == GT+      GT -> compare (SortedRange y) (SortedRange x) == LT+      EQ -> compare (SortedRange y) (SortedRange x) == EQ++-- Sorting twice is idempotent+prop_sorted_sort_idempotent :: [Range Integer] -> Bool+prop_sorted_sort_idempotent rs =+   sortOn SortedRange (sortOn SortedRange rs) == sortOn SortedRange rs++test_sortedrange_properties :: Test+test_sortedrange_properties = testGroup "SortedRange properties"+   [ testProperty "reflexive"             prop_sorted_reflexive+   , testProperty "Eq/Ord consistent"     prop_sorted_eq_ord_consistent+   , testProperty "antisymmetric"         prop_sorted_antisymmetric+   , testProperty "sort is idempotent"    prop_sorted_sort_idempotent+   ]++-- ---------------------------------------------------------------------------+-- Export+-- ---------------------------------------------------------------------------++rangeOrdTestCases :: [Test]+rangeOrdTestCases =+   [ test_keyrange_unit+   , test_keyrange_properties+   , test_sortedrange_unit+   , test_sortedrange_properties+   ]

@@ -0,0 +1,190 @@+module Test.RangeParser+   ( rangeParserTestCases+   ) where++import Test.Framework (Test, testGroup)+import Test.QuickCheck+import Test.Framework.Providers.QuickCheck2++import Data.Range+import Data.Range.Parser++-- ---------------------------------------------------------------------------+-- Helpers+-- ---------------------------------------------------------------------------++shouldParse :: String -> [Range Integer] -> Bool+shouldParse input expected = case parseRanges input of+   Right result -> result == expected+   Left _       -> False++shouldFail :: String -> Bool+shouldFail input = case (parseRanges input :: Either ParseError [Range Integer]) of+   Left _  -> True+   Right _ -> False++-- ---------------------------------------------------------------------------+-- Haddock example tests+-- ---------------------------------------------------------------------------++-- The example from the module documentation:+-- >>> parseRanges "-5,8-10,13-15,20-" :: Either ParseError [Range Integer]+-- Right [UpperBoundRange 5,SpanRange 8 10,SpanRange 13 15,LowerBoundRange 20]+prop_haddock_example :: Bool+prop_haddock_example = shouldParse "-5,8-10,13-15,20-"+   [ UpperBoundRange (Bound 5 Inclusive)+   , SpanRange (Bound 8 Inclusive) (Bound 10 Inclusive)+   , SpanRange (Bound 13 Inclusive) (Bound 15 Inclusive)+   , LowerBoundRange (Bound 20 Inclusive)+   ]++test_haddock :: Test+test_haddock = testGroup "haddock examples"+   [ testProperty "documented example parses correctly" prop_haddock_example+   ]++-- ---------------------------------------------------------------------------+-- Singleton ranges+-- ---------------------------------------------------------------------------++prop_parse_singleton :: Positive Integer -> Bool+prop_parse_singleton (Positive n) = shouldParse (show n) [SingletonRange n]++prop_parse_singleton_zero :: Bool+prop_parse_singleton_zero = shouldParse "0" [SingletonRange 0]++test_singletons :: Test+test_singletons = testGroup "singleton ranges"+   [ testProperty "positive integer parses as singleton" prop_parse_singleton+   , testProperty "zero parses as singleton" prop_parse_singleton_zero+   ]++-- ---------------------------------------------------------------------------+-- Span ranges+-- ---------------------------------------------------------------------------++prop_parse_span :: (Positive Integer, Positive Integer) -> Bool+prop_parse_span (Positive a, Positive b) =+   shouldParse (show a ++ "-" ++ show b)+      [SpanRange (Bound a Inclusive) (Bound b Inclusive)]++test_spans :: Test+test_spans = testGroup "span ranges"+   [ testProperty "a-b parses as span" prop_parse_span+   ]++-- ---------------------------------------------------------------------------+-- Bound ranges+-- ---------------------------------------------------------------------------++prop_parse_lower_bound :: Positive Integer -> Bool+prop_parse_lower_bound (Positive n) =+   shouldParse (show n ++ "-") [LowerBoundRange (Bound n Inclusive)]++prop_parse_upper_bound :: Positive Integer -> Bool+prop_parse_upper_bound (Positive n) =+   shouldParse ("-" ++ show n) [UpperBoundRange (Bound n Inclusive)]++test_bounds :: Test+test_bounds = testGroup "bound ranges"+   [ testProperty "n- parses as lower bound" prop_parse_lower_bound+   , testProperty "-n parses as upper bound" prop_parse_upper_bound+   ]++-- ---------------------------------------------------------------------------+-- Wildcard / infinite range+-- ---------------------------------------------------------------------------++prop_parse_wildcard :: Bool+prop_parse_wildcard = shouldParse "*" [InfiniteRange]++prop_parse_wildcard_in_union :: Bool+prop_parse_wildcard_in_union = shouldParse "*,5"+   [InfiniteRange, SingletonRange 5]++test_wildcard :: Test+test_wildcard = testGroup "wildcard / infinite range"+   [ testProperty "* parses as InfiniteRange" prop_parse_wildcard+   , testProperty "* in union parses correctly" prop_parse_wildcard_in_union+   ]++-- ---------------------------------------------------------------------------+-- Union (comma-separated)+-- ---------------------------------------------------------------------------++prop_parse_union :: Bool+prop_parse_union = shouldParse "1,2,3"+   [SingletonRange 1, SingletonRange 2, SingletonRange 3]++prop_parse_mixed_union :: Bool+prop_parse_mixed_union = shouldParse "5,10-20,30-"+   [ SingletonRange 5+   , SpanRange (Bound 10 Inclusive) (Bound 20 Inclusive)+   , LowerBoundRange (Bound 30 Inclusive)+   ]++test_union :: Test+test_union = testGroup "union (comma-separated)"+   [ testProperty "singletons separated by commas" prop_parse_union+   , testProperty "mixed types separated by commas" prop_parse_mixed_union+   ]++-- ---------------------------------------------------------------------------+-- Edge cases and invalid inputs+-- ---------------------------------------------------------------------------++prop_empty_string_parses :: Bool+prop_empty_string_parses = case (parseRanges "" :: Either ParseError [Range Integer]) of+   Right [] -> True+   _        -> False++-- The parser uses sepBy which returns [] on no matches,+-- so non-range input like "abc" or "-" parses as Right [].+-- This is a known limitation of the current parser design.+prop_non_range_input_parses_empty :: Bool+prop_non_range_input_parses_empty =+   case (parseRanges "abc" :: Either ParseError [Range Integer]) of+      Right [] -> True+      _        -> False++test_edge_cases :: Test+test_edge_cases = testGroup "edge cases"+   [ testProperty "empty string produces empty list" prop_empty_string_parses+   , testProperty "non-range input produces empty list" prop_non_range_input_parses_empty+   ]++-- ---------------------------------------------------------------------------+-- Custom parser args+-- ---------------------------------------------------------------------------++prop_custom_separators :: Bool+prop_custom_separators =+   let args = defaultArgs { unionSeparator = ";", rangeSeparator = ".." }+       result = customParseRanges args "1..5;10" :: Either ParseError [Range Integer]+   in case result of+      Right ranges -> ranges ==+         [ SpanRange (Bound 1 Inclusive) (Bound 5 Inclusive)+         , SingletonRange 10+         ]+      Left _ -> False++test_custom :: Test+test_custom = testGroup "custom parser args"+   [ testProperty "custom separators work" prop_custom_separators+   ]++-- ---------------------------------------------------------------------------+-- Export+-- ---------------------------------------------------------------------------++rangeParserTestCases :: [Test]+rangeParserTestCases =+   [ test_haddock+   , test_singletons+   , test_spans+   , test_bounds+   , test_wildcard+   , test_union+   , test_edge_cases+   , test_custom+   ]

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.3.1.0+version:             0.3.2.0  -- A short (one-line) description of the package. synopsis:            An efficient and versatile range library.@@ -62,6 +62,7 @@   -- Modules exported by the library.   exposed-modules:    Data.Range                       , Data.Ranges+                      , Data.Range.Ord                       , Data.Range.Parser                       , Data.Range.Algebra @@ -90,6 +91,10 @@    type:       exitcode-stdio-1.0    main-is: Test/Range.hs    other-modules: Test.RangeMerge+                  , Test.RangeLaws+                  , Test.RangeParser+                  , Test.RangeOrd+                  , Test.Generators    build-depends: base                          >= 4.5 && < 5                   , Cabal                       >= 1.14                   , QuickCheck                  >= 2.4.0.1 && < 3@@ -98,6 +103,8 @@                   , random                      >= 1.0                   , free >= 4.12                   , deepseq >= 1.4 && < 2+                  , parsec >= 3 && < 4+                  , containers >= 0.5 && < 1                   , range    default-language: Haskell2010    ghc-options: -rtsopts -Wall -fno-enable-rewrite-rules