range 0.3.2.2 → 0.4.0.0

raw patch · 5 files changed

+113/−45 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Range.hs +23/−2
• Data/Range/RangeInternal.hs +21/−0
• Data/Range/Util.hs +2/−7
• Data/Ranges.hs +64/−35
• range.cabal +3/−1

@@ -144,7 +144,7 @@ import Data.Range.Data import Data.Range.Operators import Data.Range.Util-import Data.Range.RangeInternal (exportRangeMerge, joinRM, loadRanges)+import Data.Range.RangeInternal (exportRangeMerge, joinRM, loadRanges, RangeMerge(..), buildSpanQuery) import qualified Data.Range.Algebra as Alg  -- | Performs a set union between the two input ranges and returns the resultant set of@@ -276,6 +276,24 @@ -- This is the primary membership test for the library and is significantly more -- performant than approximating it with @'elem' x [lo..hi]@. --+-- The range list is canonicalised and a 'Data.Map'-backed lookup structure is+-- built when this function is partially applied to its range argument. This+-- means that when testing multiple values against the same set of ranges,+-- partial application amortises the setup cost:+--+-- @+-- -- Efficient: map is built once+-- let memberOf = inRanges myRanges+-- filter memberOf largeList+--+-- -- Also fine for one-off checks+-- inRanges myRanges someValue+-- @+--+-- The first argument does not need to be in merged\/canonical form; the+-- function canonicalises it internally. If the input is already canonical+-- (e.g. the result of 'mergeRanges'), canonicalisation is a no-op.+-- -- >>> inRanges [1 +=+ 10, 20 +=+ 30] (5 :: Integer) -- True -- >>> inRanges [1 +=+ 10, 20 +=+ 30] (15 :: Integer)@@ -285,7 +303,10 @@ -- -- See also 'inRange' for testing against a single range. inRanges :: (Ord a) => [Range a] -> a -> Bool-inRanges rs a = any (`inRange` a) rs+inRanges rs =+  case loadRanges rs of+    IRM            -> const True+    RM lb ub spans -> buildSpanQuery lb ub spans  -- | Checks if the value provided is above (or greater than) the biggest value in -- the given range.

@@ -1,8 +1,10 @@ {-# LANGUAGE Safe #-}+{-# LANGUAGE BangPatterns #-}  module Data.Range.RangeInternal where  import Data.Maybe (catMaybes)+import qualified Data.Map.Strict as Map  import Data.Range.Data import Data.Range.Spans@@ -250,3 +252,22 @@    (maybe [] (\x -> [RM Nothing (Just x) []]) upper) ++    fmap (\x -> RM Nothing Nothing [x]) spans ++    (maybe [] (\x -> [RM (Just x) Nothing []]) lower)++-- | Pre-build a 'Data.Map'-backed lookup structure from a canonical span list,+-- returning an O(log n) membership predicate. Build the map once; apply the+-- returned function for every subsequent query.+-- Precondition: spans are sorted and non-overlapping (canonical form).+buildSpanQuery :: Ord a+               => Maybe (Bound a)       -- ^ largest lower bound (semi-infinite tail)+               -> Maybe (Bound a)       -- ^ largest upper bound (semi-infinite tail)+               -> [(Bound a, Bound a)]  -- ^ canonical finite spans+               -> (a -> Bool)+buildSpanQuery lb ub spans =+  let !m = Map.fromList spans+  in \val ->+       let v = Bound val Inclusive+       in maybe False (\b -> Overlap == againstUpperBound v b) ub+          || maybe False (\b -> Overlap == againstLowerBound v b) lb+          || case Map.lookupLE v m of+               Nothing       -> False+               Just (lo, hi) -> Overlap == boundIsBetween v (lo, hi)

@@ -2,7 +2,7 @@  module Data.Range.Util where -import Data.Maybe (catMaybes)+import Data.List (transpose)  import Data.Range.Data @@ -128,12 +128,7 @@    | otherwise    = Separate  takeEvenly :: [[a]] -> [a]-takeEvenly [] = []-takeEvenly xss = (catMaybes . map safeHead $ xss) ++ takeEvenly (filter (not . null) . map tail $ xss)--safeHead :: [a] -> Maybe a-safeHead [] = Nothing-safeHead (x : _) = Just x+takeEvenly = concat . transpose  pairs :: [a] -> [(a, a)] pairs [] = []

@@ -24,7 +24,7 @@ --   expects a 'Monoid' (e.g. 'mconcat', 'fold', writer-style accumulation). module Data.Ranges (   -- * The Ranges type-  Ranges(..),+  Ranges(unRanges),   -- * Range creation   -- $creation   (+=+),@@ -57,6 +57,13 @@ import Data.Semigroup import qualified Data.Range as R +-- | Smart constructor. Canonicalises the range list and pre-builds the cached+-- lookup predicate. All internal paths that produce a 'Ranges' go through this.+mkRanges :: Ord a => [R.Range a] -> Ranges a+mkRanges xs =+  let canonical = R.mergeRanges xs+  in Ranges canonical (Just (R.inRanges canonical))+ -- $creation -- Each operator constructs a single-element 'Ranges'. Because 'Ranges' is a -- 'Semigroup', you can combine them directly with '<>':@@ -85,74 +92,96 @@ -- -- >>> fmap (*2) (1 +=+ 5 :: Ranges Integer) -- Ranges [2 +=+ 10]-newtype Ranges a = Ranges { unRanges :: [R.Range a] }+--+-- Use 'unRanges' to extract the underlying list. Do not construct 'Ranges'+-- directly; use the operators or set-operation functions so that the cached+-- lookup structure is always kept consistent.+data Ranges a = Ranges+  { unRanges     :: [R.Range a]     -- ^ The canonical (sorted, non-overlapping) range list.+  , _rangesQuery :: Maybe (a -> Bool) -- ^ Cached O(log n) predicate; Nothing after 'fmap'.+  }  instance Show a => Show (Ranges a) where-   showsPrec i (Ranges xs) = ((++) "Ranges ") . showsPrec i xs+   showsPrec i r = ((++) "Ranges ") . showsPrec i (unRanges r)  -- | @('<>')@ computes the set union of two 'Ranges' and merges the result into -- canonical (non-overlapping) form. Associative, with 'mempty' as the identity. instance Ord a => Semigroup (Ranges a) where-   (<>) (Ranges a) (Ranges b) = Ranges . R.mergeRanges $ a ++ b+   (<>) a b = mkRanges $ unRanges a ++ unRanges b  -- | 'mempty' is the empty set. 'mconcat' is more efficient than folding '<>' -- because it merges all ranges in a single pass. instance Ord a => Monoid (Ranges a) where-   mempty = Ranges []-   mappend (Ranges a) (Ranges b) = Ranges . R.mergeRanges $ a ++ b-   mconcat = Ranges . R.mergeRanges . concat . fmap unRanges+   mempty = mkRanges []+   mappend a b = mkRanges $ unRanges a ++ unRanges b+   mconcat = mkRanges . concat . fmap unRanges  -- | Maps a function over every boundary value in every range. -- Note that mapping a non-monotonic function can produce ill-formed ranges -- (e.g. a span whose lower bound ends up greater than its upper bound). -- Use with care on ordered types.+--+-- The cached lookup predicate cannot be pre-built here because 'Functor' does+-- not allow an 'Ord' constraint. Calling 'inRanges' on the result will still+-- pre-build the map on partial application via 'Data.Range.inRanges'. instance Functor Ranges where-   fmap f (Ranges xs) = Ranges . fmap (fmap f) $ xs+   fmap f r = Ranges (fmap (fmap f) (unRanges r)) Nothing  -- | Mathematically equivalent to @[x, y]@. See 'R.+=+' for details.-(+=+) :: a -> a -> Ranges a-(+=+) a b = Ranges . pure $ (R.+=+) a b+(+=+) :: Ord a => a -> a -> Ranges a+(+=+) a b = mkRanges . pure $ (R.+=+) a b  -- | Mathematically equivalent to @[x, y)@. See 'R.+=*' for details.-(+=*) :: a -> a -> Ranges a-(+=*) a b = Ranges . pure $ (R.+=*) a b+(+=*) :: Ord a => a -> a -> Ranges a+(+=*) a b = mkRanges . pure $ (R.+=*) a b  -- | Mathematically equivalent to @(x, y]@. See 'R.*=+' for details.-(*=+) :: a -> a -> Ranges a-(*=+) a b = Ranges . pure $ (R.*=+) a b+(*=+) :: Ord a => a -> a -> Ranges a+(*=+) a b = mkRanges . pure $ (R.*=+) a b  -- | Mathematically equivalent to @(x, y)@. See 'R.*=*' for details.-(*=*) :: a -> a -> Ranges a-(*=*) a b = Ranges . pure $ (R.*=*) a b+(*=*) :: Ord a => a -> a -> Ranges a+(*=*) a b = mkRanges . pure $ (R.*=*) a b  -- | Mathematically equivalent to @[x, ∞)@. See 'R.lbi' for details.-lbi :: a -> Ranges a-lbi = Ranges . pure . R.lbi+lbi :: Ord a => a -> Ranges a+lbi = mkRanges . pure . R.lbi  -- | Mathematically equivalent to @(x, ∞)@. See 'R.lbe' for details.-lbe :: a -> Ranges a-lbe = Ranges . pure . R.lbe+lbe :: Ord a => a -> Ranges a+lbe = mkRanges . pure . R.lbe  -- | Mathematically equivalent to @(−∞, x]@. See 'R.ubi' for details.-ubi :: a -> Ranges a-ubi = Ranges . pure . R.ubi+ubi :: Ord a => a -> Ranges a+ubi = mkRanges . pure . R.ubi  -- | Mathematically equivalent to @(−∞, x)@. See 'R.ube' for details.-ube :: a -> Ranges a-ube = Ranges . pure . R.ube+ube :: Ord a => a -> Ranges a+ube = mkRanges . pure . R.ube  -- | The infinite range, covering all values. See 'R.inf' for details.-inf :: Ranges a-inf = Ranges [R.inf]+inf :: Ord a => Ranges a+inf = mkRanges [R.inf]  -- | Returns 'True' if the value falls within any of the given ranges. --+-- The lookup structure is pre-built when the 'Ranges' value is constructed,+-- so each membership test is O(log n) where n is the number of spans.+-- Partial application is idiomatic:+--+-- @+-- let memberOf = inRanges myRanges+-- filter memberOf largeList+-- @+-- -- >>> inRanges (1 +=+ 10 <> 20 +=+ 30 :: Ranges Integer) 5 -- True -- >>> inRanges (1 +=+ 10 <> 20 +=+ 30 :: Ranges Integer) 15 -- False-inRanges :: (Ord a) => Ranges a -> a -> Bool-inRanges (Ranges xs) = R.inRanges xs+inRanges :: Ord a => Ranges a -> a -> Bool+inRanges r = case _rangesQuery r of+  Just f  -> f+  Nothing -> R.inRanges (unRanges r)  -- | Returns 'True' if the value is strictly above (greater than the upper -- bound of) all of the given ranges.@@ -162,7 +191,7 @@ -- >>> aboveRanges (1 +=+ 5 <> lbi 10 :: Ranges Integer) 20 -- False aboveRanges :: (Ord a) => Ranges a -> a -> Bool-aboveRanges (Ranges xs) a = R.aboveRanges xs a+aboveRanges r a = R.aboveRanges (unRanges r) a  -- | Returns 'True' if the value is strictly below (less than the lower -- bound of) all of the given ranges.@@ -172,31 +201,31 @@ -- >>> belowRanges (ubi 10 <> 20 +=+ 30 :: Ranges Integer) 1 -- False belowRanges :: (Ord a) => Ranges a -> a -> Bool-belowRanges (Ranges rs) a = R.belowRanges rs a+belowRanges r a = R.belowRanges (unRanges r) a  -- | Set union of two 'Ranges'. The output is in merged canonical form. -- Equivalent to @('<>')@. union :: (Ord a) => Ranges a -> Ranges a -> Ranges a-union (Ranges a) (Ranges b) = Ranges $ R.union a b+union a b = mkRanges $ R.union (unRanges a) (unRanges b)  -- | Set intersection of two 'Ranges'. Returns only values present in both. -- -- >>> intersection (1 +=+ 10) (5 +=+ 15 :: Ranges Integer) -- Ranges [5 +=+ 10] intersection :: (Ord a) => Ranges a -> Ranges a -> Ranges a-intersection (Ranges a) (Ranges b) = Ranges $ R.intersection a b+intersection a b = mkRanges $ R.intersection (unRanges a) (unRanges b)  -- | Set difference: values in the first 'Ranges' that are not in the second. -- -- >>> difference (1 +=+ 10) (5 +=+ 15 :: Ranges Integer) -- Ranges [1 +=* 5] difference :: (Ord a) => Ranges a -> Ranges a -> Ranges a-difference (Ranges a) (Ranges b) = Ranges $ R.difference a b+difference a b = mkRanges $ R.difference (unRanges a) (unRanges b)  -- | Returns the complement of the given 'Ranges': all values /not/ covered. -- Note that @'invert' . 'invert' == 'id'@. invert :: (Ord a) => Ranges a -> Ranges a-invert = Ranges . R.invert . unRanges+invert = mkRanges . R.invert . unRanges  -- | Instantiates all values covered by the ranges as a list. -- __Warning:__ This is a convenience function and is not efficient. Prefer@@ -215,4 +244,4 @@ -- >>> joinRanges (mconcat [1 +=+ 5, 6 +=+ 10] :: Ranges Integer) -- Ranges [1 +=+ 10] joinRanges :: (Ord a, Enum a) => Ranges a -> Ranges a-joinRanges = Ranges . R.joinRanges . unRanges+joinRanges = mkRanges . R.joinRanges . unRanges

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.3.2.2+version:             0.4.0.0  -- A short (one-line) description of the package. synopsis:            An efficient and versatile range library.@@ -82,6 +82,7 @@                   , parsec >= 3 && < 4                   , free >= 4.12 && < 6                   , deepseq >= 1.4 && < 2+                  , containers >= 0.5 && < 1    default-language: Haskell2010   ghc-options: -Wall@@ -127,5 +128,6 @@                   , deepseq >= 1.4 && < 2                   , free >= 4.12 && < 6                   , parsec >= 3 && < 4+                  , containers >= 0.5 && < 1   default-language: Haskell2010   ghc-options:      -Wall -O2 -rtsopts