{-# LANGUAGE Safe #-}

-- | The primary interface to the range library.
--
-- A 'Range' describes a membership set over any 'Ord' type. This module
-- provides the 'Ranges' type — a canonicalised, indexed collection of
-- 'Range' values — along with construction operators, set operations, and
-- membership predicates.
--
-- = Quick start
--
-- Build ranges with the construction operators and combine them with @('<>')@:
--
-- >>> (1 +=+ 5 :: Ranges Integer) <> (3 +=+ 8)
-- Ranges [1 +=+ 8]
--
-- Test membership:
--
-- >>> inRanges (1 +=+ 10 <> 20 +=+ 30 :: Ranges Integer) 5
-- True
-- >>> inRanges (1 +=+ 10 <> 20 +=+ 30 :: Ranges Integer) 15
-- False
--
-- Use 'mconcat' to build from a list:
--
-- >>> mconcat [1 +=+ 5, 10 +=+ 15, 12 +=+ 20 :: Ranges Integer]
-- Ranges [1 +=+ 5,10 +=+ 20]
--
-- = Transforming ranges
--
-- 'Ranges' does not implement 'Functor'. Mapping a function over boundary
-- values is not a well-defined operation for half-infinite ranges: an
-- order-reversing function like @negate@ applied to 'lbi' would need to
-- produce 'ubi', but 'Functor' cannot express that structural flip.
--
-- The idiomatic alternative is to __map the query value__, not the ranges.
-- Instead of converting boundaries to a new domain, convert incoming queries
-- back to the range's domain:
--
-- @
-- -- Unit conversion: test a Fahrenheit value against Celsius ranges
-- let safeTemp = 20 +=+ 37 :: Ranges Double  -- defined in °C
-- let inSafeTemp f = inRanges safeTemp ((f - 32) * 5 / 9)
-- @
--
-- This is always correct regardless of whether the conversion is monotone,
-- never requires re-canonicalisation, and avoids the constructor-flip hazard.
--
-- = Module guide
--
-- * "Data.Ranges" — __start here__. 'Ranges' type, all set operations.
-- * "Data.Range" — deprecated re-export shim; use "Data.Ranges" instead.
-- * "Data.Range.Ord" — 'Data.Range.Ord.KeyRange' and 'Data.Range.Ord.SortedRange' for 'Ord'-requiring contexts.
-- * "Data.Range.Parser" — Parsec-based parser for range strings.
-- * "Data.Range.Algebra" — F-Algebra for deferred, efficient expression trees.
module Data.Ranges (
  -- * Core types
  Range(..),
  Bound(..),
  BoundType(..),
  -- * The Ranges type
  Ranges(unRanges),
  -- * Range creation
  -- $creation
  (+=+),
  (+=*),
  (*=+),
  (*=*),
  lbi,
  lbe,
  ubi,
  ube,
  inf,
  -- * Single-range predicates
  inRange,
  aboveRange,
  belowRange,
  rangesOverlap,
  rangesAdjoin,
  -- * Multi-range predicates
  inRanges,
  aboveRanges,
  belowRanges,
  -- * Set operations
  mergeRanges,
  union,
  intersection,
  difference,
  invert,
  -- * Enumerable methods
  fromRanges,
  joinRanges
) where

-- $setup
-- >>> import Data.Ranges
-- >>> import Data.Foldable (fold)

import Control.DeepSeq (NFData, rnf)

import Data.Range.Data
import Data.Range.Util
  ( againstLowerBound, againstUpperBound, boundIsBetween, boundsOverlapType
  , invertBound, takeEvenly
  )
import Data.Range.RangeInternal
  ( loadRanges, exportRangeMerge, joinRM, buildSpanQuery
  , RangeMerge(..)
  )
import qualified Data.Range.Operators as Op
import qualified Data.Range.Algebra as Alg

-- ---------------------------------------------------------------------------
-- Internal helpers
-- ---------------------------------------------------------------------------

-- | Build an O(log n) membership predicate from a canonical range list.
buildQuery :: Ord a => [Range a] -> a -> Bool
buildQuery :: forall a. Ord a => [Range a] -> a -> Bool
buildQuery [Range a]
rs = case [Range a] -> RangeMerge a
forall a. Ord a => [Range a] -> RangeMerge a
loadRanges [Range a]
rs of
  RangeMerge a
IRM            -> Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True
  RM Maybe (Bound a)
lb Maybe (Bound a)
ub [(Bound a, Bound a)]
spans -> Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> a -> Bool
forall a.
Ord a =>
Maybe (Bound a)
-> Maybe (Bound a) -> [(Bound a, Bound a)] -> a -> Bool
buildSpanQuery Maybe (Bound a)
lb Maybe (Bound a)
ub [(Bound a, Bound a)]
spans

-- | Build an O(1) "above all ranges" predicate from the canonical range list.
-- The last element has the largest upper bound; if @a@ is above it, it is
-- above every range. If the last element is a 'LowerBoundRange' or
-- 'InfiniteRange', nothing can be above it, so the predicate returns 'False'.
buildAboveQuery :: Ord a => [Range a] -> a -> Bool
buildAboveQuery :: forall a. Ord a => [Range a] -> a -> Bool
buildAboveQuery []  = Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True
buildAboveQuery [Range a]
rs  = Range a -> a -> Bool
forall a. Ord a => Range a -> a -> Bool
aboveRange ([Range a] -> Range a
forall a. HasCallStack => [a] -> a
last [Range a]
rs)

-- | Build an O(1) "below all ranges" predicate from the canonical range list.
-- The first element has the smallest lower bound; if @a@ is below it, it is
-- below every range. If the first element is an 'UpperBoundRange' or
-- 'InfiniteRange', nothing can be below it, so the predicate returns 'False'.
buildBelowQuery :: Ord a => [Range a] -> a -> Bool
buildBelowQuery :: forall a. Ord a => [Range a] -> a -> Bool
buildBelowQuery []    = Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True
buildBelowQuery (Range a
r:[Range a]
_) = Range a -> a -> Bool
forall a. Ord a => Range a -> a -> Bool
belowRange Range a
r

-- | Smart constructor. Canonicalises the range list and pre-builds the
-- membership predicate. Every 'Ranges' value in this module is produced
-- through this function.
mkRanges :: Ord a => [Range a] -> Ranges a
mkRanges :: forall a. Ord a => [Range a] -> Ranges a
mkRanges [Range a]
xs =
  let canonical :: [Range a]
canonical = Algebra RangeExpr [Range a]
forall a. RangeAlgebra a => Algebra RangeExpr a
Alg.eval Algebra RangeExpr [Range a] -> Algebra RangeExpr [Range a]
forall a b. (a -> b) -> a -> b
$ RangeExpr [Range a] -> RangeExpr [Range a] -> RangeExpr [Range a]
forall a. RangeExpr a -> RangeExpr a -> RangeExpr a
Alg.union ([Range a] -> RangeExpr [Range a]
forall a. a -> RangeExpr a
Alg.const []) ([Range a] -> RangeExpr [Range a]
forall a. a -> RangeExpr a
Alg.const [Range a]
xs)
  in [Range a] -> (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Ranges a
forall a.
[Range a] -> (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Ranges a
Ranges [Range a]
canonical ([Range a] -> a -> Bool
forall a. Ord a => [Range a] -> a -> Bool
buildQuery [Range a]
canonical) ([Range a] -> a -> Bool
forall a. Ord a => [Range a] -> a -> Bool
buildAboveQuery [Range a]
canonical) ([Range a] -> a -> Bool
forall a. Ord a => [Range a] -> a -> Bool
buildBelowQuery [Range a]
canonical)

-- ---------------------------------------------------------------------------
-- The Ranges type
-- ---------------------------------------------------------------------------

-- $creation
-- Each operator constructs a single-element 'Ranges'. Because 'Ranges' is a
-- 'Semigroup', you can combine them directly with '<>':
--
-- >>> (1 +=+ 5 :: Ranges Integer) <> (3 +=+ 8)
-- Ranges [1 +=+ 8]
--
-- The operators mirror those in "Data.Range.Operators" but return 'Ranges'
-- instead of 'Range', so they compose naturally without wrapping.

-- | A set of ranges represented as a merged, canonical list of
-- non-overlapping 'Range' values, with pre-built O(log n) membership,
-- O(1) above, and O(1) below predicates.
--
-- Construct values with the operators ('+=+', 'lbi', etc.) or with
-- 'mergeRanges'. Combine with @('<>')@ or 'mconcat'.
--
-- __Semigroup__: @('<>')@ computes the set union and merges the result into
-- canonical form.
--
-- >>> (1 +=+ 5 :: Ranges Integer) <> (3 +=+ 8)
-- Ranges [1 +=+ 8]
--
-- __Monoid__: 'mempty' is the empty set. 'mconcat' merges an entire list in a
-- single pass, more efficiently than repeated @('<>')@:
--
-- >>> mconcat [1 +=+ 5, 10 +=+ 15, 12 +=+ 20 :: Ranges Integer]
-- Ranges [1 +=+ 5,10 +=+ 20]
--
-- Use 'unRanges' to extract the underlying list.
data Ranges a = Ranges
  { forall a. Ranges a -> [Range a]
unRanges     :: [Range a]  -- ^ The canonical (sorted, non-overlapping) list.
  , forall a. Ranges a -> a -> Bool
_rangesQuery :: a -> Bool  -- ^ Cached O(log n) membership predicate.
  , forall a. Ranges a -> a -> Bool
_aboveQuery  :: a -> Bool  -- ^ Cached O(1) "above all ranges" predicate.
  , forall a. Ranges a -> a -> Bool
_belowQuery  :: a -> Bool  -- ^ Cached O(1) "below all ranges" predicate.
  }

-- | Two 'Ranges' values are equal when their canonical range lists are equal.
instance Eq a => Eq (Ranges a) where
  Ranges a
a == :: Ranges a -> Ranges a -> Bool
== Ranges a
b = Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
a [Range a] -> [Range a] -> Bool
forall a. Eq a => a -> a -> Bool
== Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
b

instance Show a => Show (Ranges a) where
  showsPrec :: Int -> Ranges a -> ShowS
showsPrec Int
i Ranges a
r = Bool -> ShowS -> ShowS
showParen (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String
"Ranges " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Range a] -> ShowS
forall a. Show a => a -> ShowS
shows (Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
r)

-- | Forces the canonical range list; the cached predicate closure is not
-- forced (it is derived from the list and adds no new thunks).
instance NFData a => NFData (Ranges a) where
  rnf :: Ranges a -> ()
rnf Ranges a
r = [Range a] -> ()
forall a. NFData a => a -> ()
rnf (Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
r)

instance Ord a => Semigroup (Ranges a) where
  <> :: Ranges a -> Ranges a -> Ranges a
(<>) Ranges a
a Ranges a
b = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges (Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
a [Range a] -> [Range a] -> [Range a]
forall a. [a] -> [a] -> [a]
++ Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
b)

-- | Evaluates a 'Alg.RangeExpr' tree whose leaves are 'Ranges' values,
-- producing a canonicalised 'Ranges' with a pre-built membership predicate.
--
-- This is the primary evaluation target for user-facing algebra expressions.
-- The implementation converts leaves to @['Range' a]@ internally, folds the
-- tree in a single @'RangeMerge'@ pass (the same efficient path as the
-- @['Range' a]@ instance), then wraps the result with 'mkRanges'.
instance (Ord a) => Alg.RangeAlgebra (Ranges a) where
  eval :: Algebra RangeExpr (Ranges a)
eval RangeExpr (Ranges a)
expr = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges (Algebra RangeExpr [Range a]
forall a. RangeAlgebra a => Algebra RangeExpr a
Alg.eval ((Ranges a -> [Range a])
-> RangeExpr (Ranges a) -> RangeExpr [Range a]
forall a b. (a -> b) -> RangeExpr a -> RangeExpr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges RangeExpr (Ranges a)
expr))

instance Ord a => Monoid (Ranges a) where
  mempty :: Ranges a
mempty  = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges []
  mconcat :: [Ranges a] -> Ranges a
mconcat = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges ([Range a] -> Ranges a)
-> ([Ranges a] -> [Range a]) -> [Ranges a] -> Ranges a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ranges a -> [Range a]) -> [Ranges a] -> [Range a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges

-- ---------------------------------------------------------------------------
-- Construction operators
-- ---------------------------------------------------------------------------

-- | Mathematically equivalent to @[x, y]@. See 'SpanRange' for the
-- underlying constructor.
--
-- >>> 1 +=+ 5 :: Ranges Integer
-- Ranges [1 +=+ 5]
(+=+) :: Ord a => a -> a -> Ranges a
+=+ :: forall a. Ord a => a -> a -> Ranges a
(+=+) a
a a
b = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges [a -> a -> Range a
forall a. a -> a -> Range a
(Op.+=+) a
a a
b]

-- | Mathematically equivalent to @[x, y)@.
--
-- >>> 1 +=* 5 :: Ranges Integer
-- Ranges [1 +=* 5]
(+=*) :: Ord a => a -> a -> Ranges a
+=* :: forall a. Ord a => a -> a -> Ranges a
(+=*) a
a a
b = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges [a -> a -> Range a
forall a. a -> a -> Range a
(Op.+=*) a
a a
b]

-- | Mathematically equivalent to @(x, y]@.
--
-- >>> 1 *=+ 5 :: Ranges Integer
-- Ranges [1 *=+ 5]
(*=+) :: Ord a => a -> a -> Ranges a
*=+ :: forall a. Ord a => a -> a -> Ranges a
(*=+) a
a a
b = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges [a -> a -> Range a
forall a. a -> a -> Range a
(Op.*=+) a
a a
b]

-- | Mathematically equivalent to @(x, y)@.
--
-- >>> 1 *=* 5 :: Ranges Integer
-- Ranges [1 *=* 5]
(*=*) :: Ord a => a -> a -> Ranges a
*=* :: forall a. Ord a => a -> a -> Ranges a
(*=*) a
a a
b = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges [a -> a -> Range a
forall a. a -> a -> Range a
(Op.*=*) a
a a
b]

-- | Mathematically equivalent to @[x, ∞)@.
--
-- >>> lbi 5 :: Ranges Integer
-- Ranges [lbi 5]
lbi :: Ord a => a -> Ranges a
lbi :: forall a. Ord a => a -> Ranges a
lbi = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges ([Range a] -> Ranges a) -> (a -> [Range a]) -> a -> Ranges a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range a -> [Range a] -> [Range a]
forall a. a -> [a] -> [a]
:[]) (Range a -> [Range a]) -> (a -> Range a) -> a -> [Range a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Range a
forall a. a -> Range a
Op.lbi

-- | Mathematically equivalent to @(x, ∞)@.
lbe :: Ord a => a -> Ranges a
lbe :: forall a. Ord a => a -> Ranges a
lbe = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges ([Range a] -> Ranges a) -> (a -> [Range a]) -> a -> Ranges a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range a -> [Range a] -> [Range a]
forall a. a -> [a] -> [a]
:[]) (Range a -> [Range a]) -> (a -> Range a) -> a -> [Range a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Range a
forall a. a -> Range a
Op.lbe

-- | Mathematically equivalent to @(−∞, x]@.
ubi :: Ord a => a -> Ranges a
ubi :: forall a. Ord a => a -> Ranges a
ubi = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges ([Range a] -> Ranges a) -> (a -> [Range a]) -> a -> Ranges a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range a -> [Range a] -> [Range a]
forall a. a -> [a] -> [a]
:[]) (Range a -> [Range a]) -> (a -> Range a) -> a -> [Range a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Range a
forall a. a -> Range a
Op.ubi

-- | Mathematically equivalent to @(−∞, x)@.
ube :: Ord a => a -> Ranges a
ube :: forall a. Ord a => a -> Ranges a
ube = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges ([Range a] -> Ranges a) -> (a -> [Range a]) -> a -> Ranges a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range a -> [Range a] -> [Range a]
forall a. a -> [a] -> [a]
:[]) (Range a -> [Range a]) -> (a -> Range a) -> a -> [Range a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Range a
forall a. a -> Range a
Op.ube

-- | The infinite range, covering all values.
inf :: Ord a => Ranges a
inf :: forall a. Ord a => Ranges a
inf = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges [Range a
forall a. Range a
Op.inf]

-- ---------------------------------------------------------------------------
-- Single-range predicates
-- ---------------------------------------------------------------------------

-- | Returns 'True' if the value falls within the single range.
-- Respects 'Inclusive' and 'Exclusive' bounds.
--
-- See 'inRanges' for testing against a 'Ranges' collection.
--
-- >>> inRange (SpanRange (Bound 1 Inclusive) (Bound 10 Inclusive)) (5 :: Integer)
-- True
-- >>> inRange (SpanRange (Bound 1 Inclusive) (Bound 10 Exclusive)) (10 :: Integer)
-- False
inRange :: Ord a => Range a -> a -> Bool
inRange :: forall a. Ord a => Range a -> a -> Bool
inRange (SingletonRange a
a)      a
value = a
value a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a
inRange (SpanRange Bound a
x Bound a
y)         a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> (Bound a, Bound a) -> OverlapType
forall a. Ord a => Bound a -> (Bound a, Bound a) -> OverlapType
boundIsBetween (a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
value BoundType
Inclusive) (Bound a
x, Bound a
y)
inRange (LowerBoundRange Bound a
lower) a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstLowerBound (a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
value BoundType
Inclusive) Bound a
lower
inRange (UpperBoundRange Bound a
upper) a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound (a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
value BoundType
Inclusive) Bound a
upper
inRange Range a
InfiniteRange           a
_     = Bool
True

-- | Returns 'True' if the value is strictly above (greater than the upper
-- bound of) the given range.
--
-- >>> aboveRange (SpanRange (Bound 1 Inclusive) (Bound 5 Inclusive)) (6 :: Integer)
-- True
-- >>> aboveRange (LowerBoundRange (Bound 0 Inclusive)) (6 :: Integer)
-- False
aboveRange :: Ord a => Range a -> a -> Bool
aboveRange :: forall a. Ord a => Range a -> a -> Bool
aboveRange (SingletonRange a
a)      a
value = a
value a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
a
aboveRange (SpanRange Bound a
_ Bound a
y)         a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstLowerBound (a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
value BoundType
Inclusive) (Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
y)
aboveRange (LowerBoundRange Bound a
_)     a
_     = Bool
False
aboveRange (UpperBoundRange Bound a
upper) a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstLowerBound (a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
value BoundType
Inclusive) (Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
upper)
aboveRange Range a
InfiniteRange           a
_     = Bool
False

-- | Returns 'True' if the value is strictly below (less than the lower
-- bound of) the given range.
--
-- >>> belowRange (SpanRange (Bound 1 Inclusive) (Bound 5 Inclusive)) (0 :: Integer)
-- True
-- >>> belowRange (UpperBoundRange (Bound 6 Inclusive)) (0 :: Integer)
-- False
belowRange :: Ord a => Range a -> a -> Bool
belowRange :: forall a. Ord a => Range a -> a -> Bool
belowRange (SingletonRange a
a)      a
value = a
value a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
a
belowRange (SpanRange Bound a
x Bound a
_)         a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound (a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
value BoundType
Inclusive) (Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
x)
belowRange (LowerBoundRange Bound a
lower) a
value = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound (a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
value BoundType
Inclusive) (Bound a -> Bound a
forall a. Bound a -> Bound a
invertBound Bound a
lower)
belowRange (UpperBoundRange Bound a
_)     a
_     = Bool
False
belowRange Range a
InfiniteRange           a
_     = Bool
False

-- | Returns 'True' if two ranges share at least one value.
--
-- >>> rangesOverlap (SpanRange (Bound 1 Inclusive) (Bound 5 Inclusive)) (SpanRange (Bound 3 Inclusive) (Bound 7 Inclusive) :: Range Integer)
-- True
-- >>> rangesOverlap (SpanRange (Bound 1 Inclusive) (Bound 5 Exclusive)) (SpanRange (Bound 5 Inclusive) (Bound 7 Inclusive) :: Range Integer)
-- False
rangesOverlap :: Ord a => Range a -> Range a -> Bool
rangesOverlap :: forall a. Ord a => Range a -> Range a -> Bool
rangesOverlap Range a
a Range a
b = OverlapType
Overlap OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Range a -> Range a -> OverlapType
forall a. Ord a => Range a -> Range a -> OverlapType
rangesOverlapType Range a
a Range a
b

-- | Returns 'True' if two ranges touch at a single exclusive boundary but
-- share no values.
--
-- >>> rangesAdjoin (SpanRange (Bound 1 Inclusive) (Bound 5 Exclusive)) (SpanRange (Bound 5 Inclusive) (Bound 7 Inclusive) :: Range Integer)
-- True
-- >>> rangesAdjoin (SpanRange (Bound 1 Inclusive) (Bound 5 Inclusive)) (SpanRange (Bound 3 Inclusive) (Bound 7 Inclusive) :: Range Integer)
-- False
rangesAdjoin :: Ord a => Range a -> Range a -> Bool
rangesAdjoin :: forall a. Ord a => Range a -> Range a -> Bool
rangesAdjoin Range a
a Range a
b = OverlapType
Adjoin OverlapType -> OverlapType -> Bool
forall a. Eq a => a -> a -> Bool
== Range a -> Range a -> OverlapType
forall a. Ord a => Range a -> Range a -> OverlapType
rangesOverlapType Range a
a Range a
b

rangesOverlapType :: Ord a => Range a -> Range a -> OverlapType
rangesOverlapType :: forall a. Ord a => Range a -> Range a -> OverlapType
rangesOverlapType (SingletonRange a
a) Range a
x =
  Range a -> Range a -> OverlapType
forall a. Ord a => Range a -> Range a -> OverlapType
rangesOverlapType (Bound a -> Bound a -> Range a
forall a. Bound a -> Bound a -> Range a
SpanRange (a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
a BoundType
Inclusive) (a -> BoundType -> Bound a
forall a. a -> BoundType -> Bound a
Bound a
a BoundType
Inclusive)) Range a
x
rangesOverlapType (SpanRange Bound a
x Bound a
y)        (SpanRange Bound a
a Bound a
b)         = (Bound a, Bound a) -> (Bound a, Bound a) -> OverlapType
forall a.
Ord a =>
(Bound a, Bound a) -> (Bound a, Bound a) -> OverlapType
boundsOverlapType (Bound a
x, Bound a
y) (Bound a
a, Bound a
b)
rangesOverlapType (SpanRange Bound a
_ Bound a
y)        (LowerBoundRange Bound a
lower) = Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstLowerBound Bound a
y Bound a
lower
rangesOverlapType (SpanRange Bound a
x Bound a
_)        (UpperBoundRange Bound a
upper) = Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound Bound a
x Bound a
upper
rangesOverlapType (LowerBoundRange Bound a
_)    (LowerBoundRange Bound a
_)     = OverlapType
Overlap
rangesOverlapType (LowerBoundRange Bound a
lo)   (UpperBoundRange Bound a
up)    = Bound a -> Bound a -> OverlapType
forall a. Ord a => Bound a -> Bound a -> OverlapType
againstUpperBound Bound a
lo Bound a
up
rangesOverlapType (UpperBoundRange Bound a
_)    (UpperBoundRange Bound a
_)     = OverlapType
Overlap
rangesOverlapType Range a
InfiniteRange          Range a
_                       = OverlapType
Overlap
rangesOverlapType Range a
a Range a
b = Range a -> Range a -> OverlapType
forall a. Ord a => Range a -> Range a -> OverlapType
rangesOverlapType Range a
b Range a
a

-- ---------------------------------------------------------------------------
-- Multi-range predicates
-- ---------------------------------------------------------------------------

-- | Returns 'True' if the value falls within any of the given ranges.
--
-- The membership predicate is pre-built when the 'Ranges' value is
-- constructed, so each call is O(log n) in 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 :: forall a. Ord a => Ranges a -> a -> Bool
inRanges = Ranges a -> a -> Bool
forall a. Ranges a -> a -> Bool
_rangesQuery

-- | Returns 'True' if the value is strictly above all of the given ranges.
--
-- This predicate is O(1): the answer is determined by the last element of the
-- canonical range list (which has the largest upper bound), cached at
-- construction time.
--
-- >>> aboveRanges (1 +=+ 5 <> 10 +=+ 15 :: Ranges Integer) 20
-- True
-- >>> aboveRanges (1 +=+ 5 <> lbi 10 :: Ranges Integer) 20
-- False
aboveRanges :: Ord a => Ranges a -> a -> Bool
aboveRanges :: forall a. Ord a => Ranges a -> a -> Bool
aboveRanges = Ranges a -> a -> Bool
forall a. Ranges a -> a -> Bool
_aboveQuery

-- | Returns 'True' if the value is strictly below all of the given ranges.
--
-- This predicate is O(1): the answer is determined by the first element of the
-- canonical range list (which has the smallest lower bound), cached at
-- construction time.
--
-- >>> belowRanges (5 +=+ 10 <> 20 +=+ 30 :: Ranges Integer) 1
-- True
-- >>> belowRanges (ubi 10 <> 20 +=+ 30 :: Ranges Integer) 1
-- False
belowRanges :: Ord a => Ranges a -> a -> Bool
belowRanges :: forall a. Ord a => Ranges a -> a -> Bool
belowRanges = Ranges a -> a -> Bool
forall a. Ranges a -> a -> Bool
_belowQuery

-- ---------------------------------------------------------------------------
-- Set operations
-- ---------------------------------------------------------------------------

-- | Canonicalise a raw list of 'Range' values into a 'Ranges'. Overlapping
-- ranges are merged; the result is sorted and non-overlapping.
--
-- >>> mergeRanges [LowerBoundRange (Bound 12 Inclusive), SpanRange (Bound 1 Inclusive) (Bound 10 Inclusive), SpanRange (Bound 5 Inclusive) (Bound 15 Inclusive) :: Range Integer]
-- Ranges [lbi 1]
mergeRanges :: Ord a => [Range a] -> Ranges a
mergeRanges :: forall a. Ord a => [Range a] -> Ranges a
mergeRanges = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges

-- | Set union. Equivalent to @('<>')@.
--
-- >>> union (1 +=+ 10) (5 +=+ 15 :: Ranges Integer)
-- Ranges [1 +=+ 15]
union :: Ord a => Ranges a -> Ranges a -> Ranges a
union :: forall a. Ord a => Ranges a -> Ranges a -> Ranges a
union Ranges a
a Ranges a
b = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges ([Range a] -> Ranges a) -> [Range a] -> Ranges a
forall a b. (a -> b) -> a -> b
$ Algebra RangeExpr [Range a]
forall a. RangeAlgebra a => Algebra RangeExpr a
Alg.eval Algebra RangeExpr [Range a] -> Algebra RangeExpr [Range a]
forall a b. (a -> b) -> a -> b
$
  RangeExpr [Range a] -> RangeExpr [Range a] -> RangeExpr [Range a]
forall a. RangeExpr a -> RangeExpr a -> RangeExpr a
Alg.union ([Range a] -> RangeExpr [Range a]
forall a. a -> RangeExpr a
Alg.const (Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
a)) ([Range a] -> RangeExpr [Range a]
forall a. a -> RangeExpr a
Alg.const (Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
b))

-- | Set intersection. 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 :: forall a. Ord a => Ranges a -> Ranges a -> Ranges a
intersection Ranges a
a Ranges a
b = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges ([Range a] -> Ranges a) -> [Range a] -> Ranges a
forall a b. (a -> b) -> a -> b
$ Algebra RangeExpr [Range a]
forall a. RangeAlgebra a => Algebra RangeExpr a
Alg.eval Algebra RangeExpr [Range a] -> Algebra RangeExpr [Range a]
forall a b. (a -> b) -> a -> b
$
  RangeExpr [Range a] -> RangeExpr [Range a] -> RangeExpr [Range a]
forall a. RangeExpr a -> RangeExpr a -> RangeExpr a
Alg.intersection ([Range a] -> RangeExpr [Range a]
forall a. a -> RangeExpr a
Alg.const (Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
a)) ([Range a] -> RangeExpr [Range a]
forall a. a -> RangeExpr a
Alg.const (Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
b))

-- | Set difference: values in the first 'Ranges' not in the second.
--
-- >>> difference (1 +=+ 10) (5 +=+ 15 :: Ranges Integer)
-- Ranges [1 +=* 5]
difference :: Ord a => Ranges a -> Ranges a -> Ranges a
difference :: forall a. Ord a => Ranges a -> Ranges a -> Ranges a
difference Ranges a
a Ranges a
b = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges ([Range a] -> Ranges a) -> [Range a] -> Ranges a
forall a b. (a -> b) -> a -> b
$ Algebra RangeExpr [Range a]
forall a. RangeAlgebra a => Algebra RangeExpr a
Alg.eval Algebra RangeExpr [Range a] -> Algebra RangeExpr [Range a]
forall a b. (a -> b) -> a -> b
$
  RangeExpr [Range a] -> RangeExpr [Range a] -> RangeExpr [Range a]
forall a. RangeExpr a -> RangeExpr a -> RangeExpr a
Alg.difference ([Range a] -> RangeExpr [Range a]
forall a. a -> RangeExpr a
Alg.const (Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
a)) ([Range a] -> RangeExpr [Range a]
forall a. a -> RangeExpr a
Alg.const (Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges Ranges a
b))

-- | Complement: all values /not/ covered by the given 'Ranges'.
-- @'invert' . 'invert' == 'id'@.
--
-- >>> invert (1 +=* 10 <> 15 *=+ 20 :: Ranges Integer)
-- Ranges [ube 1,10 +=+ 15,lbe 20]
invert :: Ord a => Ranges a -> Ranges a
invert :: forall a. Ord a => Ranges a -> Ranges a
invert = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges ([Range a] -> Ranges a)
-> (Ranges a -> [Range a]) -> Ranges a -> Ranges a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Algebra RangeExpr [Range a]
forall a. RangeAlgebra a => Algebra RangeExpr a
Alg.eval Algebra RangeExpr [Range a]
-> (Ranges a -> RangeExpr [Range a]) -> Ranges a -> [Range a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RangeExpr [Range a] -> RangeExpr [Range a]
forall a. RangeExpr a -> RangeExpr a
Alg.invert (RangeExpr [Range a] -> RangeExpr [Range a])
-> (Ranges a -> RangeExpr [Range a])
-> Ranges a
-> RangeExpr [Range a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Range a] -> RangeExpr [Range a]
forall a. a -> RangeExpr a
Alg.const ([Range a] -> RangeExpr [Range a])
-> (Ranges a -> [Range a]) -> Ranges a -> RangeExpr [Range a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges

-- ---------------------------------------------------------------------------
-- Enumerable methods
-- ---------------------------------------------------------------------------

-- | Instantiate all values covered by the ranges as a list.
-- __Warning:__ not efficient. Prefer 'inRanges' for membership tests.
-- Combine with 'take' to avoid evaluating infinite ranges.
--
-- >>> take 5 . fromRanges $ (1 +=+ 10 :: Ranges Integer)
-- [1,2,3,4,5]
--
-- >>> take 6 . fromRanges $ (1 +=+ 3 :: Ranges Integer) <> (10 +=+ 12)
-- [1,10,2,11,3,12]
fromRanges :: (Ord a, Enum a) => Ranges a -> [a]
fromRanges :: forall a. (Ord a, Enum a) => Ranges a -> [a]
fromRanges = [[a]] -> [a]
forall a. [[a]] -> [a]
takeEvenly ([[a]] -> [a]) -> (Ranges a -> [[a]]) -> Ranges a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range a -> [a]) -> [Range a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range a -> [a]
forall {a}. Enum a => Range a -> [a]
fromRange ([Range a] -> [[a]])
-> (Ranges a -> [Range a]) -> Ranges a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges
  where
    fromRange :: Range a -> [a]
fromRange (SingletonRange a
x) = [a
x]
    fromRange (SpanRange (Bound a
a BoundType
aType) (Bound a
b BoundType
bType)) =
      [ (if BoundType
aType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Inclusive then a
a else a -> a
forall a. Enum a => a -> a
succ a
a)
        .. (if BoundType
bType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Inclusive then a
b else a -> a
forall a. Enum a => a -> a
pred a
b) ]
    fromRange (LowerBoundRange (Bound a
x BoundType
xType)) =
      (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
forall a. Enum a => a -> a
succ (if BoundType
xType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Inclusive then a
x else a -> a
forall a. Enum a => a -> a
succ a
x)
    fromRange (UpperBoundRange (Bound a
x BoundType
xType)) =
      (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
forall a. Enum a => a -> a
pred (if BoundType
xType BoundType -> BoundType -> Bool
forall a. Eq a => a -> a -> Bool
== BoundType
Inclusive then a
x else a -> a
forall a. Enum a => a -> a
pred a
x)
    fromRange Range a
InfiniteRange =
      a
zero a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [[a]] -> [a]
forall a. [[a]] -> [a]
takeEvenly [(a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
forall a. Enum a => a -> a
succ (a -> a
forall a. Enum a => a -> a
succ a
zero), (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
forall a. Enum a => a -> a
pred (a -> a
forall a. Enum a => a -> a
pred a
zero)]
      where zero :: a
zero = Int -> a
forall a. Enum a => Int -> a
toEnum Int
0

-- | Join adjacent ranges that are contiguous for 'Enum' types.
-- For example, @[1 +=+ 5, 6 +=+ 10]@ collapses to @[1 +=+ 10]@ for
-- 'Integer' because there is no integer between 5 and 6.
--
-- >>> joinRanges (mconcat [1 +=+ 5, 6 +=+ 10] :: Ranges Integer)
-- Ranges [1 +=+ 10]
joinRanges :: (Ord a, Enum a) => Ranges a -> Ranges a
joinRanges :: forall a. (Ord a, Enum a) => Ranges a -> Ranges a
joinRanges = [Range a] -> Ranges a
forall a. Ord a => [Range a] -> Ranges a
mkRanges ([Range a] -> Ranges a)
-> (Ranges a -> [Range a]) -> Ranges a -> Ranges a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RangeMerge a -> [Range a]
forall a. Eq a => RangeMerge a -> [Range a]
exportRangeMerge (RangeMerge a -> [Range a])
-> (Ranges a -> RangeMerge a) -> Ranges a -> [Range a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RangeMerge a -> RangeMerge a
forall a. (Eq a, Enum a) => RangeMerge a -> RangeMerge a
joinRM (RangeMerge a -> RangeMerge a)
-> (Ranges a -> RangeMerge a) -> Ranges a -> RangeMerge a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Range a] -> RangeMerge a
forall a. Ord a => [Range a] -> RangeMerge a
loadRanges ([Range a] -> RangeMerge a)
-> (Ranges a -> [Range a]) -> Ranges a -> RangeMerge a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ranges a -> [Range a]
forall a. Ranges a -> [Range a]
unRanges