-- |
-- Module       : Data.Interval
-- Copyright    : (c) Melanie Brown 2022
-- License:     : BSD3 (see the file LICENSE)
--
-- Intervals over types and their operations.
module Data.Interval (
  Extremum (..),
  opposite,
  Bound (..),
  unBound,
  Bounding (..),
  compareBounds,
  SomeBound (..),
  unSomeBound,
  oppose,
  Interval (..),
  imap,
  imapLev,
  itraverse,
  itraverseLev,
  pattern (:<->:),
  pattern (:<-|:),
  pattern (:|->:),
  pattern (:|-|:),
  pattern (:---:),
  pattern (:<>:),
  pattern (:<|:),
  pattern (:|>:),
  pattern (:||:),
  pattern Whole,
  (+/-),
  (...),
  bounds,
  lower,
  lowerBound,
  upper,
  upperBound,
  interval,
  imin,
  iinf,
  isup,
  imax,
  hull,
  hulls,
  within,
  point,
  open,
  close,
  openclosed,
  closedopen,
  openLower,
  closedLower,
  openUpper,
  closedUpper,
  setLower,
  setUpper,
  Adjacency (..),
  converseAdjacency,
  adjacency,
  intersect,
  union,
  unions,
  unionsAsc,
  complement,
  difference,
  (\\),
  symmetricDifference,
  measure,
  measuring,
  hausdorff,
  isSubsetOf,
) where

import Algebra.Lattice.Levitated
import Data.Data (Data)
import Data.OneOrTwo (OneOrTwo (..))
import GHC.Show qualified (show)

-- | The kinds of extremum an interval can have.
data Extremum
  = Minimum
  | Infimum
  | Supremum
  | Maximum
  deriving (Extremum -> Extremum -> Bool
(Extremum -> Extremum -> Bool)
-> (Extremum -> Extremum -> Bool) -> Eq Extremum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extremum -> Extremum -> Bool
$c/= :: Extremum -> Extremum -> Bool
== :: Extremum -> Extremum -> Bool
$c== :: Extremum -> Extremum -> Bool
Eq, Eq Extremum
Eq Extremum
-> (Extremum -> Extremum -> Ordering)
-> (Extremum -> Extremum -> Bool)
-> (Extremum -> Extremum -> Bool)
-> (Extremum -> Extremum -> Bool)
-> (Extremum -> Extremum -> Bool)
-> (Extremum -> Extremum -> Extremum)
-> (Extremum -> Extremum -> Extremum)
-> Ord Extremum
Extremum -> Extremum -> Bool
Extremum -> Extremum -> Ordering
Extremum -> Extremum -> Extremum
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Extremum -> Extremum -> Extremum
$cmin :: Extremum -> Extremum -> Extremum
max :: Extremum -> Extremum -> Extremum
$cmax :: Extremum -> Extremum -> Extremum
>= :: Extremum -> Extremum -> Bool
$c>= :: Extremum -> Extremum -> Bool
> :: Extremum -> Extremum -> Bool
$c> :: Extremum -> Extremum -> Bool
<= :: Extremum -> Extremum -> Bool
$c<= :: Extremum -> Extremum -> Bool
< :: Extremum -> Extremum -> Bool
$c< :: Extremum -> Extremum -> Bool
compare :: Extremum -> Extremum -> Ordering
$ccompare :: Extremum -> Extremum -> Ordering
$cp1Ord :: Eq Extremum
Ord, Int -> Extremum
Extremum -> Int
Extremum -> [Extremum]
Extremum -> Extremum
Extremum -> Extremum -> [Extremum]
Extremum -> Extremum -> Extremum -> [Extremum]
(Extremum -> Extremum)
-> (Extremum -> Extremum)
-> (Int -> Extremum)
-> (Extremum -> Int)
-> (Extremum -> [Extremum])
-> (Extremum -> Extremum -> [Extremum])
-> (Extremum -> Extremum -> [Extremum])
-> (Extremum -> Extremum -> Extremum -> [Extremum])
-> Enum Extremum
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Extremum -> Extremum -> Extremum -> [Extremum]
$cenumFromThenTo :: Extremum -> Extremum -> Extremum -> [Extremum]
enumFromTo :: Extremum -> Extremum -> [Extremum]
$cenumFromTo :: Extremum -> Extremum -> [Extremum]
enumFromThen :: Extremum -> Extremum -> [Extremum]
$cenumFromThen :: Extremum -> Extremum -> [Extremum]
enumFrom :: Extremum -> [Extremum]
$cenumFrom :: Extremum -> [Extremum]
fromEnum :: Extremum -> Int
$cfromEnum :: Extremum -> Int
toEnum :: Int -> Extremum
$ctoEnum :: Int -> Extremum
pred :: Extremum -> Extremum
$cpred :: Extremum -> Extremum
succ :: Extremum -> Extremum
$csucc :: Extremum -> Extremum
Enum, Extremum
Extremum -> Extremum -> Bounded Extremum
forall a. a -> a -> Bounded a
maxBound :: Extremum
$cmaxBound :: Extremum
minBound :: Extremum
$cminBound :: Extremum
Bounded, Int -> Extremum -> ShowS
[Extremum] -> ShowS
Extremum -> String
(Int -> Extremum -> ShowS)
-> (Extremum -> String) -> ([Extremum] -> ShowS) -> Show Extremum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extremum] -> ShowS
$cshowList :: [Extremum] -> ShowS
show :: Extremum -> String
$cshow :: Extremum -> String
showsPrec :: Int -> Extremum -> ShowS
$cshowsPrec :: Int -> Extremum -> ShowS
Show, ReadPrec [Extremum]
ReadPrec Extremum
Int -> ReadS Extremum
ReadS [Extremum]
(Int -> ReadS Extremum)
-> ReadS [Extremum]
-> ReadPrec Extremum
-> ReadPrec [Extremum]
-> Read Extremum
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Extremum]
$creadListPrec :: ReadPrec [Extremum]
readPrec :: ReadPrec Extremum
$creadPrec :: ReadPrec Extremum
readList :: ReadS [Extremum]
$creadList :: ReadS [Extremum]
readsPrec :: Int -> ReadS Extremum
$creadsPrec :: Int -> ReadS Extremum
Read, (forall x. Extremum -> Rep Extremum x)
-> (forall x. Rep Extremum x -> Extremum) -> Generic Extremum
forall x. Rep Extremum x -> Extremum
forall x. Extremum -> Rep Extremum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Extremum x -> Extremum
$cfrom :: forall x. Extremum -> Rep Extremum x
Generic, Typeable Extremum
DataType
Constr
Typeable Extremum
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Extremum -> c Extremum)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Extremum)
-> (Extremum -> Constr)
-> (Extremum -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Extremum))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extremum))
-> ((forall b. Data b => b -> b) -> Extremum -> Extremum)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Extremum -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Extremum -> r)
-> (forall u. (forall d. Data d => d -> u) -> Extremum -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Extremum -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Extremum -> m Extremum)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Extremum -> m Extremum)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Extremum -> m Extremum)
-> Data Extremum
Extremum -> DataType
Extremum -> Constr
(forall b. Data b => b -> b) -> Extremum -> Extremum
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extremum -> c Extremum
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extremum
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Extremum -> u
forall u. (forall d. Data d => d -> u) -> Extremum -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Extremum -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Extremum -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Extremum -> m Extremum
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extremum -> m Extremum
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extremum
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extremum -> c Extremum
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Extremum)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extremum)
$cMaximum :: Constr
$cSupremum :: Constr
$cInfimum :: Constr
$cMinimum :: Constr
$tExtremum :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Extremum -> m Extremum
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extremum -> m Extremum
gmapMp :: (forall d. Data d => d -> m d) -> Extremum -> m Extremum
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extremum -> m Extremum
gmapM :: (forall d. Data d => d -> m d) -> Extremum -> m Extremum
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Extremum -> m Extremum
gmapQi :: Int -> (forall d. Data d => d -> u) -> Extremum -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Extremum -> u
gmapQ :: (forall d. Data d => d -> u) -> Extremum -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Extremum -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Extremum -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Extremum -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Extremum -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Extremum -> r
gmapT :: (forall b. Data b => b -> b) -> Extremum -> Extremum
$cgmapT :: (forall b. Data b => b -> b) -> Extremum -> Extremum
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extremum)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extremum)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Extremum)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Extremum)
dataTypeOf :: Extremum -> DataType
$cdataTypeOf :: Extremum -> DataType
toConstr :: Extremum -> Constr
$ctoConstr :: Extremum -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extremum
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extremum
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extremum -> c Extremum
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extremum -> c Extremum
$cp1Data :: Typeable Extremum
Data, Typeable)

-- | The 'opposite' of an extremum is how it would be viewed
-- from the other "direction" of how it is currently.
--
-- c.f. 'opposeBound'.
opposite :: Extremum -> Extremum
opposite :: Extremum -> Extremum
opposite = \case
  Extremum
Minimum -> Extremum
Supremum
  Extremum
Infimum -> Extremum
Maximum
  Extremum
Supremum -> Extremum
Minimum
  Extremum
Maximum -> Extremum
Infimum

-- | A 'Bound' is an endpoint of an 'Interval'.
type Bound :: Extremum -> Type -> Type
data Bound ext x where
  Min :: !x -> Bound Minimum x
  Inf :: !x -> Bound Infimum x
  Sup :: !x -> Bound Supremum x
  Max :: !x -> Bound Maximum x

-- | Extract the term from a 'Bound'.
unBound :: Bound ext x -> x
unBound :: Bound ext x -> x
unBound = \case
  Min x
x -> x
x
  Inf x
x -> x
x
  Sup x
x -> x
x
  Max x
x -> x
x

instance Functor (Bound ext) where
  fmap :: (a -> b) -> Bound ext a -> Bound ext b
fmap a -> b
f = \case
    Min a
x -> b -> Bound 'Minimum b
forall x. x -> Bound 'Minimum x
Min (a -> b
f a
x)
    Inf a
x -> b -> Bound 'Infimum b
forall x. x -> Bound 'Infimum x
Inf (a -> b
f a
x)
    Sup a
x -> b -> Bound 'Supremum b
forall x. x -> Bound 'Supremum x
Sup (a -> b
f a
x)
    Max a
x -> b -> Bound 'Maximum b
forall x. x -> Bound 'Maximum x
Max (a -> b
f a
x)

instance Foldable (Bound ext) where
  foldMap :: (a -> m) -> Bound ext a -> m
foldMap a -> m
f = \case
    Min a
x -> a -> m
f a
x
    Inf a
x -> a -> m
f a
x
    Sup a
x -> a -> m
f a
x
    Max a
x -> a -> m
f a
x

instance Traversable (Bound ext) where
  traverse :: (a -> f b) -> Bound ext a -> f (Bound ext b)
traverse a -> f b
f = \case
    Min a
x -> b -> Bound 'Minimum b
forall x. x -> Bound 'Minimum x
Min (b -> Bound 'Minimum b) -> f b -> f (Bound 'Minimum b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    Inf a
x -> b -> Bound 'Infimum b
forall x. x -> Bound 'Infimum x
Inf (b -> Bound 'Infimum b) -> f b -> f (Bound 'Infimum b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    Sup a
x -> b -> Bound 'Supremum b
forall x. x -> Bound 'Supremum x
Sup (b -> Bound 'Supremum b) -> f b -> f (Bound 'Supremum b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    Max a
x -> b -> Bound 'Maximum b
forall x. x -> Bound 'Maximum x
Max (b -> Bound 'Maximum b) -> f b -> f (Bound 'Maximum b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

instance (Eq x) => Eq (Bound ext x) where
  Min x
x == :: Bound ext x -> Bound ext x -> Bool
== Min x
y = x
x x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
y
  Inf x
x == Inf x
y = x
x x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
y
  Sup x
x == Sup x
y = x
x x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
y
  Max x
x == Max x
y = x
x x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
y

instance (Ord x) => Ord (Bound ext (Levitated x)) where
  compare :: Bound ext (Levitated x) -> Bound ext (Levitated x) -> Ordering
compare = Bound ext (Levitated x) -> Bound ext (Levitated x) -> Ordering
forall x (ext1 :: Extremum) (ext2 :: Extremum).
Ord x =>
Bound ext1 (Levitated x) -> Bound ext2 (Levitated x) -> Ordering
compareBounds

-- | A type class for inverting 'Bound's.
type Bounding :: Extremum -> Constraint
class
  ( Opposite (Opposite ext) ~ ext
  ) =>
  Bounding ext
  where
  type Opposite ext :: Extremum
  bound :: x -> Bound ext x

  -- | c.f. 'opposite'.
  opposeBound :: Bound ext x -> Bound (Opposite ext) x

instance Bounding Minimum where
  type Opposite Minimum = Supremum
  bound :: x -> Bound 'Minimum x
bound = x -> Bound 'Minimum x
forall x. x -> Bound 'Minimum x
Min
  opposeBound :: Bound 'Minimum x -> Bound (Opposite 'Minimum) x
opposeBound (Min x
x) = x -> Bound 'Supremum x
forall x. x -> Bound 'Supremum x
Sup x
x

instance Bounding Infimum where
  type Opposite Infimum = Maximum
  bound :: x -> Bound 'Infimum x
bound = x -> Bound 'Infimum x
forall x. x -> Bound 'Infimum x
Inf
  opposeBound :: Bound 'Infimum x -> Bound (Opposite 'Infimum) x
opposeBound (Inf x
x) = x -> Bound 'Maximum x
forall x. x -> Bound 'Maximum x
Max x
x

instance Bounding Supremum where
  type Opposite Supremum = Minimum
  bound :: x -> Bound 'Supremum x
bound = x -> Bound 'Supremum x
forall x. x -> Bound 'Supremum x
Sup
  opposeBound :: Bound 'Supremum x -> Bound (Opposite 'Supremum) x
opposeBound (Sup x
x) = x -> Bound 'Minimum x
forall x. x -> Bound 'Minimum x
Min x
x

instance Bounding Maximum where
  type Opposite Maximum = Infimum
  bound :: x -> Bound 'Maximum x
bound = x -> Bound 'Maximum x
forall x. x -> Bound 'Maximum x
Max
  opposeBound :: Bound 'Maximum x -> Bound (Opposite 'Maximum) x
opposeBound (Max x
x) = x -> Bound 'Infimum x
forall x. x -> Bound 'Infimum x
Inf x
x

-- | 'Bound's have special comparison rules for identical points.
--
-- - minima are lesser than infima
-- - suprema are lesser than maxima
-- - infima and minima are both lesser than suprema and maxima
compareBounds ::
  (Ord x) =>
  Bound ext1 (Levitated x) ->
  Bound ext2 (Levitated x) ->
  Ordering
compareBounds :: Bound ext1 (Levitated x) -> Bound ext2 (Levitated x) -> Ordering
compareBounds (Min Levitated x
l) = \case
  Min Levitated x
ll -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
ll
  Inf Levitated x
ll -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
ll Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
LT
  Sup Levitated x
u -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
u Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
GT
  Max Levitated x
u -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
u
compareBounds (Inf Levitated x
l) = \case
  Min Levitated x
ll -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
ll Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
GT
  Inf Levitated x
ll -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
ll
  Sup Levitated x
u -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
u Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
GT
  Max Levitated x
u -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
u Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
GT
compareBounds (Sup Levitated x
u) = \case
  Min Levitated x
l -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
u Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
LT
  Inf Levitated x
l -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
u Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
LT
  Sup Levitated x
uu -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
u Levitated x
uu
  Max Levitated x
uu -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
u Levitated x
uu Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
LT
compareBounds (Max Levitated x
u) = \case
  Min Levitated x
l -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
u
  Inf Levitated x
l -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
l Levitated x
u Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
LT
  Sup Levitated x
uu -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
u Levitated x
uu Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
GT
  Max Levitated x
uu -> Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
u Levitated x
uu

data SomeBound x
  = forall ext.
    (Bounding ext, Bounding (Opposite ext)) =>
    SomeBound !(Bound ext x)

instance (Eq x) => Eq (SomeBound (Levitated x)) where
  SomeBound (Min Levitated x
a) == :: SomeBound (Levitated x) -> SomeBound (Levitated x) -> Bool
== SomeBound (Min Levitated x
b) = Levitated x
a Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== Levitated x
b
  SomeBound (Max Levitated x
a) == SomeBound (Max Levitated x
b) = Levitated x
a Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== Levitated x
b
  SomeBound (Inf Levitated x
a) == SomeBound (Inf Levitated x
b) = Levitated x
a Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== Levitated x
b
  SomeBound (Sup Levitated x
a) == SomeBound (Sup Levitated x
b) = Levitated x
a Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== Levitated x
b
  SomeBound (Levitated x)
_ == SomeBound (Levitated x)
_ = Bool
False

instance (Ord x) => Ord (SomeBound (Levitated x)) where
  SomeBound Bound ext (Levitated x)
b0 compare :: SomeBound (Levitated x) -> SomeBound (Levitated x) -> Ordering
`compare` SomeBound Bound ext (Levitated x)
b1 = Bound ext (Levitated x) -> Bound ext (Levitated x) -> Ordering
forall x (ext1 :: Extremum) (ext2 :: Extremum).
Ord x =>
Bound ext1 (Levitated x) -> Bound ext2 (Levitated x) -> Ordering
compareBounds Bound ext (Levitated x)
b0 Bound ext (Levitated x)
b1

oppose :: SomeBound x -> SomeBound x
oppose :: SomeBound x -> SomeBound x
oppose (SomeBound Bound ext x
b) = Bound (Opposite ext) x -> SomeBound x
forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound (Bound ext x -> Bound (Opposite ext) x
forall (ext :: Extremum) x.
Bounding ext =>
Bound ext x -> Bound (Opposite ext) x
opposeBound Bound ext x
b)

unSomeBound :: (Ord x) => SomeBound x -> x
unSomeBound :: SomeBound x -> x
unSomeBound (SomeBound Bound ext x
b) = Bound ext x -> x
forall (ext :: Extremum) x. Bound ext x -> x
unBound Bound ext x
b

infix 5 :<-->:

infix 5 :<--|:

infix 5 :|-->:

infix 5 :|--|:

type Interval :: Type -> Type
data Interval x where
  -- Open-open interval. You probably want '(:<->:)' or '(:<>:)'.
  (:<-->:) ::
    (Ord x) =>
    !(Bound Infimum (Levitated x)) ->
    !(Bound Supremum (Levitated x)) ->
    Interval x
  -- Open-closed interval. You probably want '(:<-|:)' or '(:<|:)'.
  (:<--|:) ::
    (Ord x) =>
    !(Bound Infimum (Levitated x)) ->
    !(Bound Maximum (Levitated x)) ->
    Interval x
  -- Closed-open interval. You probably want '(:|->:)' or '(:|>:)'.
  (:|-->:) ::
    (Ord x) =>
    !(Bound Minimum (Levitated x)) ->
    !(Bound Supremum (Levitated x)) ->
    Interval x
  -- Closed-closed interval. You probably want '(:|-|:)' or '(:||:)'.
  (:|--|:) ::
    (Ord x) =>
    !(Bound Minimum (Levitated x)) ->
    !(Bound Maximum (Levitated x)) ->
    Interval x

deriving instance (Ord x) => Eq (Interval x)

instance (Ord x, Show x) => Show (Interval x) where
  show :: Interval x -> String
show = \case
    Levitated x
l :<->: Levitated x
u -> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Levitated x -> String
forall b a. (Show a, IsString b) => a -> b
show Levitated x
l String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :<->: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Levitated x -> String
forall b a. (Show a, IsString b) => a -> b
show Levitated x
u String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
    Levitated x
l :|->: Levitated x
u -> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Levitated x -> String
forall b a. (Show a, IsString b) => a -> b
show Levitated x
l String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :|->: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Levitated x -> String
forall b a. (Show a, IsString b) => a -> b
show Levitated x
u String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
    Levitated x
l :<-|: Levitated x
u -> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Levitated x -> String
forall b a. (Show a, IsString b) => a -> b
show Levitated x
l String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :<-|: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Levitated x -> String
forall b a. (Show a, IsString b) => a -> b
show Levitated x
u String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
    Levitated x
l :|-|: Levitated x
u -> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Levitated x -> String
forall b a. (Show a, IsString b) => a -> b
show Levitated x
l String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :|-|: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Levitated x -> String
forall b a. (Show a, IsString b) => a -> b
show Levitated x
u String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

instance (Ord x) => Ord (Interval x) where
  compare :: Interval x -> Interval x -> Ordering
compare Interval x
i1 Interval x
i2 = (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Ordering)
-> (Interval x -> SomeBound (Levitated x))
-> Interval x
-> Interval x
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on SomeBound (Levitated x) -> SomeBound (Levitated x) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i1 Interval x
i2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Ordering)
-> (Interval x -> SomeBound (Levitated x))
-> Interval x
-> Interval x
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on SomeBound (Levitated x) -> SomeBound (Levitated x) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
i1 Interval x
i2

-- | Since the 'Ord' constraints on the constructors for 'Interval'
-- prevent it from being a 'Functor', this will have to suffice.
imap :: (Ord x, Ord y) => (x -> y) -> Interval x -> Interval y
imap :: (x -> y) -> Interval x -> Interval y
imap x -> y
f = \case
  Levitated x
l :<->: Levitated x
u -> (x -> y) -> Levitated x -> Levitated y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
l Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: (x -> y) -> Levitated x -> Levitated y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
u
  Levitated x
l :|->: Levitated x
u -> (x -> y) -> Levitated x -> Levitated y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
l Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: (x -> y) -> Levitated x -> Levitated y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
u
  Levitated x
l :<-|: Levitated x
u -> (x -> y) -> Levitated x -> Levitated y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
l Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: (x -> y) -> Levitated x -> Levitated y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
u
  Levitated x
l :|-|: Levitated x
u -> (x -> y) -> Levitated x -> Levitated y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
l Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: (x -> y) -> Levitated x -> Levitated y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
u

-- | Same as 'imap' but on the 'Levitated' of the underlying type.
imapLev ::
  (Ord x, Ord y) =>
  (Levitated x -> Levitated y) ->
  Interval x ->
  Interval y
imapLev :: (Levitated x -> Levitated y) -> Interval x -> Interval y
imapLev Levitated x -> Levitated y
f = \case
  Levitated x
l :<->: Levitated x
u -> Levitated x -> Levitated y
f Levitated x
l Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x -> Levitated y
f Levitated x
u
  Levitated x
l :|->: Levitated x
u -> Levitated x -> Levitated y
f Levitated x
l Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x -> Levitated y
f Levitated x
u
  Levitated x
l :<-|: Levitated x
u -> Levitated x -> Levitated y
f Levitated x
l Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x -> Levitated y
f Levitated x
u
  Levitated x
l :|-|: Levitated x
u -> Levitated x -> Levitated y
f Levitated x
l Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x -> Levitated y
f Levitated x
u

-- | Since the 'Ord' constraints on the constructors for 'Interval'
-- prevent it from being 'Traversable', this will have to suffice.
itraverse ::
  (Ord x, Ord y, Applicative f) =>
  (x -> f y) ->
  Interval x ->
  f (Interval y)
itraverse :: (x -> f y) -> Interval x -> f (Interval y)
itraverse x -> f y
f = \case
  Levitated x
l :<->: Levitated x
u -> (Levitated y -> Levitated y -> Interval y)
-> f (Levitated y) -> f (Levitated y) -> f (Interval y)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<->:) ((x -> f y) -> Levitated x -> f (Levitated y)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse x -> f y
f Levitated x
l) ((x -> f y) -> Levitated x -> f (Levitated y)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse x -> f y
f Levitated x
u)
  Levitated x
l :|->: Levitated x
u -> (Levitated y -> Levitated y -> Interval y)
-> f (Levitated y) -> f (Levitated y) -> f (Interval y)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|->:) ((x -> f y) -> Levitated x -> f (Levitated y)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse x -> f y
f Levitated x
l) ((x -> f y) -> Levitated x -> f (Levitated y)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse x -> f y
f Levitated x
u)
  Levitated x
l :<-|: Levitated x
u -> (Levitated y -> Levitated y -> Interval y)
-> f (Levitated y) -> f (Levitated y) -> f (Interval y)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<-|:) ((x -> f y) -> Levitated x -> f (Levitated y)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse x -> f y
f Levitated x
l) ((x -> f y) -> Levitated x -> f (Levitated y)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse x -> f y
f Levitated x
u)
  Levitated x
l :|-|: Levitated x
u -> (Levitated y -> Levitated y -> Interval y)
-> f (Levitated y) -> f (Levitated y) -> f (Interval y)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|-|:) ((x -> f y) -> Levitated x -> f (Levitated y)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse x -> f y
f Levitated x
l) ((x -> f y) -> Levitated x -> f (Levitated y)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse x -> f y
f Levitated x
u)

-- | Same as 'itraverse' but on the 'Levitated' of the underlying type.
itraverseLev ::
  (Ord x, Ord y, Applicative f) =>
  (Levitated x -> f (Levitated y)) ->
  Interval x ->
  f (Interval y)
itraverseLev :: (Levitated x -> f (Levitated y)) -> Interval x -> f (Interval y)
itraverseLev Levitated x -> f (Levitated y)
f = \case
  Levitated x
l :<->: Levitated x
u -> (Levitated y -> Levitated y -> Interval y)
-> f (Levitated y) -> f (Levitated y) -> f (Interval y)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<->:) (Levitated x -> f (Levitated y)
f Levitated x
l) (Levitated x -> f (Levitated y)
f Levitated x
u)
  Levitated x
l :|->: Levitated x
u -> (Levitated y -> Levitated y -> Interval y)
-> f (Levitated y) -> f (Levitated y) -> f (Interval y)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|->:) (Levitated x -> f (Levitated y)
f Levitated x
l) (Levitated x -> f (Levitated y)
f Levitated x
u)
  Levitated x
l :<-|: Levitated x
u -> (Levitated y -> Levitated y -> Interval y)
-> f (Levitated y) -> f (Levitated y) -> f (Interval y)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<-|:) (Levitated x -> f (Levitated y)
f Levitated x
l) (Levitated x -> f (Levitated y)
f Levitated x
u)
  Levitated x
l :|-|: Levitated x
u -> (Levitated y -> Levitated y -> Interval y)
-> f (Levitated y) -> f (Levitated y) -> f (Interval y)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Levitated y -> Levitated y -> Interval y
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|-|:) (Levitated x -> f (Levitated y)
f Levitated x
l) (Levitated x -> f (Levitated y)
f Levitated x
u)

infix 5 :<->:

infix 5 :<-|:

infix 5 :|->:

infix 5 :|-|:

-- | A pattern synonym matching open intervals.
pattern (:<->:) :: (Ord x) => Levitated x -> Levitated x -> Interval x
pattern l $b:<->: :: Levitated x -> Levitated x -> Interval x
$m:<->: :: forall r x.
Ord x =>
Interval x
-> (Levitated x -> Levitated x -> r) -> (Void# -> r) -> r
:<->: u <-
  Inf l :<-->: Sup u
  where
    Levitated x
b1 :<->: Levitated x
b2 =
      let inf :: Levitated x
inf = Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
min Levitated x
b1 Levitated x
b2
          sup :: Levitated x
sup = Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
max Levitated x
b1 Levitated x
b2
       in case Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
b1 Levitated x
b2 of
            Ordering
EQ -> Levitated x -> Bound 'Minimum (Levitated x)
forall x. x -> Bound 'Minimum x
Min Levitated x
inf Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:|--|: Levitated x -> Bound 'Maximum (Levitated x)
forall x. x -> Bound 'Maximum x
Max Levitated x
sup
            Ordering
_ -> Levitated x -> Bound 'Infimum (Levitated x)
forall x. x -> Bound 'Infimum x
Inf Levitated x
inf Bound 'Infimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Infimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
:<-->: Levitated x -> Bound 'Supremum (Levitated x)
forall x. x -> Bound 'Supremum x
Sup Levitated x
sup

-- | A pattern synonym matching open-closed intervals.
pattern (:<-|:) :: (Ord x) => Levitated x -> Levitated x -> Interval x
pattern l $b:<-|: :: Levitated x -> Levitated x -> Interval x
$m:<-|: :: forall r x.
Ord x =>
Interval x
-> (Levitated x -> Levitated x -> r) -> (Void# -> r) -> r
:<-|: u <-
  Inf l :<--|: Max u
  where
    Levitated x
b1 :<-|: Levitated x
b2 =
      let inf :: Levitated x
inf = Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
min Levitated x
b1 Levitated x
b2
          sup :: Levitated x
sup = Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
max Levitated x
b1 Levitated x
b2
       in case Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
b1 Levitated x
b2 of
            Ordering
LT -> Levitated x -> Bound 'Infimum (Levitated x)
forall x. x -> Bound 'Infimum x
Inf Levitated x
inf Bound 'Infimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Infimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:<--|: Levitated x -> Bound 'Maximum (Levitated x)
forall x. x -> Bound 'Maximum x
Max Levitated x
sup
            Ordering
EQ -> Levitated x -> Bound 'Minimum (Levitated x)
forall x. x -> Bound 'Minimum x
Min Levitated x
inf Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:|--|: Levitated x -> Bound 'Maximum (Levitated x)
forall x. x -> Bound 'Maximum x
Max Levitated x
sup
            Ordering
GT -> Levitated x -> Bound 'Minimum (Levitated x)
forall x. x -> Bound 'Minimum x
Min Levitated x
inf Bound 'Minimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
:|-->: Levitated x -> Bound 'Supremum (Levitated x)
forall x. x -> Bound 'Supremum x
Sup Levitated x
sup

-- | A pattern synonym matching closed-open intervals.
pattern (:|->:) :: (Ord x) => Levitated x -> Levitated x -> Interval x
pattern l $b:|->: :: Levitated x -> Levitated x -> Interval x
$m:|->: :: forall r x.
Ord x =>
Interval x
-> (Levitated x -> Levitated x -> r) -> (Void# -> r) -> r
:|->: u <-
  Min l :|-->: Sup u
  where
    Levitated x
b1 :|->: Levitated x
b2 =
      let inf :: Levitated x
inf = Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
min Levitated x
b1 Levitated x
b2
          sup :: Levitated x
sup = Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
max Levitated x
b1 Levitated x
b2
       in case Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
b1 Levitated x
b2 of
            Ordering
LT -> Levitated x -> Bound 'Minimum (Levitated x)
forall x. x -> Bound 'Minimum x
Min Levitated x
inf Bound 'Minimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
:|-->: Levitated x -> Bound 'Supremum (Levitated x)
forall x. x -> Bound 'Supremum x
Sup Levitated x
sup
            Ordering
EQ -> Levitated x -> Bound 'Minimum (Levitated x)
forall x. x -> Bound 'Minimum x
Min Levitated x
inf Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:|--|: Levitated x -> Bound 'Maximum (Levitated x)
forall x. x -> Bound 'Maximum x
Max Levitated x
sup
            Ordering
GT -> Levitated x -> Bound 'Infimum (Levitated x)
forall x. x -> Bound 'Infimum x
Inf Levitated x
inf Bound 'Infimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Infimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:<--|: Levitated x -> Bound 'Maximum (Levitated x)
forall x. x -> Bound 'Maximum x
Max Levitated x
sup

-- | A pattern synonym matching closed intervals.
pattern (:|-|:) :: (Ord x) => Levitated x -> Levitated x -> Interval x
pattern l $b:|-|: :: Levitated x -> Levitated x -> Interval x
$m:|-|: :: forall r x.
Ord x =>
Interval x
-> (Levitated x -> Levitated x -> r) -> (Void# -> r) -> r
:|-|: u <-
  Min l :|--|: Max u
  where
    Levitated x
b1 :|-|: Levitated x
b2 = Levitated x -> Bound 'Minimum (Levitated x)
forall x. x -> Bound 'Minimum x
Min (Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
min Levitated x
b1 Levitated x
b2) Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:|--|: Levitated x -> Bound 'Maximum (Levitated x)
forall x. x -> Bound 'Maximum x
Max (Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
max Levitated x
b1 Levitated x
b2)

{-# COMPLETE (:<->:), (:<-|:), (:|->:), (:|-|:) #-}

pattern (:---:) :: forall x. (Ord x) => Levitated x -> Levitated x -> Interval x
pattern l $m:---: :: forall r x.
Ord x =>
Interval x
-> (Levitated x -> Levitated x -> r) -> (Void# -> r) -> r
:---: u <- (bounds -> (SomeBound (unBound -> l), SomeBound (unBound -> u)))

{-# COMPLETE (:---:) #-}

infix 5 :<>:

infix 5 :<|:

infix 5 :|>:

infix 5 :||:

-- | A pattern synonym matching finite open intervals.
pattern (:<>:) :: forall x. (Ord x) => x -> x -> Interval x
pattern l $b:<>: :: x -> x -> Interval x
$m:<>: :: forall r x.
Ord x =>
Interval x -> (x -> x -> r) -> (Void# -> r) -> r
:<>: u <- -- Levitate l :<->: Levitate u
  Levitate l :<->: Levitate u
  where
    x
b1 :<>: x
b2 =
      let inf :: Levitated x
inf = x -> Levitated x
forall a. a -> Levitated a
Levitate (x -> x -> x
forall a. Ord a => a -> a -> a
min x
b1 x
b2)
          sup :: Levitated x
sup = x -> Levitated x
forall a. a -> Levitated a
Levitate (x -> x -> x
forall a. Ord a => a -> a -> a
max x
b1 x
b2)
       in case Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
inf Levitated x
sup of
            Ordering
EQ -> Levitated x -> Bound 'Minimum (Levitated x)
forall x. x -> Bound 'Minimum x
Min Levitated x
inf Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:|--|: Levitated x -> Bound 'Maximum (Levitated x)
forall x. x -> Bound 'Maximum x
Max Levitated x
sup
            Ordering
_ -> Levitated x -> Bound 'Infimum (Levitated x)
forall x. x -> Bound 'Infimum x
Inf Levitated x
inf Bound 'Infimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Infimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
:<-->: Levitated x -> Bound 'Supremum (Levitated x)
forall x. x -> Bound 'Supremum x
Sup Levitated x
sup

-- | A pattern synonym matching finite open-closed intervals.
pattern (:<|:) :: forall x. (Ord x) => x -> x -> Interval x
pattern l $b:<|: :: x -> x -> Interval x
$m:<|: :: forall r x.
Ord x =>
Interval x -> (x -> x -> r) -> (Void# -> r) -> r
:<|: u <- -- Levitate l :<-|: Levitate u
  Levitate l :<-|: Levitate u
  where
    x
b1 :<|: x
b2 =
      let inf :: Levitated x
inf = x -> Levitated x
forall a. a -> Levitated a
Levitate (x -> x -> x
forall a. Ord a => a -> a -> a
min x
b1 x
b2)
          sup :: Levitated x
sup = x -> Levitated x
forall a. a -> Levitated a
Levitate (x -> x -> x
forall a. Ord a => a -> a -> a
max x
b1 x
b2)
       in case Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
inf Levitated x
sup of
            Ordering
EQ -> Levitated x -> Bound 'Minimum (Levitated x)
forall x. x -> Bound 'Minimum x
Min Levitated x
inf Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:|--|: Levitated x -> Bound 'Maximum (Levitated x)
forall x. x -> Bound 'Maximum x
Max Levitated x
sup
            Ordering
_ -> Levitated x -> Bound 'Infimum (Levitated x)
forall x. x -> Bound 'Infimum x
Inf Levitated x
inf Bound 'Infimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Infimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:<--|: Levitated x -> Bound 'Maximum (Levitated x)
forall x. x -> Bound 'Maximum x
Max Levitated x
sup

-- | A pattern synonym matching finite closed-open intervals.
pattern (:|>:) :: forall x. (Ord x) => x -> x -> Interval x
pattern l $b:|>: :: x -> x -> Interval x
$m:|>: :: forall r x.
Ord x =>
Interval x -> (x -> x -> r) -> (Void# -> r) -> r
:|>: u <- -- Levitate l :|->: Levitate u
  Levitate l :|->: Levitate u
  where
    x
b1 :|>: x
b2 =
      let inf :: Levitated x
inf = x -> Levitated x
forall a. a -> Levitated a
Levitate (x -> x -> x
forall a. Ord a => a -> a -> a
min x
b1 x
b2)
          sup :: Levitated x
sup = x -> Levitated x
forall a. a -> Levitated a
Levitate (x -> x -> x
forall a. Ord a => a -> a -> a
max x
b1 x
b2)
       in case Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Levitated x
inf Levitated x
sup of
            Ordering
EQ -> Levitated x -> Bound 'Minimum (Levitated x)
forall x. x -> Bound 'Minimum x
Min Levitated x
inf Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:|--|: Levitated x -> Bound 'Maximum (Levitated x)
forall x. x -> Bound 'Maximum x
Max Levitated x
sup
            Ordering
_ -> Levitated x -> Bound 'Minimum (Levitated x)
forall x. x -> Bound 'Minimum x
Min Levitated x
inf Bound 'Minimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
:|-->: Levitated x -> Bound 'Supremum (Levitated x)
forall x. x -> Bound 'Supremum x
Sup Levitated x
sup

-- | A pattern synonym matching finite closed intervals.
pattern (:||:) :: forall x. (Ord x) => x -> x -> Interval x
pattern l $b:||: :: x -> x -> Interval x
$m:||: :: forall r x.
Ord x =>
Interval x -> (x -> x -> r) -> (Void# -> r) -> r
:||: u <- -- Levitate l :|-|: Levitate u
  Levitate l :|-|: Levitate u
  where
    x
b1 :||: x
b2 = Levitated x -> Bound 'Minimum (Levitated x)
forall x. x -> Bound 'Minimum x
Min (x -> Levitated x
forall a. a -> Levitated a
Levitate (x -> Levitated x) -> x -> Levitated x
forall a b. (a -> b) -> a -> b
$ x -> x -> x
forall a. Ord a => a -> a -> a
min x
b1 x
b2) Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:|--|: Levitated x -> Bound 'Maximum (Levitated x)
forall x. x -> Bound 'Maximum x
Max (x -> Levitated x
forall a. a -> Levitated a
Levitate (x -> Levitated x) -> x -> Levitated x
forall a b. (a -> b) -> a -> b
$ x -> x -> x
forall a. Ord a => a -> a -> a
max x
b1 x
b2)

-- | The whole interval.
pattern Whole :: (Ord x) => Interval x
pattern $bWhole :: Interval x
$mWhole :: forall r x.
Ord x =>
Interval x -> (Void# -> r) -> (Void# -> r) -> r
Whole = Bottom :|-|: Top

-- | Get the @(lower, upper)@ 'bounds' of an 'Interval'.
--
-- c.f. 'lower', 'upper'.
bounds :: Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
bounds :: Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
bounds = \case
  Bound 'Infimum (Levitated x)
l :<-->: Bound 'Supremum (Levitated x)
u -> (Bound 'Infimum (Levitated x) -> SomeBound (Levitated x)
forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Infimum (Levitated x)
l, Bound 'Supremum (Levitated x) -> SomeBound (Levitated x)
forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Supremum (Levitated x)
u)
  Bound 'Infimum (Levitated x)
l :<--|: Bound 'Maximum (Levitated x)
u -> (Bound 'Infimum (Levitated x) -> SomeBound (Levitated x)
forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Infimum (Levitated x)
l, Bound 'Maximum (Levitated x) -> SomeBound (Levitated x)
forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Maximum (Levitated x)
u)
  Bound 'Minimum (Levitated x)
l :|-->: Bound 'Supremum (Levitated x)
u -> (Bound 'Minimum (Levitated x) -> SomeBound (Levitated x)
forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Minimum (Levitated x)
l, Bound 'Supremum (Levitated x) -> SomeBound (Levitated x)
forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Supremum (Levitated x)
u)
  Bound 'Minimum (Levitated x)
l :|--|: Bound 'Maximum (Levitated x)
u -> (Bound 'Minimum (Levitated x) -> SomeBound (Levitated x)
forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Minimum (Levitated x)
l, Bound 'Maximum (Levitated x) -> SomeBound (Levitated x)
forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Maximum (Levitated x)
u)

-- | Get the lower bound of an interval.
--
-- > lower = fst . bounds
lower :: (Ord x) => Interval x -> SomeBound (Levitated x)
lower :: Interval x -> SomeBound (Levitated x)
lower = (SomeBound (Levitated x), SomeBound (Levitated x))
-> SomeBound (Levitated x)
forall a b. (a, b) -> a
fst ((SomeBound (Levitated x), SomeBound (Levitated x))
 -> SomeBound (Levitated x))
-> (Interval x
    -> (SomeBound (Levitated x), SomeBound (Levitated x)))
-> Interval x
-> SomeBound (Levitated x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
forall x.
Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
bounds

-- | Get the upper bound of an interval.
--
-- > upper = snd . bounds
upper :: (Ord x) => Interval x -> SomeBound (Levitated x)
upper :: Interval x -> SomeBound (Levitated x)
upper = (SomeBound (Levitated x), SomeBound (Levitated x))
-> SomeBound (Levitated x)
forall a b. (a, b) -> b
snd ((SomeBound (Levitated x), SomeBound (Levitated x))
 -> SomeBound (Levitated x))
-> (Interval x
    -> (SomeBound (Levitated x), SomeBound (Levitated x)))
-> Interval x
-> SomeBound (Levitated x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
forall x.
Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
bounds

-- | Get the lower bound of an interval
-- (with the bound expressed at the term level).
lowerBound :: (Ord x) => Interval x -> (Levitated x, Extremum)
lowerBound :: Interval x -> (Levitated x, Extremum)
lowerBound = \case
  Levitated x
l :<->: Levitated x
_ -> (Levitated x
l, Extremum
Infimum)
  Levitated x
l :<-|: Levitated x
_ -> (Levitated x
l, Extremum
Infimum)
  Levitated x
l :|->: Levitated x
_ -> (Levitated x
l, Extremum
Minimum)
  Levitated x
l :|-|: Levitated x
_ -> (Levitated x
l, Extremum
Minimum)

-- | Get the upper bound of an interval
-- (with the bound expressed at the term level).
upperBound :: (Ord x) => Interval x -> (Levitated x, Extremum)
upperBound :: Interval x -> (Levitated x, Extremum)
upperBound = \case
  Levitated x
_ :<->: Levitated x
u -> (Levitated x
u, Extremum
Supremum)
  Levitated x
_ :<-|: Levitated x
u -> (Levitated x
u, Extremum
Maximum)
  Levitated x
_ :|->: Levitated x
u -> (Levitated x
u, Extremum
Supremum)
  Levitated x
_ :|-|: Levitated x
u -> (Levitated x
u, Extremum
Maximum)

-- | Given 'SomeBound's, try to make an interval.
interval ::
  (Ord x) =>
  SomeBound (Levitated x) ->
  SomeBound (Levitated x) ->
  Interval x
interval :: SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound Bound ext (Levitated x)
b1) (SomeBound Bound ext (Levitated x)
b2) = case (Bound ext (Levitated x)
b1, Bound ext (Levitated x)
b2) of
  (Min Levitated x
l, Sup Levitated x
u) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  (Min Levitated x
l, Max Levitated x
u) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  (Inf Levitated x
l, Sup Levitated x
u) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  (Inf Levitated x
l, Max Levitated x
u) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  (Sup Levitated x
u, Min Levitated x
l) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  (Sup Levitated x
u, Inf Levitated x
l) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  (Max Levitated x
u, Min Levitated x
l) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  (Max Levitated x
u, Inf Levitated x
l) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  (Bound ext (Levitated x), Bound ext (Levitated x))
_ -> Text -> Interval x
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"cannot make an interval with the given bounds"

-- | Given limits and 'Extremum's, try to make an interval.
(...) ::
  (Ord x) =>
  (Levitated x, Extremum) ->
  (Levitated x, Extremum) ->
  Interval x
(Levitated x
x, Extremum
b1) ... :: (Levitated x, Extremum) -> (Levitated x, Extremum) -> Interval x
... (Levitated x
y, Extremum
b2) = case (Extremum
b1, Extremum
b2) of
  (Extremum
Minimum, Extremum
Supremum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  (Extremum
Minimum, Extremum
Maximum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  (Extremum
Infimum, Extremum
Supremum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  (Extremum
Infimum, Extremum
Maximum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  (Extremum
Supremum, Extremum
Minimum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  (Extremum
Supremum, Extremum
Infimum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  (Extremum
Maximum, Extremum
Minimum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  (Extremum
Maximum, Extremum
Infimum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  (Extremum, Extremum)
_ -> Text -> Interval x
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"cannot make an interval with the given bounds"
 where
  l :: Levitated x
l = Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
min Levitated x
x Levitated x
y
  u :: Levitated x
u = Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
max Levitated x
x Levitated x
y

-- | According to
-- [Allen](https://en.wikipedia.org/wiki/Allen%27s_interval_algebra),
-- two intervals can be "adjacent" in 13 different ways,
-- into at most 3 distinct intervals. In this package,
-- this quality is called the 'Adjacency' of the intervals.
data Adjacency x
  = Before !(Interval x) !(Interval x)
  | Meets !(Interval x) !(Interval x) !(Interval x)
  | Overlaps !(Interval x) !(Interval x) !(Interval x)
  | Starts !(Interval x) !(Interval x)
  | During !(Interval x) !(Interval x) !(Interval x)
  | Finishes !(Interval x) !(Interval x)
  | Identical !(Interval x)
  | FinishedBy !(Interval x) !(Interval x)
  | Contains !(Interval x) !(Interval x) !(Interval x)
  | StartedBy !(Interval x) !(Interval x)
  | OverlappedBy !(Interval x) !(Interval x) !(Interval x)
  | MetBy !(Interval x) !(Interval x) !(Interval x)
  | After !(Interval x) !(Interval x)
  deriving (Adjacency x -> Adjacency x -> Bool
(Adjacency x -> Adjacency x -> Bool)
-> (Adjacency x -> Adjacency x -> Bool) -> Eq (Adjacency x)
forall x. Ord x => Adjacency x -> Adjacency x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Adjacency x -> Adjacency x -> Bool
$c/= :: forall x. Ord x => Adjacency x -> Adjacency x -> Bool
== :: Adjacency x -> Adjacency x -> Bool
$c== :: forall x. Ord x => Adjacency x -> Adjacency x -> Bool
Eq, Eq (Adjacency x)
Eq (Adjacency x)
-> (Adjacency x -> Adjacency x -> Ordering)
-> (Adjacency x -> Adjacency x -> Bool)
-> (Adjacency x -> Adjacency x -> Bool)
-> (Adjacency x -> Adjacency x -> Bool)
-> (Adjacency x -> Adjacency x -> Bool)
-> (Adjacency x -> Adjacency x -> Adjacency x)
-> (Adjacency x -> Adjacency x -> Adjacency x)
-> Ord (Adjacency x)
Adjacency x -> Adjacency x -> Bool
Adjacency x -> Adjacency x -> Ordering
Adjacency x -> Adjacency x -> Adjacency x
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x. Ord x => Eq (Adjacency x)
forall x. Ord x => Adjacency x -> Adjacency x -> Bool
forall x. Ord x => Adjacency x -> Adjacency x -> Ordering
forall x. Ord x => Adjacency x -> Adjacency x -> Adjacency x
min :: Adjacency x -> Adjacency x -> Adjacency x
$cmin :: forall x. Ord x => Adjacency x -> Adjacency x -> Adjacency x
max :: Adjacency x -> Adjacency x -> Adjacency x
$cmax :: forall x. Ord x => Adjacency x -> Adjacency x -> Adjacency x
>= :: Adjacency x -> Adjacency x -> Bool
$c>= :: forall x. Ord x => Adjacency x -> Adjacency x -> Bool
> :: Adjacency x -> Adjacency x -> Bool
$c> :: forall x. Ord x => Adjacency x -> Adjacency x -> Bool
<= :: Adjacency x -> Adjacency x -> Bool
$c<= :: forall x. Ord x => Adjacency x -> Adjacency x -> Bool
< :: Adjacency x -> Adjacency x -> Bool
$c< :: forall x. Ord x => Adjacency x -> Adjacency x -> Bool
compare :: Adjacency x -> Adjacency x -> Ordering
$ccompare :: forall x. Ord x => Adjacency x -> Adjacency x -> Ordering
$cp1Ord :: forall x. Ord x => Eq (Adjacency x)
Ord, Int -> Adjacency x -> ShowS
[Adjacency x] -> ShowS
Adjacency x -> String
(Int -> Adjacency x -> ShowS)
-> (Adjacency x -> String)
-> ([Adjacency x] -> ShowS)
-> Show (Adjacency x)
forall x. (Ord x, Show x) => Int -> Adjacency x -> ShowS
forall x. (Ord x, Show x) => [Adjacency x] -> ShowS
forall x. (Ord x, Show x) => Adjacency x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Adjacency x] -> ShowS
$cshowList :: forall x. (Ord x, Show x) => [Adjacency x] -> ShowS
show :: Adjacency x -> String
$cshow :: forall x. (Ord x, Show x) => Adjacency x -> String
showsPrec :: Int -> Adjacency x -> ShowS
$cshowsPrec :: forall x. (Ord x, Show x) => Int -> Adjacency x -> ShowS
Show, (forall x. Adjacency x -> Rep (Adjacency x) x)
-> (forall x. Rep (Adjacency x) x -> Adjacency x)
-> Generic (Adjacency x)
forall x. Rep (Adjacency x) x -> Adjacency x
forall x. Adjacency x -> Rep (Adjacency x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (Adjacency x) x -> Adjacency x
forall x x. Adjacency x -> Rep (Adjacency x) x
$cto :: forall x x. Rep (Adjacency x) x -> Adjacency x
$cfrom :: forall x x. Adjacency x -> Rep (Adjacency x) x
Generic, Typeable)

-- | The result of having compared the same two intervals in reverse order.
converseAdjacency :: Adjacency x -> Adjacency x
converseAdjacency :: Adjacency x -> Adjacency x
converseAdjacency = \case
  Before Interval x
i Interval x
j -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
After Interval x
i Interval x
j
  Meets Interval x
i Interval x
j Interval x
k -> Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
MetBy Interval x
i Interval x
j Interval x
k
  Overlaps Interval x
i Interval x
j Interval x
k -> Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
OverlappedBy Interval x
i Interval x
j Interval x
k
  Starts Interval x
i Interval x
j -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
StartedBy Interval x
i Interval x
j
  During Interval x
i Interval x
j Interval x
k -> Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Contains Interval x
i Interval x
j Interval x
k
  Finishes Interval x
i Interval x
j -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
FinishedBy Interval x
i Interval x
j
  Identical Interval x
i -> Interval x -> Adjacency x
forall x. Interval x -> Adjacency x
Identical Interval x
i
  FinishedBy Interval x
i Interval x
j -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
Finishes Interval x
i Interval x
j
  Contains Interval x
i Interval x
j Interval x
k -> Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
During Interval x
i Interval x
j Interval x
k
  StartedBy Interval x
i Interval x
j -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
Starts Interval x
i Interval x
j
  OverlappedBy Interval x
i Interval x
j Interval x
k -> Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Overlaps Interval x
i Interval x
j Interval x
k
  MetBy Interval x
i Interval x
j Interval x
k -> Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Meets Interval x
i Interval x
j Interval x
k
  After Interval x
i Interval x
j -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
Before Interval x
i Interval x
j

-- | Get the convex hull of two intervals.
--
-- >>> hull (7 :|>: 8) (3 :|>: 4)
-- (Levitate 3 :|->: Levitate 8)
--
-- >>> hull (Bottom :<-|: 3) (3 :<|: 4)
-- (Bottom :<-|: Levitate 4)
hull :: (Ord x) => Interval x -> Interval x -> Interval x
hull :: Interval x -> Interval x -> Interval x
hull Interval x
i1 Interval x
i2 = case (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower (Interval x -> Interval x -> Interval x
forall a. Ord a => a -> a -> a
min Interval x
i1 Interval x
i2), Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper (Interval x -> Interval x -> Interval x
forall a. Ord a => a -> a -> a
max Interval x
i1 Interval x
i2)) of
  (SomeBound l :: Bound ext (Levitated x)
l@(Inf Levitated x
_), SomeBound u :: Bound ext (Levitated x)
u@(Sup Levitated x
_)) -> Bound ext (Levitated x)
Bound 'Infimum (Levitated x)
l Bound 'Infimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Infimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
:<-->: Bound ext (Levitated x)
Bound 'Supremum (Levitated x)
u
  (SomeBound l :: Bound ext (Levitated x)
l@(Inf Levitated x
_), SomeBound u :: Bound ext (Levitated x)
u@(Max Levitated x
_)) -> Bound ext (Levitated x)
Bound 'Infimum (Levitated x)
l Bound 'Infimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Infimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:<--|: Bound ext (Levitated x)
Bound 'Maximum (Levitated x)
u
  (SomeBound l :: Bound ext (Levitated x)
l@(Min Levitated x
_), SomeBound u :: Bound ext (Levitated x)
u@(Sup Levitated x
_)) -> Bound ext (Levitated x)
Bound 'Minimum (Levitated x)
l Bound 'Minimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
:|-->: Bound ext (Levitated x)
Bound 'Supremum (Levitated x)
u
  (SomeBound l :: Bound ext (Levitated x)
l@(Min Levitated x
_), SomeBound u :: Bound ext (Levitated x)
u@(Max Levitated x
_)) -> Bound ext (Levitated x)
Bound 'Minimum (Levitated x)
l Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:|--|: Bound ext (Levitated x)
Bound 'Maximum (Levitated x)
u
  (SomeBound (Levitated x), SomeBound (Levitated x))
_ -> Text -> Interval x
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Invalid lower/upper bounds"

-- | Get the convex hull of a non-empty list of intervals.
hulls :: (Ord x) => NonEmpty (Interval x) -> Interval x
hulls :: NonEmpty (Interval x) -> Interval x
hulls (Interval x
i :| []) = Interval x
i
hulls (Interval x
i :| Interval x
j : [Interval x]
is) = NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (NonEmpty (Interval x) -> Interval x)
-> NonEmpty (Interval x) -> Interval x
forall a b. (a -> b) -> a -> b
$ Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x]
is

-- | Test whether a point is contained in the interval.
within :: (Ord x) => x -> Interval x -> Bool
within :: x -> Interval x -> Bool
within (x -> Levitated x
forall a. a -> Levitated a
Levitate -> Levitated x
x) (Levitated x
l :---: Levitated x
u) = Levitated x
l Levitated x -> Levitated x -> Bool
forall a. Ord a => a -> a -> Bool
< Levitated x
x Bool -> Bool -> Bool
&& Levitated x
x Levitated x -> Levitated x -> Bool
forall a. Ord a => a -> a -> Bool
< Levitated x
u

-- | Create the closed-closed interval at a given point.
point :: (Ord x) => x -> Interval x
point :: x -> Interval x
point = (x -> x -> Interval x) -> x -> Interval x
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join x -> x -> Interval x
forall x. Ord x => x -> x -> Interval x
(:||:)

-- | Get the infimum of an interval, weakening if necessary.
iinf :: (Ord x) => Interval x -> Bound Infimum (Levitated x)
iinf :: Interval x -> Bound 'Infimum (Levitated x)
iinf (Levitated x
x :---: Levitated x
_) = Levitated x -> Bound 'Infimum (Levitated x)
forall x. x -> Bound 'Infimum x
Inf Levitated x
x

-- | Get the minimum of an interval, if it exists.
imin :: (Ord x) => Interval x -> Maybe (Bound Minimum (Levitated x))
imin :: Interval x -> Maybe (Bound 'Minimum (Levitated x))
imin = \case
  (Bound 'Minimum (Levitated x)
x :|-->: Bound 'Supremum (Levitated x)
_) -> Bound 'Minimum (Levitated x)
-> Maybe (Bound 'Minimum (Levitated x))
forall a. a -> Maybe a
Just Bound 'Minimum (Levitated x)
x
  (Bound 'Minimum (Levitated x)
x :|--|: Bound 'Maximum (Levitated x)
_) -> Bound 'Minimum (Levitated x)
-> Maybe (Bound 'Minimum (Levitated x))
forall a. a -> Maybe a
Just Bound 'Minimum (Levitated x)
x
  Interval x
_ -> Maybe (Bound 'Minimum (Levitated x))
forall a. Maybe a
Nothing

-- | Get the maximum of an interval if it exists.
imax :: (Ord x) => Interval x -> Maybe (Bound Maximum (Levitated x))
imax :: Interval x -> Maybe (Bound 'Maximum (Levitated x))
imax = \case
  (Bound 'Infimum (Levitated x)
_ :<--|: Bound 'Maximum (Levitated x)
x) -> Bound 'Maximum (Levitated x)
-> Maybe (Bound 'Maximum (Levitated x))
forall a. a -> Maybe a
Just Bound 'Maximum (Levitated x)
x
  (Bound 'Minimum (Levitated x)
_ :|--|: Bound 'Maximum (Levitated x)
x) -> Bound 'Maximum (Levitated x)
-> Maybe (Bound 'Maximum (Levitated x))
forall a. a -> Maybe a
Just Bound 'Maximum (Levitated x)
x
  Interval x
_ -> Maybe (Bound 'Maximum (Levitated x))
forall a. Maybe a
Nothing

-- | Get the supremum of an interval, weakening if necessary.
isup :: (Ord x) => Interval x -> Bound Supremum (Levitated x)
isup :: Interval x -> Bound 'Supremum (Levitated x)
isup (Levitated x
_ :---: Levitated x
x) = Levitated x -> Bound 'Supremum (Levitated x)
forall x. x -> Bound 'Supremum x
Sup Levitated x
x

-- | Open both bounds of the given interval.
open :: (Ord x) => Interval x -> Interval x
open :: Interval x -> Interval x
open (Levitated x
l :---: Levitated x
u) = Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u

-- | Close both bounds of the given interval.
close :: (Ord x) => Interval x -> Interval x
close :: Interval x -> Interval x
close (Levitated x
l :---: Levitated x
u) = Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u

-- | Make the interval open-closed, leaving the endpoints unchanged.
openclosed :: (Ord x) => Interval x -> Interval x
openclosed :: Interval x -> Interval x
openclosed (Levitated x
l :---: Levitated x
u) = Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u

-- | Make the interval closed-open, leaving the endpoints unchanged.
closedopen :: (Ord x) => Interval x -> Interval x
closedopen :: Interval x -> Interval x
closedopen (Levitated x
l :---: Levitated x
u) = Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u

-- | Make the lower bound open, leaving the endpoints unchanged.
openLower :: (Ord x) => Interval x -> Interval x
openLower :: Interval x -> Interval x
openLower = \case
  Levitated x
l :<->: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  Levitated x
l :<-|: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  Levitated x
l :|->: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  Levitated x
l :|-|: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u

-- | Make the lower bound closed, leaving the endpoints unchanged.
closedLower :: (Ord x) => Interval x -> Interval x
closedLower :: Interval x -> Interval x
closedLower = \case
  Levitated x
l :<->: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  Levitated x
l :<-|: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  Levitated x
l :|->: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  Levitated x
l :|-|: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u

-- | Make the upper bound open, leaving the endpoints unchanged.
openUpper :: (Ord x) => Interval x -> Interval x
openUpper :: Interval x -> Interval x
openUpper = \case
  Levitated x
l :<->: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  Levitated x
l :<-|: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  Levitated x
l :|->: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  Levitated x
l :|-|: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u

-- | Make the upper bound closed, leaving the endpoints unchanged.
closedUpper :: (Ord x) => Interval x -> Interval x
closedUpper :: Interval x -> Interval x
closedUpper = \case
  Levitated x
l :<->: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  Levitated x
l :<-|: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  Levitated x
l :|->: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  Levitated x
l :|-|: Levitated x
u -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u

setLower :: (Ord x) => Levitated x -> Interval x -> Interval x
setLower :: Levitated x -> Interval x -> Interval x
setLower Levitated x
x = \case
  Levitated x
_ :<->: Levitated x
u -> Levitated x
x Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  Levitated x
_ :<-|: Levitated x
u -> Levitated x
x Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  Levitated x
_ :|->: Levitated x
u -> Levitated x
x Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  Levitated x
_ :|-|: Levitated x
u -> Levitated x
x Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u

setUpper :: (Ord x) => Levitated x -> Interval x -> Interval x
setUpper :: Levitated x -> Interval x -> Interval x
setUpper Levitated x
x = \case
  Levitated x
l :<->: Levitated x
_ -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
x
  Levitated x
l :<-|: Levitated x
_ -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
x
  Levitated x
l :|->: Levitated x
_ -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
x
  Levitated x
l :|-|: Levitated x
_ -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
x

-- | Calculate the 'Adjacency' between two intervals, according to
-- [Allen](https://en.wikipedia.org/wiki/Allen%27s_interval_algebra).
adjacency :: (Ord x) => Interval x -> Interval x -> Adjacency x
adjacency :: Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 = case ((Interval x -> SomeBound (Levitated x))
-> Interval x -> Interval x -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i1 Interval x
i2, (Interval x -> SomeBound (Levitated x))
-> Interval x -> Interval x -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
i1 Interval x
i2) of
  (Ordering
LT, Ordering
LT) -> case SomeBound (Levitated x) -> Levitated x
forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
ub1 Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` SomeBound (Levitated x) -> Levitated x
forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
lb2 of
    Ordering
LT -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
Before Interval x
i1 Interval x
i2
    Ordering
EQ -> case (SomeBound (Levitated x)
ub1, SomeBound (Levitated x)
lb2) of
      (SomeBound (Max Levitated x
_), SomeBound (Min Levitated x
_)) ->
        Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Meets
          (Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x
openUpper Interval x
i1)
          (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 SomeBound (Levitated x)
ub1)
          (Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x
openLower Interval x
i2)
      (SomeBound (Levitated x), SomeBound (Levitated x))
_ -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
Before Interval x
i1 Interval x
i2
    Ordering
GT ->
      Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Overlaps
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb2))
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 SomeBound (Levitated x)
ub1)
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub1) SomeBound (Levitated x)
ub2)
  (Ordering
LT, Ordering
EQ) ->
    Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
Finishes
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb2))
      Interval x
i2
  (Ordering
LT, Ordering
GT) ->
    Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Contains
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb2))
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 SomeBound (Levitated x)
ub2)
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub2) SomeBound (Levitated x)
ub1)
  (Ordering
EQ, Ordering
LT) ->
    Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
Starts
      Interval x
i1
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub1) SomeBound (Levitated x)
ub2)
  (Ordering
EQ, Ordering
EQ) -> Interval x -> Adjacency x
forall x. Interval x -> Adjacency x
Identical Interval x
i1
  (Ordering
EQ, Ordering
GT) ->
    Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
StartedBy
      Interval x
i2
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub2) SomeBound (Levitated x)
ub1)
  (Ordering
GT, Ordering
LT) ->
    Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
During
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb1))
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 SomeBound (Levitated x)
ub1)
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub1) SomeBound (Levitated x)
ub2)
  (Ordering
GT, Ordering
EQ) ->
    Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
FinishedBy
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb1))
      Interval x
i1
  (Ordering
GT, Ordering
GT) -> case SomeBound (Levitated x) -> Levitated x
forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
ub2 Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` SomeBound (Levitated x) -> Levitated x
forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
lb1 of
    Ordering
GT ->
      Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
OverlappedBy
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb1))
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 SomeBound (Levitated x)
ub2)
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub2) SomeBound (Levitated x)
ub1)
    Ordering
EQ -> case (SomeBound (Levitated x)
ub2, SomeBound (Levitated x)
lb1) of
      (SomeBound (Max Levitated x
_), SomeBound (Min Levitated x
_)) ->
        Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
MetBy
          (Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x
openUpper Interval x
i2)
          (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 SomeBound (Levitated x)
ub2)
          (Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x
openLower Interval x
i1)
      (SomeBound (Levitated x), SomeBound (Levitated x))
_ -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
After Interval x
i2 Interval x
i1
    Ordering
LT -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
After Interval x
i2 Interval x
i1
 where
  (SomeBound (Levitated x)
lb1, SomeBound (Levitated x)
ub1) = Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
forall x.
Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
bounds Interval x
i1
  (SomeBound (Levitated x)
lb2, SomeBound (Levitated x)
ub2) = Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
forall x.
Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
bounds Interval x
i2

-- | Calculate the intersection of two intervals, if it exists.
--
-- @
--
-- >>> intersect (2 :<>: 4) (3 :||: 5)
-- Just (Levitate 3 :|->: Levitate 4)
--
-- >>> intersect (2 :<>: 4) (4 :||: 5)
-- Nothing
--
-- >>> intersect (1 :<>: 4) (2 :||: 3)
-- Just (Levitate 2 :|-|: Levitate 3)
--
-- @
intersect ::
  forall x.
  (Ord x) =>
  Interval x ->
  Interval x ->
  Maybe (Interval x)
intersect :: Interval x -> Interval x -> Maybe (Interval x)
intersect Interval x
i1 Interval x
i2 = case Interval x -> Interval x -> Adjacency x
forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 of
  Before Interval x
_ Interval x
_ -> Maybe (Interval x)
forall a. Maybe a
Nothing
  Meets Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  Overlaps Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  Starts Interval x
i Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
i
  During Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  Finishes Interval x
_ Interval x
j -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  Identical Interval x
i -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
i
  FinishedBy Interval x
_ Interval x
j -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  Contains Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  StartedBy Interval x
i Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
i
  OverlappedBy Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  MetBy Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  After Interval x
_ Interval x
_ -> Maybe (Interval x)
forall a. Maybe a
Nothing

-- | Get the union of two intervals, as either 'OneOrTwo'.
--
-- @
--
-- >>> union (2 :||: 5) (5 :<>: 7)
-- One (Levitate 2 :|->: Levitate 7)
--
-- >>> union (2 :||: 4) (5 :<>: 7)
-- Two (Levitate 2 :|-|: Levitate 4) (Levitate 5 :<->: Levitate 7)
--
-- @
union ::
  forall x.
  (Ord x) =>
  Interval x ->
  Interval x ->
  OneOrTwo (Interval x)
union :: Interval x -> Interval x -> OneOrTwo (Interval x)
union Interval x
i1 Interval x
i2 = case Interval x -> Interval x -> Adjacency x
forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 of
  Before Interval x
i Interval x
j
    | (Levitated x, Extremum) -> Levitated x
forall a b. (a, b) -> a
fst (Interval x -> (Levitated x, Extremum)
forall x. Ord x => Interval x -> (Levitated x, Extremum)
upperBound Interval x
i) Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== (Levitated x, Extremum) -> Levitated x
forall a b. (a, b) -> a
fst (Interval x -> (Levitated x, Extremum)
forall x. Ord x => Interval x -> (Levitated x, Extremum)
lowerBound Interval x
j) -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j
    | Bool
otherwise -> Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two Interval x
i Interval x
j
  Meets Interval x
i Interval x
j Interval x
k -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x
k Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j])
  Overlaps Interval x
i Interval x
j Interval x
k -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x
i Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x
j, Interval x
k])
  Starts Interval x
i Interval x
j -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x
i Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x
j])
  During Interval x
i Interval x
j Interval x
k -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x
i Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x
j, Interval x
k])
  Finishes Interval x
i Interval x
j -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x
i Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x
j])
  Identical Interval x
i -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
i
  FinishedBy Interval x
i Interval x
j -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x
i Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x
j])
  Contains Interval x
i Interval x
j Interval x
k -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x
i Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x
j, Interval x
k])
  StartedBy Interval x
i Interval x
j -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x
i Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x
j])
  OverlappedBy Interval x
i Interval x
j Interval x
k -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x
i Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x
j, Interval x
k])
  MetBy Interval x
i Interval x
j Interval x
k -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x
k Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j])
  After Interval x
i Interval x
j
    | (Levitated x, Extremum) -> Levitated x
forall a b. (a, b) -> a
fst (Interval x -> (Levitated x, Extremum)
forall x. Ord x => Interval x -> (Levitated x, Extremum)
upperBound Interval x
i) Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== (Levitated x, Extremum) -> Levitated x
forall a b. (a, b) -> a
fst (Interval x -> (Levitated x, Extremum)
forall x. Ord x => Interval x -> (Levitated x, Extremum)
lowerBound Interval x
j) -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> OneOrTwo (Interval x))
-> Interval x -> OneOrTwo (Interval x)
forall a b. (a -> b) -> a -> b
$ Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j
    | Bool
otherwise -> Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two Interval x
i Interval x
j

-- | /O(n log n)/. Get the union of a list of intervals.
--
-- This function uses 'sort'. See also 'unionsAsc'.
unions :: forall x. (Ord x) => [Interval x] -> [Interval x]
unions :: [Interval x] -> [Interval x]
unions = [Interval x] -> [Interval x]
forall x. Ord x => [Interval x] -> [Interval x]
unionsAsc ([Interval x] -> [Interval x])
-> ([Interval x] -> [Interval x]) -> [Interval x] -> [Interval x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Interval x] -> [Interval x]
forall a. Ord a => [a] -> [a]
sort

-- | /O(n)/. Get the union of a sorted list of intervals.
--
-- NOTE: The input condition is not checked. Use with care.
unionsAsc :: forall x. (Ord x) => [Interval x] -> [Interval x]
unionsAsc :: [Interval x] -> [Interval x]
unionsAsc = \case
  Interval x
i : Interval x
j : [Interval x]
is -> case Interval x
i Interval x -> Interval x -> OneOrTwo (Interval x)
forall x.
Ord x =>
Interval x -> Interval x -> OneOrTwo (Interval x)
`union` Interval x
j of
    One Interval x
k -> [Interval x] -> [Interval x]
forall x. Ord x => [Interval x] -> [Interval x]
unions (Interval x
k Interval x -> [Interval x] -> [Interval x]
forall a. a -> [a] -> [a]
: [Interval x]
is)
    OneOrTwo (Interval x)
_ -> Interval x
i Interval x -> [Interval x] -> [Interval x]
forall a. a -> [a] -> [a]
: [Interval x] -> [Interval x]
forall x. Ord x => [Interval x] -> [Interval x]
unions (Interval x
j Interval x -> [Interval x] -> [Interval x]
forall a. a -> [a] -> [a]
: [Interval x]
is)
  [Interval x]
x -> [Interval x]
x

-- | Take the complement of the interval, as possibly 'OneOrTwo'.
--
-- @
--
-- >>> complement (3 :<>: 4)
-- Just (Two (Bottom :|-|: Levitate 3) (Levitate 4 :|-|: Top))
--
-- @
--
-- Note that infinitely-open intervals will return the points at infinity
-- toward which they are infinite in their result:
--
-- @
--
-- >>> complement (Levitate 3 :<->: Top)
-- Just (Two (Bottom :|-|: Levitate 3) (Top :|-|: Top))
--
-- @
complement :: forall x. (Ord x) => Interval x -> Maybe (OneOrTwo (Interval x))
complement :: Interval x -> Maybe (OneOrTwo (Interval x))
complement = \case
  Interval x
Whole -> Maybe (OneOrTwo (Interval x))
forall a. Maybe a
Nothing
  Levitated x
Bottom :|-|: Levitated x
u -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Levitated x
u Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
forall a. Levitated a
Top))
  Levitated x
Bottom :|->: Levitated x
u -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Levitated x
u Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
forall a. Levitated a
Top))
  Levitated x
Bottom :<-|: Levitated x
u -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two (Levitated x
forall a. Levitated a
Bottom Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
forall a. Levitated a
Bottom) (Levitated x
u Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
forall a. Levitated a
Top))
  Levitated x
Bottom :<->: Levitated x
u -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two (Levitated x
forall a. Levitated a
Bottom Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
forall a. Levitated a
Bottom) (Levitated x
u Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
forall a. Levitated a
Top))
  --
  Levitated x
l :|-|: Levitated x
Top -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Levitated x
forall a. Levitated a
Bottom Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
l))
  Levitated x
l :<-|: Levitated x
Top -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Levitated x
forall a. Levitated a
Bottom Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
l))
  Levitated x
l :|->: Levitated x
Top -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two (Levitated x
forall a. Levitated a
Bottom Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
l) (Levitated x
forall a. Levitated a
Top Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
forall a. Levitated a
Top))
  Levitated x
l :<->: Levitated x
Top -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two (Levitated x
forall a. Levitated a
Bottom Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
l) (Levitated x
forall a. Levitated a
Top Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
forall a. Levitated a
Top))
  --
  Levitated x
l :|-|: Levitated x
u -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two (Levitated x
forall a. Levitated a
Bottom Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
l) (Levitated x
u Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
forall a. Levitated a
Top))
  Levitated x
l :|->: Levitated x
u -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two (Levitated x
forall a. Levitated a
Bottom Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
l) (Levitated x
u Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
forall a. Levitated a
Top))
  Levitated x
l :<-|: Levitated x
u -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two (Levitated x
forall a. Levitated a
Bottom Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
l) (Levitated x
u Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
forall a. Levitated a
Top))
  Levitated x
l :<->: Levitated x
u -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two (Levitated x
forall a. Levitated a
Bottom Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
l) (Levitated x
u Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
forall a. Levitated a
Top))

-- | Remove all points of the second interval from the first.
--
-- @
--
-- >>> difference Whole (3 :<>: 4)
-- Just (Two (Bottom :|-|: Levitate 3) (Levitate 4 :|-|: Top))
--
-- >>> difference (1 :<>: 4) (2 :||: 3)
-- Just (Two (Levitate 1 :<->: Levitate 2) (Levitate 3 :<->: Levitate 4))
--
-- @
difference ::
  forall x.
  (Ord x) =>
  Interval x ->
  Interval x ->
  Maybe (OneOrTwo (Interval x))
difference :: Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
difference Interval x
i1 Interval x
i2 = case Interval x -> Interval x -> Adjacency x
forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 of
  -- not commutative!!
  Before Interval x
i Interval x
_ -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x)))
-> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a b. (a -> b) -> a -> b
$ Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
i
  Meets Interval x
i Interval x
_ Interval x
_ -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x)))
-> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a b. (a -> b) -> a -> b
$ Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
i
  Overlaps Interval x
i Interval x
_ Interval x
_ -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x)))
-> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a b. (a -> b) -> a -> b
$ Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
i
  Starts{} -> Maybe (OneOrTwo (Interval x))
forall a. Maybe a
Nothing
  During{} -> Maybe (OneOrTwo (Interval x))
forall a. Maybe a
Nothing
  Finishes{} -> Maybe (OneOrTwo (Interval x))
forall a. Maybe a
Nothing
  Identical{} -> Maybe (OneOrTwo (Interval x))
forall a. Maybe a
Nothing
  FinishedBy Interval x
i Interval x
_ -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x)))
-> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a b. (a -> b) -> a -> b
$ Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
i
  Contains Interval x
i Interval x
_ Interval x
k -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x)))
-> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a b. (a -> b) -> a -> b
$ Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two Interval x
i Interval x
k
  StartedBy Interval x
_ Interval x
j -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x)))
-> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a b. (a -> b) -> a -> b
$ Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
j
  OverlappedBy Interval x
_ Interval x
_ Interval x
k -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x)))
-> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a b. (a -> b) -> a -> b
$ Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
k
  MetBy Interval x
i Interval x
_ Interval x
_ -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x)))
-> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a b. (a -> b) -> a -> b
$ Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
i
  After Interval x
i Interval x
_ -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x)))
-> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a b. (a -> b) -> a -> b
$ Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
i

-- | Infix synonym for 'difference'
(\\) ::
  forall x.
  (Ord x) =>
  Interval x ->
  Interval x ->
  Maybe (OneOrTwo (Interval x))
\\ :: Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
(\\) = Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
forall x.
Ord x =>
Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
difference

-- | The difference of the union and intersection of two intervals.
--
-- @
--
-- >>> symmetricDifference Whole (3 :<>: 4)
-- Just (Two (Bottom :|-|: Levitate 3) (Levitate 4 :|-|: Top))
--
-- >>> symmetricDifference (1 :<>: 4) (2 :||: 3)
-- Just (Two (Levitate 1 :<->: Levitate 2) (Levitate 3 :<->: Levitate 4))
--
-- @
symmetricDifference ::
  forall x.
  (Ord x) =>
  Interval x ->
  Interval x ->
  Maybe (OneOrTwo (Interval x))
symmetricDifference :: Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
symmetricDifference Interval x
i1 Interval x
i2 = case Interval x
i1 Interval x -> Interval x -> OneOrTwo (Interval x)
forall x.
Ord x =>
Interval x -> Interval x -> OneOrTwo (Interval x)
`union` Interval x
i2 of
  Two Interval x
j1 Interval x
j2 -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two Interval x
j1 Interval x
j2)
  One Interval x
u -> case Interval x
i1 Interval x -> Interval x -> Maybe (Interval x)
forall x. Ord x => Interval x -> Interval x -> Maybe (Interval x)
`intersect` Interval x
i2 of
    Maybe (Interval x)
Nothing -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
u)
    Just Interval x
i -> Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
forall x.
Ord x =>
Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
difference Interval x
u Interval x
i

-- | Get the measure of an interval.
--
-- @
--
-- >>> measure (-1 :<>: 1)
-- Just 2
--
-- >>> measure (Bottom :<->: Levitate 1)
-- Nothing
--
-- @
measure :: forall x. (Ord x, Num x) => Interval x -> Maybe x
measure :: Interval x -> Maybe x
measure = (x -> x -> x) -> Interval x -> Maybe x
forall y x.
(Ord x, Num y) =>
(x -> x -> y) -> Interval x -> Maybe y
measuring x -> x -> x
forall a. Num a => a -> a -> a
subtract

-- | Apply a function to the lower, then upper, endpoint of an interval.
--
-- @
--
-- >>> measuring max (-1 :<>: 1)
-- Just 1
--
-- >>> measuring min (-1 :<>: 1)
-- Just (-1)
--
-- @
measuring ::
  forall y x. (Ord x, Num y) => (x -> x -> y) -> Interval x -> Maybe y
measuring :: (x -> x -> y) -> Interval x -> Maybe y
measuring x -> x -> y
f = \case
  Levitate x
l :---: Levitate x
u -> y -> Maybe y
forall a. a -> Maybe a
Just (x -> x -> y
f x
l x
u)
  Levitated x
l :---: Levitated x
u -> if Levitated x
l Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== Levitated x
u then y -> Maybe y
forall a. a -> Maybe a
Just y
0 else Maybe y
forall a. Maybe a
Nothing

-- | Get the distance between two intervals, or 0 if they adjacency.
--
-- @
--
-- >>> hausdorff (3 :<>: 5) (6 :<>: 7)
-- Just 1
--
-- >>> hausdorff (3 :<>: 5) Whole
-- Just 0
--
-- @
hausdorff :: (Ord x, Num x) => Interval x -> Interval x -> Maybe x
hausdorff :: Interval x -> Interval x -> Maybe x
hausdorff Interval x
i1 Interval x
i2 = case Interval x -> Interval x -> Adjacency x
forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 of
  Before Interval x
i Interval x
j ->
    Maybe x -> (x -> Maybe x) -> Maybe x -> Levitated x -> Maybe x
forall b a. b -> (a -> b) -> b -> Levitated a -> b
foldLevitated Maybe x
forall a. Maybe a
Nothing x -> Maybe x
forall a. a -> Maybe a
Just Maybe x
forall a. Maybe a
Nothing (Levitated x -> Maybe x) -> Levitated x -> Maybe x
forall a b. (a -> b) -> a -> b
$ (Levitated x -> Levitated x -> Levitated x)
-> (SomeBound (Levitated x) -> Levitated x)
-> SomeBound (Levitated x)
-> SomeBound (Levitated x)
-> Levitated x
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on ((x -> x -> x) -> Levitated x -> Levitated x -> Levitated x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)) SomeBound (Levitated x) -> Levitated x
forall x. Ord x => SomeBound x -> x
unSomeBound (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
j) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
i)
  After Interval x
i Interval x
j ->
    Maybe x -> (x -> Maybe x) -> Maybe x -> Levitated x -> Maybe x
forall b a. b -> (a -> b) -> b -> Levitated a -> b
foldLevitated Maybe x
forall a. Maybe a
Nothing x -> Maybe x
forall a. a -> Maybe a
Just Maybe x
forall a. Maybe a
Nothing (Levitated x -> Maybe x) -> Levitated x -> Maybe x
forall a b. (a -> b) -> a -> b
$ (Levitated x -> Levitated x -> Levitated x)
-> (SomeBound (Levitated x) -> Levitated x)
-> SomeBound (Levitated x)
-> SomeBound (Levitated x)
-> Levitated x
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on ((x -> x -> x) -> Levitated x -> Levitated x -> Levitated x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)) SomeBound (Levitated x) -> Levitated x
forall x. Ord x => SomeBound x -> x
unSomeBound (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
j) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
i)
  Adjacency x
_ -> x -> Maybe x
forall a. a -> Maybe a
Just x
0

-- | @m '+/-' r@ creates the closed interval centred at @m@ with radius @r@.
--
-- For the open interval, simply write @'open' (x '+/-' y)@.
(+/-) :: (Ord x, Num x) => x -> x -> Interval x
x
m +/- :: x -> x -> Interval x
+/- x
r = x
m x -> x -> x
forall a. Num a => a -> a -> a
- x
r x -> x -> Interval x
forall x. Ord x => x -> x -> Interval x
:||: x
m x -> x -> x
forall a. Num a => a -> a -> a
+ x
r

-- | Full containment.
isSubsetOf :: (Ord x) => Interval x -> Interval x -> Bool
isSubsetOf :: Interval x -> Interval x -> Bool
isSubsetOf Interval x
i Interval x
j = case Interval x -> Interval x -> Adjacency x
forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i Interval x
j of
  Before{} -> Bool
False
  Meets{} -> Bool
False
  Overlaps{} -> Bool
False
  Starts{} -> Bool
True
  During{} -> Bool
True
  Finishes{} -> Bool
True
  Identical{} -> Bool
True
  FinishedBy{} -> Bool
False
  Contains{} -> Bool
False
  StartedBy{} -> Bool
False
  OverlappedBy{} -> Bool
False
  MetBy{} -> Bool
False
  After{} -> Bool
False