-- |
-- 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,
  imapS,
  itraverse,
  itraverseS,
  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,
  (+/-),
) 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.
imapS ::
  (Ord x, Ord y) =>
  (Levitated x -> Levitated y) ->
  Interval x ->
  Interval y
imapS :: (Levitated x -> Levitated y) -> Interval x -> Interval y
imapS 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.
itraverseS ::
  (Ord x, Ord y, Applicative f) =>
  (Levitated x -> f (Levitated y)) ->
  Interval x ->
  f (Interval y)
itraverseS :: (Levitated x -> f (Levitated y)) -> Interval x -> f (Interval y)
itraverseS 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 (:<->:), (:<-|:), (:|->:), (:|-|:) #-}

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 '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 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"

-- | 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) = \case
  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
  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
  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
  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 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 'Infimum (Levitated x)
_ :<-->: Bound 'Supremum (Levitated x)
_) -> Maybe (Bound 'Minimum (Levitated x))
forall a. Maybe a
Nothing
  (Bound 'Infimum (Levitated x)
_ :<--|: Bound 'Maximum (Levitated x)
_) -> Maybe (Bound 'Minimum (Levitated x))
forall a. Maybe a
Nothing
  (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

-- | 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 = \case
  (Levitated x
x :<->: Levitated x
_) -> Levitated x -> Bound 'Infimum (Levitated x)
forall x. x -> Bound 'Infimum x
Inf Levitated x
x
  (Levitated x
x :<-|: Levitated x
_) -> Levitated x -> Bound 'Infimum (Levitated x)
forall x. x -> Bound 'Infimum x
Inf Levitated x
x
  (Levitated x
x :|->: Levitated x
_) -> Levitated x -> Bound 'Infimum (Levitated x)
forall x. x -> Bound 'Infimum x
Inf Levitated x
x
  (Levitated x
x :|-|: Levitated x
_) -> Levitated x -> Bound 'Infimum (Levitated x)
forall x. x -> Bound 'Infimum x
Inf Levitated x
x

-- | 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 = \case
  (Levitated x
_ :<->: Levitated x
x) -> Levitated x -> Bound 'Supremum (Levitated x)
forall x. x -> Bound 'Supremum x
Sup Levitated x
x
  (Levitated x
_ :<-|: Levitated x
x) -> Levitated x -> Bound 'Supremum (Levitated x)
forall x. x -> Bound 'Supremum x
Sup Levitated x
x
  (Levitated x
_ :|->: Levitated x
x) -> Levitated x -> Bound 'Supremum (Levitated x)
forall x. x -> Bound 'Supremum x
Sup Levitated x
x
  (Levitated x
_ :|-|: Levitated x
x) -> Levitated x -> Bound 'Supremum (Levitated x)
forall x. x -> Bound 'Supremum x
Sup Levitated x
x

-- | 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 'Supremum (Levitated x)
_) -> Maybe (Bound 'Maximum (Levitated x))
forall a. Maybe a
Nothing
  (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 'Supremum (Levitated x)
_) -> Maybe (Bound 'Maximum (Levitated x))
forall a. Maybe a
Nothing
  (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

-- | Open both bounds of the given interval.
open :: (Ord x) => Interval x -> Interval x
open :: Interval x -> Interval x
open = \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

-- | Close both bounds of the given interval.
close :: (Ord x) => Interval x -> Interval x
close :: Interval x -> Interval x
close = \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 interval open-closed, leaving the endpoints unchanged.
openclosed :: (Ord x) => Interval x -> Interval x
openclosed :: Interval x -> Interval x
openclosed = \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 interval closed-open, leaving the endpoints unchanged.
closedopen :: (Ord x) => Interval x -> Interval x
closedopen :: Interval x -> Interval x
closedopen = \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 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))
--
-- @
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)
  Levitate x
l :|->: Levitate x
u -> y -> Maybe y
forall a. a -> Maybe a
Just (x -> x -> y
f x
l x
u)
  Levitate x
l :<-|: Levitate x
u -> y -> Maybe y
forall a. a -> Maybe a
Just (x -> x -> y
f x
l x
u)
  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
  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
  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
  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