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

import Algebra.Lattice.Levitated (Levitated (..), foldLevitated)
import Control.Applicative (liftA2)
import Control.Monad (join)
import Data.Data
import Data.Function (on)
import Data.Functor.Const (Const (Const))
import Data.Kind (Constraint, Type)
import Data.List (sort)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.OneOrTwo (OneOrTwo (..))
import Data.Ord (comparing)
import GHC.Generics (Generic (..), type (:*:) (..))

-- | The kinds of extremum an interval can have.
data Extremum
  = Minimum
  | Infimum
  | Supremum
  | Maximum
  deriving (Extremum -> Extremum -> Bool
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
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
Ord, Int -> Extremum
Extremum -> Int
Extremum -> [Extremum]
Extremum -> Extremum
Extremum -> Extremum -> [Extremum]
Extremum -> Extremum -> Extremum -> [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
forall a. a -> a -> Bounded a
maxBound :: Extremum
$cmaxBound :: Extremum
minBound :: Extremum
$cminBound :: Extremum
Bounded, Int -> Extremum -> ShowS
[Extremum] -> ShowS
Extremum -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Extremum] -> ShowS
$cshowList :: [Extremum] -> ShowS
show :: Extremum -> [Char]
$cshow :: Extremum -> [Char]
showsPrec :: Int -> Extremum -> ShowS
$cshowsPrec :: Int -> Extremum -> ShowS
Show, ReadPrec [Extremum]
ReadPrec Extremum
Int -> ReadS Extremum
ReadS [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. 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
Extremum -> DataType
Extremum -> Constr
(forall b. Data b => b -> b) -> Extremum -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Extremum -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Extremum -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Extremum -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Extremum -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable)

-- |
-- The 'opposite' of an 'Extremum' is its complementary analogue:
-- how the same point would be viewed from the complement of the
-- interval to which it belongs.
--
-- 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 :: forall (ext :: Extremum) x. 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 :: forall a b. (a -> b) -> Bound ext a -> Bound ext b
fmap a -> b
f = \case
    Min a
x -> forall x. x -> Bound 'Minimum x
Min (a -> b
f a
x)
    Inf a
x -> forall x. x -> Bound 'Infimum x
Inf (a -> b
f a
x)
    Sup a
x -> forall x. x -> Bound 'Supremum x
Sup (a -> b
f a
x)
    Max a
x -> forall x. x -> Bound 'Maximum x
Max (a -> b
f a
x)

instance Foldable (Bound ext) where
  foldMap :: forall m a. Monoid m => (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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bound ext a -> f (Bound ext b)
traverse a -> f b
f = \case
    Min a
x -> forall x. x -> Bound 'Minimum x
Min forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    Inf a
x -> forall x. x -> Bound 'Infimum x
Inf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    Sup a
x -> forall x. x -> Bound 'Supremum x
Sup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    Max a
x -> forall x. x -> Bound 'Maximum x
Max 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 forall a. Eq a => a -> a -> Bool
== x
y
  Inf x
x == Inf x
y = x
x forall a. Eq a => a -> a -> Bool
== x
y
  Sup x
x == Sup x
y = x
x forall a. Eq a => a -> a -> Bool
== x
y
  Max x
x == Max x
y = x
x 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 = forall x (ext1 :: Extremum) (ext2 :: Extremum).
Ord x =>
Bound ext1 x -> Bound ext2 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 :: forall x. x -> Bound 'Minimum x
bound = forall x. x -> Bound 'Minimum x
Min
  opposeBound :: forall x. Bound 'Minimum x -> Bound (Opposite 'Minimum) x
opposeBound (Min x
x) = forall x. x -> Bound 'Supremum x
Sup x
x

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

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

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

-- | 'Bound's have special comparison rules for identical points.
--
-- >>> compareBounds (Min (Levitate 5)) (Max (Levitate 5))
-- EQ
-- >>> compareBounds (Inf (Levitate 5)) (Sup (Levitate 5))
-- GT
-- >>> compareBounds (Max (Levitate 5)) (Sup (Levitate 5))
-- GT
-- >>> compareBounds (Inf (Levitate 5)) (Min (Levitate 5))
-- GT
-- >>> compareBounds (Max (Levitate 5)) (Inf (Levitate 5))
-- LT
compareBounds ::
  (Ord x) =>
  Bound ext1 x ->
  Bound ext2 x ->
  Ordering
compareBounds :: forall x (ext1 :: Extremum) (ext2 :: Extremum).
Ord x =>
Bound ext1 x -> Bound ext2 x -> Ordering
compareBounds (Min x
l) = \case
  Min x
ll -> forall a. Ord a => a -> a -> Ordering
compare x
l x
ll
  Inf x
ll -> forall a. Ord a => a -> a -> Ordering
compare x
l x
ll forall a. Semigroup a => a -> a -> a
<> Ordering
LT
  Sup x
u -> forall a. Ord a => a -> a -> Ordering
compare x
l x
u forall a. Semigroup a => a -> a -> a
<> Ordering
GT
  Max x
u -> forall a. Ord a => a -> a -> Ordering
compare x
l x
u
compareBounds (Inf x
l) = \case
  Min x
ll -> forall a. Ord a => a -> a -> Ordering
compare x
l x
ll forall a. Semigroup a => a -> a -> a
<> Ordering
GT
  Inf x
ll -> forall a. Ord a => a -> a -> Ordering
compare x
l x
ll
  Sup x
u -> forall a. Ord a => a -> a -> Ordering
compare x
l x
u forall a. Semigroup a => a -> a -> a
<> Ordering
GT
  Max x
u -> forall a. Ord a => a -> a -> Ordering
compare x
l x
u forall a. Semigroup a => a -> a -> a
<> Ordering
GT
compareBounds (Sup x
l) = \case
  Min x
u -> forall a. Ord a => a -> a -> Ordering
compare x
l x
u forall a. Semigroup a => a -> a -> a
<> Ordering
LT
  Inf x
u -> forall a. Ord a => a -> a -> Ordering
compare x
l x
u forall a. Semigroup a => a -> a -> a
<> Ordering
LT
  Sup x
uu -> forall a. Ord a => a -> a -> Ordering
compare x
l x
uu
  Max x
uu -> forall a. Ord a => a -> a -> Ordering
compare x
l x
uu forall a. Semigroup a => a -> a -> a
<> Ordering
LT
compareBounds (Max x
l) = \case
  Min x
u -> forall a. Ord a => a -> a -> Ordering
compare x
l x
u
  Inf x
u -> forall a. Ord a => a -> a -> Ordering
compare x
l x
u forall a. Semigroup a => a -> a -> a
<> Ordering
LT
  Sup x
uu -> forall a. Ord a => a -> a -> Ordering
compare x
l x
uu forall a. Semigroup a => a -> a -> a
<> Ordering
GT
  Max x
uu -> forall a. Ord a => a -> a -> Ordering
compare x
l 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 forall a. Eq a => a -> a -> Bool
== Levitated x
b
  SomeBound (Max Levitated x
a) == SomeBound (Max Levitated x
b) = Levitated x
a forall a. Eq a => a -> a -> Bool
== Levitated x
b
  SomeBound (Inf Levitated x
a) == SomeBound (Inf Levitated x
b) = Levitated x
a forall a. Eq a => a -> a -> Bool
== Levitated x
b
  SomeBound (Sup Levitated x
a) == SomeBound (Sup Levitated x
b) = Levitated x
a 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 = forall x (ext1 :: Extremum) (ext2 :: Extremum).
Ord x =>
Bound ext1 x -> Bound ext2 x -> Ordering
compareBounds Bound ext (Levitated x)
b0 Bound ext (Levitated x)
b1

oppose :: SomeBound x -> SomeBound x
oppose :: forall x. SomeBound x -> SomeBound x
oppose (SomeBound Bound ext x
b) = forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound (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 :: forall x. Ord x => SomeBound x -> x
unSomeBound (SomeBound Bound ext x
b) = 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

infix 5 :<->:

infix 5 :<-|:

infix 5 :|->:

infix 5 :|-|:

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

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

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

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

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

-- | A unidirectional pattern synonym ignoring the particular 'Bound's.
pattern (:---:) :: forall x. (Ord x) => Levitated x -> Levitated x -> Interval x
pattern l $m:---: :: forall {r} {x}.
Ord x =>
Interval x
-> (Levitated x -> Levitated x -> r) -> ((# #) -> r) -> r
:---: u <-
  (bounds -> (SomeBound (unBound -> l), SomeBound (unBound -> u)))

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

infix 5 :<>:

infix 5 :<|:

infix 5 :|>:

infix 5 :||:

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

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

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

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

-- |
-- A unidirectional pattern synonym matching finite intervals,
-- that ignores the particular 'Bound's.
pattern (:--:) :: forall x. (Ord x) => x -> x -> Interval x
pattern l $m:--: :: forall {r} {x}.
Ord x =>
Interval x -> (x -> x -> r) -> ((# #) -> r) -> r
:--: u <-
  ( bounds ->
      (SomeBound (unBound -> Levitate l), SomeBound (unBound -> Levitate u))
    )

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

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

instance (Ord x, Show x) => Show (Interval x) where
  show :: Interval x -> [Char]
show = \case
    x
l :<>: x
u -> [Char]
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show x
l forall a. Semigroup a => a -> a -> a
<> [Char]
" :<>: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show x
u forall a. Semigroup a => a -> a -> a
<> [Char]
")"
    x
l :|>: x
u -> [Char]
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show x
l forall a. Semigroup a => a -> a -> a
<> [Char]
" :|>: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show x
u forall a. Semigroup a => a -> a -> a
<> [Char]
")"
    x
l :<|: x
u -> [Char]
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show x
l forall a. Semigroup a => a -> a -> a
<> [Char]
" :<|: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show x
u forall a. Semigroup a => a -> a -> a
<> [Char]
")"
    x
l :||: x
u -> [Char]
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show x
l forall a. Semigroup a => a -> a -> a
<> [Char]
" :||: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show x
u forall a. Semigroup a => a -> a -> a
<> [Char]
")"
    Levitated x
l :<->: Levitated x
u -> [Char]
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Levitated x
l forall a. Semigroup a => a -> a -> a
<> [Char]
" :<->: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Levitated x
u forall a. Semigroup a => a -> a -> a
<> [Char]
")"
    Levitated x
l :|->: Levitated x
u -> [Char]
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Levitated x
l forall a. Semigroup a => a -> a -> a
<> [Char]
" :|->: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Levitated x
u forall a. Semigroup a => a -> a -> a
<> [Char]
")"
    Levitated x
l :<-|: Levitated x
u -> [Char]
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Levitated x
l forall a. Semigroup a => a -> a -> a
<> [Char]
" :<-|: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Levitated x
u forall a. Semigroup a => a -> a -> a
<> [Char]
")"
    Levitated x
l :|-|: Levitated x
u -> [Char]
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Levitated x
l forall a. Semigroup a => a -> a -> a
<> [Char]
" :|-|: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Levitated x
u forall a. Semigroup a => a -> a -> a
<> [Char]
")"

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

instance (Ord x, Data x) => Data (Interval x) where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Interval x -> c (Interval x)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
(<^>) forall g. g -> c g
gpure = \case
    Levitated x
l :<->: Levitated x
u -> forall g. g -> c g
gpure forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<->:) forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
l forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
u
    Levitated x
l :|->: Levitated x
u -> forall g. g -> c g
gpure forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|->:) forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
l forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
u
    Levitated x
l :<-|: Levitated x
u -> forall g. g -> c g
gpure forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<-|:) forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
l forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
u
    Levitated x
l :|-|: Levitated x
u -> forall g. g -> c g
gpure forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|-|:) forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
l forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
u
  toConstr :: Interval x -> Constr
toConstr = \case
    Levitated x
_ :<->: Levitated x
_ -> Constr
intervalOpenOpenConstr
    Levitated x
_ :|->: Levitated x
_ -> Constr
intervalClosedOpenConstr
    Levitated x
_ :<-|: Levitated x
_ -> Constr
intervalOpenClosedConstr
    Levitated x
_ :|-|: Levitated x
_ -> Constr
intervalClosedClosedConstr
  dataTypeOf :: Interval x -> DataType
dataTypeOf Interval x
_ = DataType
intervalDataType
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Interval x)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
gpure Constr
constr = case Constr -> Int
constrIndex Constr
constr of
    Int
0 -> forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
gpure forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<->:)))
    Int
1 -> forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
gpure forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|->:)))
    Int
2 -> forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
gpure forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<-|:)))
    Int
3 -> forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
gpure forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|-|:)))
    Int
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"

intervalOpenOpenConstr :: Constr
intervalOpenOpenConstr :: Constr
intervalOpenOpenConstr =
  DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr
    DataType
intervalDataType
    [Char]
":<--->:"
    []
    Fixity
Infix

intervalClosedOpenConstr :: Constr
intervalClosedOpenConstr :: Constr
intervalClosedOpenConstr =
  DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr
    DataType
intervalDataType
    [Char]
":|--->:"
    []
    Fixity
Infix

intervalOpenClosedConstr :: Constr
intervalOpenClosedConstr :: Constr
intervalOpenClosedConstr =
  DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr
    DataType
intervalDataType
    [Char]
":<---|:"
    []
    Fixity
Infix

intervalClosedClosedConstr :: Constr
intervalClosedClosedConstr :: Constr
intervalClosedClosedConstr =
  DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr
    DataType
intervalDataType
    [Char]
":|---|:"
    []
    Fixity
Infix

intervalDataType :: DataType
intervalDataType :: DataType
intervalDataType =
  [Char] -> [Constr] -> DataType
mkDataType
    [Char]
"Data.Interval.Interval"
    [ Constr
intervalOpenOpenConstr
    , Constr
intervalClosedOpenConstr
    , Constr
intervalOpenClosedConstr
    , Constr
intervalClosedClosedConstr
    ]

deriving instance Typeable x => Typeable (Interval x)

instance (Ord x, Generic x) => Generic (Interval x) where
  type Rep (Interval x) = (Const (Levitated x, Extremum) :*: Const (Levitated x, Extremum))
  from :: forall x. Interval x -> Rep (Interval x) x
from = \case
    Levitated x
l :<->: Levitated x
u -> (forall {k} a (b :: k). a -> Const a b
Const (Levitated x
l, Extremum
Infimum) forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} a (b :: k). a -> Const a b
Const (Levitated x
u, Extremum
Supremum))
    Levitated x
l :|->: Levitated x
u -> (forall {k} a (b :: k). a -> Const a b
Const (Levitated x
l, Extremum
Minimum) forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} a (b :: k). a -> Const a b
Const (Levitated x
u, Extremum
Supremum))
    Levitated x
l :<-|: Levitated x
u -> (forall {k} a (b :: k). a -> Const a b
Const (Levitated x
l, Extremum
Infimum) forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} a (b :: k). a -> Const a b
Const (Levitated x
u, Extremum
Maximum))
    Levitated x
l :|-|: Levitated x
u -> (forall {k} a (b :: k). a -> Const a b
Const (Levitated x
l, Extremum
Minimum) forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} a (b :: k). a -> Const a b
Const (Levitated x
u, Extremum
Maximum))
  to :: forall x. Rep (Interval x) x -> Interval x
to (Const (Levitated x, Extremum)
l :*: Const (Levitated x, Extremum)
u) = (Levitated x, Extremum)
l forall x.
Ord x =>
(Levitated x, Extremum) -> (Levitated x, Extremum) -> Interval x
... (Levitated x, Extremum)
u

-- | 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 :: forall x y. (Ord x, Ord y) => (x -> y) -> Interval x -> Interval y
imap x -> y
f = \case
  Levitated x
l :<->: Levitated x
u -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f Levitated x
u

-- | Same as 'imap' but on the 'Levitated' of the underlying type.
imapLev ::
  (Ord x, Ord y) =>
  (Levitated x -> Levitated y) ->
  Interval x ->
  Interval y
imapLev :: forall x y.
(Ord x, Ord y) =>
(Levitated x -> Levitated y) -> Interval x -> Interval y
imapLev Levitated x -> Levitated y
f = \case
  Levitated x
l :<->: Levitated x
u -> Levitated x -> Levitated y
f Levitated x
l 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 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 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 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 :: forall x y (f :: * -> *).
(Ord x, Ord y, Applicative f) =>
(x -> f y) -> Interval x -> f (Interval y)
itraverse x -> f y
f = \case
  Levitated x
l :<->: Levitated x
u -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<->:) (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) (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 -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|->:) (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) (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 -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<-|:) (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) (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 -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|-|:) (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) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse x -> f y
f Levitated x
u)

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

-- | Get the @(lower, upper)@ 'bounds' of an 'Interval'.
--
-- c.f. 'lower', 'upper'.
bounds :: Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
bounds :: forall x.
Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
bounds = \case
  Bound 'Infimum (Levitated x)
l :<-->: Bound 'Supremum (Levitated x)
u -> (forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Infimum (Levitated x)
l, 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 -> (forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Infimum (Levitated x)
l, 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 -> (forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Minimum (Levitated x)
l, 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 -> (forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound Bound 'Minimum (Levitated x)
l, 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 :: forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall x. Ord x => 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 :: forall x. Ord x => 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 :: forall x.
Ord x =>
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 forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  (Min Levitated x
l, Max Levitated x
u) -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  (Inf Levitated x
l, Sup Levitated x
u) -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  (Inf Levitated x
l, Max Levitated x
u) -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  (Sup Levitated x
u, Min Levitated x
l) -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  (Sup Levitated x
u, Inf Levitated x
l) -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  (Max Levitated x
u, Min Levitated x
l) -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  (Max Levitated x
u, Inf Levitated x
l) -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  (Bound ext (Levitated x), Bound ext (Levitated x))
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"cannot make an interval with the given bounds"

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

-- | According to
-- [Allen](https://en.wikipedia.org/wiki/Allen%27s_interval_algebra),
-- two intervals can be "adjacent" in 13 different ways,
-- into at most 3 distinct intervals. In this package,
-- this quality is called the 'Adjacency' of the intervals.
data Adjacency x
  = Before !(Interval x) !(Interval x)
  | Meets !(Interval x) !(Interval x) !(Interval x)
  | Overlaps !(Interval x) !(Interval x) !(Interval x)
  | Starts !(Interval x) !(Interval x)
  | During !(Interval x) !(Interval x) !(Interval x)
  | Finishes !(Interval x) !(Interval x)
  | Identical !(Interval x)
  | FinishedBy !(Interval x) !(Interval x)
  | Contains !(Interval x) !(Interval x) !(Interval x)
  | StartedBy !(Interval x) !(Interval x)
  | OverlappedBy !(Interval x) !(Interval x) !(Interval x)
  | MetBy !(Interval x) !(Interval x) !(Interval x)
  | After !(Interval x) !(Interval x)
  deriving (Adjacency x -> Adjacency x -> Bool
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, Adjacency x -> Adjacency x -> Ordering
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
Ord, Int -> Adjacency x -> ShowS
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Adjacency x] -> ShowS
$cshowList :: forall x. (Ord x, Show x) => [Adjacency x] -> ShowS
show :: Adjacency x -> [Char]
$cshow :: forall x. (Ord x, Show x) => Adjacency x -> [Char]
showsPrec :: Int -> Adjacency x -> ShowS
$cshowsPrec :: forall x. (Ord x, Show x) => Int -> Adjacency x -> ShowS
Show, 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, Adjacency x -> DataType
Adjacency x -> Constr
forall {x}. (Data x, Ord x) => Typeable (Adjacency x)
forall x. (Data x, Ord x) => Adjacency x -> DataType
forall x. (Data x, Ord x) => Adjacency x -> Constr
forall x.
(Data x, Ord x) =>
(forall b. Data b => b -> b) -> Adjacency x -> Adjacency x
forall x u.
(Data x, Ord x) =>
Int -> (forall d. Data d => d -> u) -> Adjacency x -> u
forall x u.
(Data x, Ord x) =>
(forall d. Data d => d -> u) -> Adjacency x -> [u]
forall x r r'.
(Data x, Ord x) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Adjacency x -> r
forall x r r'.
(Data x, Ord x) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Adjacency x -> r
forall x (m :: * -> *).
(Data x, Ord x, Monad m) =>
(forall d. Data d => d -> m d) -> Adjacency x -> m (Adjacency x)
forall x (m :: * -> *).
(Data x, Ord x, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Adjacency x -> m (Adjacency x)
forall x (c :: * -> *).
(Data x, Ord x) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Adjacency x)
forall x (c :: * -> *).
(Data x, Ord x) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Adjacency x -> c (Adjacency x)
forall x (t :: * -> *) (c :: * -> *).
(Data x, Ord x, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Adjacency x))
forall x (t :: * -> * -> *) (c :: * -> *).
(Data x, Ord x, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Adjacency x))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Adjacency x)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Adjacency x -> c (Adjacency x)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Adjacency x))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Adjacency x -> m (Adjacency x)
$cgmapMo :: forall x (m :: * -> *).
(Data x, Ord x, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Adjacency x -> m (Adjacency x)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Adjacency x -> m (Adjacency x)
$cgmapMp :: forall x (m :: * -> *).
(Data x, Ord x, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Adjacency x -> m (Adjacency x)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Adjacency x -> m (Adjacency x)
$cgmapM :: forall x (m :: * -> *).
(Data x, Ord x, Monad m) =>
(forall d. Data d => d -> m d) -> Adjacency x -> m (Adjacency x)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Adjacency x -> u
$cgmapQi :: forall x u.
(Data x, Ord x) =>
Int -> (forall d. Data d => d -> u) -> Adjacency x -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Adjacency x -> [u]
$cgmapQ :: forall x u.
(Data x, Ord x) =>
(forall d. Data d => d -> u) -> Adjacency x -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Adjacency x -> r
$cgmapQr :: forall x r r'.
(Data x, Ord x) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Adjacency x -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Adjacency x -> r
$cgmapQl :: forall x r r'.
(Data x, Ord x) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Adjacency x -> r
gmapT :: (forall b. Data b => b -> b) -> Adjacency x -> Adjacency x
$cgmapT :: forall x.
(Data x, Ord x) =>
(forall b. Data b => b -> b) -> Adjacency x -> Adjacency x
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Adjacency x))
$cdataCast2 :: forall x (t :: * -> * -> *) (c :: * -> *).
(Data x, Ord x, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Adjacency x))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Adjacency x))
$cdataCast1 :: forall x (t :: * -> *) (c :: * -> *).
(Data x, Ord x, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Adjacency x))
dataTypeOf :: Adjacency x -> DataType
$cdataTypeOf :: forall x. (Data x, Ord x) => Adjacency x -> DataType
toConstr :: Adjacency x -> Constr
$ctoConstr :: forall x. (Data x, Ord x) => Adjacency x -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Adjacency x)
$cgunfold :: forall x (c :: * -> *).
(Data x, Ord x) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Adjacency x)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Adjacency x -> c (Adjacency x)
$cgfoldl :: forall x (c :: * -> *).
(Data x, Ord x) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Adjacency x -> c (Adjacency x)
Data)

-- | The result of having compared the same two intervals in reverse order.
converseAdjacency :: Adjacency x -> Adjacency x
converseAdjacency :: forall x. Adjacency x -> Adjacency x
converseAdjacency = \case
  Before Interval x
i Interval x
j -> 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 -> 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 -> 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 -> 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 -> 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 -> forall x. Interval x -> Interval x -> Adjacency x
FinishedBy Interval x
i Interval x
j
  Identical Interval x
i -> forall x. Interval x -> Adjacency x
Identical Interval x
i
  FinishedBy Interval x
i Interval x
j -> 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 -> 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 -> 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 -> 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 -> 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 -> 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)
-- (3 :|>: 8)
--
-- >>> hull (Bottom :<-|: Levitate 3) (4 :<>: 5)
-- (Bottom :<->: Levitate 5)
hull :: (Ord x) => Interval x -> Interval x -> Interval x
hull :: forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i1 Interval x
i2 = case (forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower (forall a. Ord a => a -> a -> a
min Interval x
i1 Interval x
i2), forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper (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)
l forall x.
Ord x =>
Bound 'Infimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
:<-->: Bound ext (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)
l forall x.
Ord x =>
Bound 'Infimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:<--|: Bound ext (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)
l forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Supremum (Levitated x) -> Interval x
:|-->: Bound ext (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)
l forall x.
Ord x =>
Bound 'Minimum (Levitated x)
-> Bound 'Maximum (Levitated x) -> Interval x
:|--|: Bound ext (Levitated x)
u
  (SomeBound (Levitated x), SomeBound (Levitated x))
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid lower/upper bounds"

-- | Get the convex hull of a non-empty list of intervals.
hulls :: (Ord x) => NonEmpty (Interval x) -> Interval x
hulls :: forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x
i :| []) = Interval x
i
hulls (Interval x
i :| Interval x
j : [Interval x]
is) = forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j 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 :: forall x. Ord x => x -> Interval x -> Bool
within (forall a. a -> Levitated a
Levitate -> Levitated x
x) = \case
  Levitated x
l :<->: Levitated x
u -> Levitated x
l forall a. Ord a => a -> a -> Bool
< Levitated x
x Bool -> Bool -> Bool
&& Levitated x
x forall a. Ord a => a -> a -> Bool
< Levitated x
u
  Levitated x
l :<-|: Levitated x
u -> Levitated x
l forall a. Ord a => a -> a -> Bool
< Levitated x
x Bool -> Bool -> Bool
&& Levitated x
x forall a. Ord a => a -> a -> Bool
<= Levitated x
u
  Levitated x
l :|->: Levitated x
u -> Levitated x
l forall a. Ord a => a -> a -> Bool
<= Levitated x
x Bool -> Bool -> Bool
&& Levitated x
x forall a. Ord a => a -> a -> Bool
< Levitated x
u
  Levitated x
l :|-|: Levitated x
u -> Levitated x
l forall a. Ord a => a -> a -> Bool
<= Levitated x
x Bool -> Bool -> Bool
&& Levitated x
x 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 :: forall x. Ord x => x -> Interval x
point = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall x. Ord x => x -> x -> Interval x
(:||:)

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

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

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

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

-- | Open both bounds of the given interval.
open :: (Ord x) => Interval x -> Interval x
open :: forall x. Ord x => Interval x -> Interval x
open (Levitated x
l :---: Levitated x
u) = Levitated x
l 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 :: forall x. Ord x => Interval x -> Interval x
close (Levitated x
l :---: Levitated x
u) = Levitated x
l 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 :: forall x. Ord x => Interval x -> Interval x
openclosed (Levitated x
l :---: Levitated x
u) = Levitated x
l 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 :: forall x. Ord x => Interval x -> Interval x
closedopen (Levitated x
l :---: Levitated x
u) = Levitated x
l 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 :: forall x. Ord x => Interval x -> Interval x
openLower = \case
  Levitated x
l :<->: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  Levitated x
l :<-|: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  Levitated x
l :|->: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  Levitated x
l :|-|: Levitated x
u -> Levitated x
l 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 :: forall x. Ord x => Interval x -> Interval x
closedLower = \case
  Levitated x
l :<->: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  Levitated x
l :<-|: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  Levitated x
l :|->: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  Levitated x
l :|-|: Levitated x
u -> Levitated x
l 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 :: forall x. Ord x => Interval x -> Interval x
openUpper = \case
  Levitated x
l :<->: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  Levitated x
l :<-|: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  Levitated x
l :|->: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  Levitated x
l :|-|: Levitated x
u -> Levitated x
l 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 :: forall x. Ord x => Interval x -> Interval x
closedUpper = \case
  Levitated x
l :<->: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  Levitated x
l :<-|: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  Levitated x
l :|->: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  Levitated x
l :|-|: Levitated x
u -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u

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

setUpper :: (Ord x) => Levitated x -> Interval x -> Interval x
setUpper :: forall x. Ord x => Levitated x -> Interval x -> Interval x
setUpper Levitated x
x = \case
  Levitated x
l :<->: Levitated x
_ -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
x
  Levitated x
l :<-|: Levitated x
_ -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
x
  Levitated x
l :|->: Levitated x
_ -> Levitated x
l forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
x
  Levitated x
l :|-|: Levitated x
_ -> Levitated x
l 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 :: forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 = case (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i1 Interval x
i2, forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
i1 Interval x
i2) of
  (Ordering
LT, Ordering
LT) -> case forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
ub1 forall a. Ord a => a -> a -> Ordering
`compare` forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
lb2 of
    Ordering
LT -> 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
_)) ->
        forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Meets
          (forall x. Ord x => Interval x -> Interval x
openUpper Interval x
i1)
          (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 SomeBound (Levitated x)
ub1)
          (forall x. Ord x => Interval x -> Interval x
openLower Interval x
i2)
      (SomeBound (Levitated x), SomeBound (Levitated x))
_ -> forall x. Interval x -> Interval x -> Adjacency x
Before Interval x
i1 Interval x
i2
    Ordering
GT ->
      forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Overlaps
        (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 (forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb2))
        (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 SomeBound (Levitated x)
ub1)
        (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub1) SomeBound (Levitated x)
ub2)
  (Ordering
LT, Ordering
EQ) ->
    forall x. Interval x -> Interval x -> Adjacency x
Finishes
      (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 (forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb2))
      Interval x
i2
  (Ordering
LT, Ordering
GT) ->
    forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Contains
      (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 (forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb2))
      (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 SomeBound (Levitated x)
ub2)
      (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub2) SomeBound (Levitated x)
ub1)
  (Ordering
EQ, Ordering
LT) ->
    forall x. Interval x -> Interval x -> Adjacency x
Starts
      Interval x
i1
      (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub1) SomeBound (Levitated x)
ub2)
  (Ordering
EQ, Ordering
EQ) -> forall x. Interval x -> Adjacency x
Identical Interval x
i1
  (Ordering
EQ, Ordering
GT) ->
    forall x. Interval x -> Interval x -> Adjacency x
StartedBy
      Interval x
i2
      (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub2) SomeBound (Levitated x)
ub1)
  (Ordering
GT, Ordering
LT) ->
    forall x. Interval x -> Interval x -> Interval x -> Adjacency x
During
      (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 (forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb1))
      (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 SomeBound (Levitated x)
ub1)
      (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub1) SomeBound (Levitated x)
ub2)
  (Ordering
GT, Ordering
EQ) ->
    forall x. Interval x -> Interval x -> Adjacency x
FinishedBy
      (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 (forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb1))
      Interval x
i1
  (Ordering
GT, Ordering
GT) -> case forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
ub2 forall a. Ord a => a -> a -> Ordering
`compare` forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
lb1 of
    Ordering
GT ->
      forall x. Interval x -> Interval x -> Interval x -> Adjacency x
OverlappedBy
        (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 (forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb1))
        (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 SomeBound (Levitated x)
ub2)
        (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (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
_)) ->
        forall x. Interval x -> Interval x -> Interval x -> Adjacency x
MetBy
          (forall x. Ord x => Interval x -> Interval x
openUpper Interval x
i2)
          (forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 SomeBound (Levitated x)
ub2)
          (forall x. Ord x => Interval x -> Interval x
openLower Interval x
i1)
      (SomeBound (Levitated x), SomeBound (Levitated x))
_ -> forall x. Interval x -> Interval x -> Adjacency x
After Interval x
i2 Interval x
i1
    Ordering
LT -> forall x. Interval x -> Interval x -> Adjacency x
After Interval x
i2 Interval x
i1
 where
  (SomeBound (Levitated x)
lb1, SomeBound (Levitated x)
ub1) = forall x.
Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
bounds Interval x
i1
  (SomeBound (Levitated x)
lb2, SomeBound (Levitated x)
ub2) = 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 (3 :|>: 4)
--
-- >>> intersect (2 :<>: 4) (4 :||: 5)
-- Nothing
--
-- >>> intersect (1 :<>: 4) (2 :||: 3)
-- Just (2 :||: 3)
--
-- @
intersect ::
  forall x.
  (Ord x) =>
  Interval x ->
  Interval x ->
  Maybe (Interval x)
intersect :: forall x. Ord x => Interval x -> Interval x -> Maybe (Interval x)
intersect Interval x
i1 Interval x
i2 = case forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 of
  Before Interval x
_ Interval x
_ -> forall a. Maybe a
Nothing
  Meets Interval x
_ Interval x
j Interval x
_ -> forall a. a -> Maybe a
Just Interval x
j
  Overlaps Interval x
_ Interval x
j Interval x
_ -> forall a. a -> Maybe a
Just Interval x
j
  Starts Interval x
i Interval x
_ -> forall a. a -> Maybe a
Just Interval x
i
  During Interval x
_ Interval x
j Interval x
_ -> forall a. a -> Maybe a
Just Interval x
j
  Finishes Interval x
_ Interval x
j -> forall a. a -> Maybe a
Just Interval x
j
  Identical Interval x
i -> forall a. a -> Maybe a
Just Interval x
i
  FinishedBy Interval x
_ Interval x
j -> forall a. a -> Maybe a
Just Interval x
j
  Contains Interval x
_ Interval x
j Interval x
_ -> forall a. a -> Maybe a
Just Interval x
j
  StartedBy Interval x
i Interval x
_ -> forall a. a -> Maybe a
Just Interval x
i
  OverlappedBy Interval x
_ Interval x
j Interval x
_ -> forall a. a -> Maybe a
Just Interval x
j
  MetBy Interval x
_ Interval x
j Interval x
_ -> forall a. a -> Maybe a
Just Interval x
j
  After Interval x
_ 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 :: forall x.
Ord x =>
Interval x -> Interval x -> OneOrTwo (Interval x)
union Interval x
i1 Interval x
i2 = case 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
    | forall a b. (a, b) -> a
fst (forall x. Ord x => Interval x -> (Levitated x, Extremum)
upperBound Interval x
i) forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (forall x. Ord x => Interval x -> (Levitated x, Extremum)
lowerBound Interval x
j) -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j
    | Bool
otherwise -> forall x. x -> x -> OneOrTwo x
Two Interval x
i Interval x
j
  Meets Interval x
i Interval x
_ Interval x
k -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
k
  Overlaps Interval x
i Interval x
_ Interval x
k -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
k
  Starts Interval x
i Interval x
j -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j
  During Interval x
i Interval x
_ Interval x
k -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
k
  Finishes Interval x
i Interval x
j -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j
  Identical Interval x
i -> forall x. x -> OneOrTwo x
One Interval x
i
  FinishedBy Interval x
i Interval x
j -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j
  Contains Interval x
i Interval x
_ Interval x
k -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
k
  StartedBy Interval x
i Interval x
j -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j
  OverlappedBy Interval x
i Interval x
_ Interval x
k -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
k
  MetBy Interval x
i Interval x
_ Interval x
k -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
k
  After Interval x
i Interval x
j
    | forall a b. (a, b) -> a
fst (forall x. Ord x => Interval x -> (Levitated x, Extremum)
upperBound Interval x
i) forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (forall x. Ord x => Interval x -> (Levitated x, Extremum)
lowerBound Interval x
j) -> forall x. x -> OneOrTwo x
One forall a b. (a -> b) -> a -> b
$ forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j
    | Bool
otherwise -> 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 :: forall x. Ord x => [Interval x] -> [Interval x]
unions = forall x. Ord x => [Interval x] -> [Interval x]
unionsAsc forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall x. Ord x => [Interval x] -> [Interval x]
unionsAsc = \case
  Interval x
i : Interval x
j : [Interval x]
is -> case Interval x
i forall x.
Ord x =>
Interval x -> Interval x -> OneOrTwo (Interval x)
`union` Interval x
j of
    One Interval x
k -> forall x. Ord x => [Interval x] -> [Interval x]
unionsAsc (Interval x
k forall a. a -> [a] -> [a]
: [Interval x]
is)
    OneOrTwo (Interval x)
_ -> Interval x
i forall a. a -> [a] -> [a]
: forall x. Ord x => [Interval x] -> [Interval x]
unionsAsc (Interval x
j forall a. a -> [a] -> [a]
: [Interval x]
is)
  [Interval x]
x -> [Interval x]
x

-- | Take the complement of the interval, as possibly 'OneOrTwo'.
--
-- @
--
-- >>> complement (3 :<>: 4)
-- Just (Two (Bottom :|-|: Levitate 3) (Levitate 4 :|-|: Top))
--
-- @
--
-- Note that infinitely-open intervals will return the points at infinity
-- toward which they are infinite in their result:
--
-- @
--
-- >>> complement (Levitate 3 :<->: Top)
-- Just (Two (Bottom :|-|: Levitate 3) (Top :|-|: Top))
--
-- @
complement ::
  forall x.
  (Ord x) =>
  Interval x ->
  Maybe (OneOrTwo (Interval x))
complement :: forall x. Ord x => Interval x -> Maybe (OneOrTwo (Interval x))
complement = \case
  Interval x
Whole -> forall a. Maybe a
Nothing
  Levitated x
Bottom :|-|: Levitated x
u -> forall a. a -> Maybe a
Just (forall x. x -> OneOrTwo x
One (Levitated x
u forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: forall a. Levitated a
Top))
  Levitated x
Bottom :|->: Levitated x
u -> forall a. a -> Maybe a
Just (forall x. x -> OneOrTwo x
One (Levitated x
u forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: forall a. Levitated a
Top))
  Levitated x
Bottom :<-|: Levitated x
u -> forall a. a -> Maybe a
Just (forall x. x -> x -> OneOrTwo x
Two (forall a. Levitated a
Bottom forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: forall a. Levitated a
Bottom) (Levitated x
u forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: forall a. Levitated a
Top))
  Levitated x
Bottom :<->: Levitated x
u -> forall a. a -> Maybe a
Just (forall x. x -> x -> OneOrTwo x
Two (forall a. Levitated a
Bottom forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: forall a. Levitated a
Bottom) (Levitated x
u forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: forall a. Levitated a
Top))
  --
  Levitated x
l :|-|: Levitated x
Top -> forall a. a -> Maybe a
Just (forall x. x -> OneOrTwo x
One (forall a. Levitated a
Bottom forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
l))
  Levitated x
l :<-|: Levitated x
Top -> forall a. a -> Maybe a
Just (forall x. x -> OneOrTwo x
One (forall a. Levitated a
Bottom forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
l))
  Levitated x
l :|->: Levitated x
Top -> forall a. a -> Maybe a
Just (forall x. x -> x -> OneOrTwo x
Two (forall a. Levitated a
Bottom forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
l) (forall a. Levitated a
Top forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: forall a. Levitated a
Top))
  Levitated x
l :<->: Levitated x
Top -> forall a. a -> Maybe a
Just (forall x. x -> x -> OneOrTwo x
Two (forall a. Levitated a
Bottom forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
l) (forall a. Levitated a
Top forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: forall a. Levitated a
Top))
  --
  Levitated x
l :|-|: Levitated x
u -> forall a. a -> Maybe a
Just (forall x. x -> x -> OneOrTwo x
Two (forall a. Levitated a
Bottom forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
l) (Levitated x
u forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: forall a. Levitated a
Top))
  Levitated x
l :|->: Levitated x
u -> forall a. a -> Maybe a
Just (forall x. x -> x -> OneOrTwo x
Two (forall a. Levitated a
Bottom forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
l) (Levitated x
u forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: forall a. Levitated a
Top))
  Levitated x
l :<-|: Levitated x
u -> forall a. a -> Maybe a
Just (forall x. x -> x -> OneOrTwo x
Two (forall a. Levitated a
Bottom forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
l) (Levitated x
u forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: forall a. Levitated a
Top))
  Levitated x
l :<->: Levitated x
u -> forall a. a -> Maybe a
Just (forall x. x -> x -> OneOrTwo x
Two (forall a. Levitated a
Bottom forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
l) (Levitated x
u forall x. Ord x => Levitated x -> Levitated x -> Interval 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 (1 :<>: 2) (3 :<>: 4))
--
-- >>> difference (1 :|>: 4) (0 :||: 1)
-- Just (One (1 :<>: 4))
--
-- >>> difference (1 :<>: 4) (0 :||: 1)
-- Just (One (1 :<>: 4))
--
-- @
difference ::
  forall x.
  (Ord x) =>
  Interval x ->
  Interval x ->
  Maybe (OneOrTwo (Interval x))
difference :: forall x.
Ord x =>
Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
difference Interval x
i1 Interval x
i2 = case 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
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. x -> OneOrTwo x
One Interval x
i
  Meets Interval x
i Interval x
_ Interval x
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. x -> OneOrTwo x
One Interval x
i
  Overlaps Interval x
i Interval x
_ Interval x
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. x -> OneOrTwo x
One Interval x
i
  Starts{} -> forall a. Maybe a
Nothing
  During{} -> forall a. Maybe a
Nothing
  Finishes{} -> forall a. Maybe a
Nothing
  Identical{} -> forall a. Maybe a
Nothing
  FinishedBy Interval x
i Interval x
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. x -> OneOrTwo x
One Interval x
i
  Contains Interval x
i Interval x
_ Interval x
k -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. x -> x -> OneOrTwo x
Two Interval x
i Interval x
k
  StartedBy Interval x
_ Interval x
j -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. x -> OneOrTwo x
One Interval x
j
  OverlappedBy Interval x
_ Interval x
_ Interval x
k -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. x -> OneOrTwo x
One Interval x
k
  MetBy Interval x
_ Interval x
_ Interval x
k -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. x -> OneOrTwo x
One Interval x
k
  After Interval x
_ Interval x
j -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. x -> OneOrTwo x
One Interval x
j

-- | Infix synonym for 'difference'
(\\) ::
  forall x.
  (Ord x) =>
  Interval x ->
  Interval x ->
  Maybe (OneOrTwo (Interval x))
\\ :: forall x.
Ord 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 (1 :<>: 2) (3 :<>: 4))
--
-- @
symmetricDifference ::
  forall x.
  (Ord x) =>
  Interval x ->
  Interval x ->
  Maybe (OneOrTwo (Interval x))
symmetricDifference :: forall x.
Ord x =>
Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
symmetricDifference Interval x
i1 Interval x
i2 = case Interval x
i1 forall x.
Ord x =>
Interval x -> Interval x -> OneOrTwo (Interval x)
`union` Interval x
i2 of
  Two Interval x
j1 Interval x
j2 -> forall a. a -> Maybe a
Just (forall x. x -> x -> OneOrTwo x
Two Interval x
j1 Interval x
j2)
  One Interval x
u -> case Interval x
i1 forall x. Ord x => Interval x -> Interval x -> Maybe (Interval x)
`intersect` Interval x
i2 of
    Maybe (Interval x)
Nothing -> forall a. a -> Maybe a
Just (forall x. x -> OneOrTwo x
One Interval x
u)
    Just Interval x
i -> 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 :: forall x. (Ord x, Num x) => Interval x -> Maybe x
measure = forall y x.
(Ord x, Num y) =>
(x -> x -> y) -> Interval x -> Maybe y
measuring 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 (*) (4 :<>: 6)
-- Just 24
--
-- @
measuring ::
  forall y x.
  (Ord x, Num y) =>
  (x -> x -> y) ->
  Interval x ->
  Maybe y
measuring :: forall y x.
(Ord x, Num y) =>
(x -> x -> y) -> Interval x -> Maybe y
measuring x -> x -> y
f = \case
  Levitate x
l :---: Levitate x
u -> forall a. a -> Maybe a
Just (x -> x -> y
f x
l x
u)
  Levitated x
l :---: Levitated x
u
    | Levitated x
l forall a. Eq a => a -> a -> Bool
== Levitated x
u -> forall a. a -> Maybe a
Just y
0
    | Bool
otherwise -> 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 :: forall x. (Ord x, Num x) => Interval x -> Interval x -> Maybe x
hausdorff Interval x
i1 Interval x
i2 = case forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 of
  Before (Levitated x
_ :---: Levitated x
a) (Levitated x
b :---: Levitated x
_) -> forall {a}. Levitated a -> Maybe a
levMaybe forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-) Levitated x
b Levitated x
a
  After (Levitated x
_ :---: Levitated x
a) (Levitated x
b :---: Levitated x
_) -> forall {a}. Levitated a -> Maybe a
levMaybe forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-) Levitated x
b Levitated x
a
  Adjacency x
_ -> forall a. a -> Maybe a
Just x
0
 where
  levMaybe :: Levitated a -> Maybe a
levMaybe = forall b a. b -> (a -> b) -> b -> Levitated a -> b
foldLevitated forall a. Maybe a
Nothing forall a. a -> Maybe a
Just forall a. Maybe a
Nothing

-- | @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 +/- :: forall x. (Ord x, Num x) => x -> x -> Interval x
+/- x
r = x
m forall a. Num a => a -> a -> a
- x
r forall x. Ord x => x -> x -> Interval x
:||: x
m forall a. Num a => a -> a -> a
+ x
r

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