{-# LANGUAGE RankNTypes #-}
module Data.Range.Typed.Operators where
import Data.Range.Typed.Data
(+=+) :: a -> a -> Range 'True 'True a
+=+ :: forall a. a -> a -> Range 'True 'True a
(+=+) a
x a
y = Bound a -> Bound a -> Range 'True 'True a
forall a. Bound a -> Bound a -> Range 'True 'True a
SpanRange (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
x) (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
y)
(+=*) :: a -> a -> Range 'True 'True a
+=* :: forall a. a -> a -> Range 'True 'True a
(+=*) a
x a
y = Bound a -> Bound a -> Range 'True 'True a
forall a. Bound a -> Bound a -> Range 'True 'True a
SpanRange (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
x) (a -> Bound a
forall a. a -> Bound a
ExclusiveBound a
y)
(*=+) :: a -> a -> Range 'True 'True a
*=+ :: forall a. a -> a -> Range 'True 'True a
(*=+) a
x a
y = Bound a -> Bound a -> Range 'True 'True a
forall a. Bound a -> Bound a -> Range 'True 'True a
SpanRange (a -> Bound a
forall a. a -> Bound a
ExclusiveBound a
x) (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
y)
(*=*) :: a -> a -> Range 'True 'True a
*=* :: forall a. a -> a -> Range 'True 'True a
(*=*) a
x a
y = Bound a -> Bound a -> Range 'True 'True a
forall a. Bound a -> Bound a -> Range 'True 'True a
SpanRange (a -> Bound a
forall a. a -> Bound a
ExclusiveBound a
x) (a -> Bound a
forall a. a -> Bound a
ExclusiveBound a
y)
lbi :: a -> Range 'True 'False a
lbi :: forall a. a -> Range 'True 'False a
lbi = Bound a -> Range 'True 'False a
forall a. Bound a -> Range 'True 'False a
LowerBoundRange (Bound a -> Range 'True 'False a)
-> (a -> Bound a) -> a -> Range 'True 'False a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bound a
forall a. a -> Bound a
InclusiveBound
lbe :: a -> Range 'True 'False a
lbe :: forall a. a -> Range 'True 'False a
lbe = Bound a -> Range 'True 'False a
forall a. Bound a -> Range 'True 'False a
LowerBoundRange (Bound a -> Range 'True 'False a)
-> (a -> Bound a) -> a -> Range 'True 'False a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bound a
forall a. a -> Bound a
ExclusiveBound
ubi :: a -> Range 'False 'True a
ubi :: forall a. a -> Range 'False 'True a
ubi = Bound a -> Range 'False 'True a
forall a. Bound a -> Range 'False 'True a
UpperBoundRange (Bound a -> Range 'False 'True a)
-> (a -> Bound a) -> a -> Range 'False 'True a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bound a
forall a. a -> Bound a
InclusiveBound
ube :: a -> Range 'False 'True a
ube :: forall a. a -> Range 'False 'True a
ube = Bound a -> Range 'False 'True a
forall a. Bound a -> Range 'False 'True a
UpperBoundRange (Bound a -> Range 'False 'True a)
-> (a -> Bound a) -> a -> Range 'False 'True a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bound a
forall a. a -> Bound a
ExclusiveBound
inf :: Range 'False 'False a
inf :: forall a. Range 'False 'False a
inf = Range 'False 'False a
forall a. Range 'False 'False a
InfiniteRange
empty :: Range 'False 'False a
empty :: forall a. Range 'False 'False a
empty = Range 'False 'False a
forall a. Range 'False 'False a
EmptyRange
singleton :: a -> Range 'True 'True a
singleton :: forall a. a -> Range 'True 'True a
singleton = a -> Range 'True 'True a
forall a. a -> Range 'True 'True a
SingletonRange
anyRange :: forall a l h. Range l h a -> AnyRange a
anyRange :: forall a (l :: Bool) (h :: Bool). Range l h a -> AnyRange a
anyRange = Range l h a -> AnyRangeFor AnyRangeConstraint a
forall (c :: (* -> *) -> Constraint) a (hasLowerBound :: Bool)
(hasUpperBound :: Bool).
c (Range hasLowerBound hasUpperBound) =>
Range hasLowerBound hasUpperBound a -> AnyRangeFor c a
AnyRangeFor
anyRangeFor :: forall c a l h. (c (Range l h)) => Range l h a -> AnyRangeFor c a
anyRangeFor :: forall (c :: (* -> *) -> Constraint) a (hasLowerBound :: Bool)
(hasUpperBound :: Bool).
c (Range hasLowerBound hasUpperBound) =>
Range hasLowerBound hasUpperBound a -> AnyRangeFor c a
anyRangeFor = Range l h a -> AnyRangeFor c a
forall (c :: (* -> *) -> Constraint) a (hasLowerBound :: Bool)
(hasUpperBound :: Bool).
c (Range hasLowerBound hasUpperBound) =>
Range hasLowerBound hasUpperBound a -> AnyRangeFor c a
AnyRangeFor
withRange :: (forall l h. (c (Range l h)) => Range l h a -> b) -> AnyRangeFor c a -> b
withRange :: forall (c :: (* -> *) -> Constraint) a b.
(forall (l :: Bool) (h :: Bool). c (Range l h) => Range l h a -> b)
-> AnyRangeFor c a -> b
withRange forall (l :: Bool) (h :: Bool). c (Range l h) => Range l h a -> b
f (AnyRangeFor Range hasLowerBound hasUpperBound a
range) = Range hasLowerBound hasUpperBound a -> b
forall (l :: Bool) (h :: Bool). c (Range l h) => Range l h a -> b
f Range hasLowerBound hasUpperBound a
range