-- |
-- Module       : Data.Interval
-- Copyright    : (c) Melanie Brown 2023
-- License      : BSD3 (see the file LICENSE)
--
-- Intervals over types and their operations.
module Data.Interval (
  -- * The Interval type
  Interval,

  -- ** Construction

  -- *** Finite intervals
  pattern (:<>:),
  pattern (:<|:),
  pattern (:|>:),
  pattern (:||:),
  pattern (:--:),

  -- *** Possibly-infinite intervals

  -- |
  -- The first four form a @{-# COMPLETE #-}@ set of bidirectional patterns,
  -- and the final is a @{-# COMPLETE #-}@ unidirectional pattern on its own.
  pattern (:<->:),
  pattern (:<-|:),
  pattern (:|->:),
  pattern (:|-|:),
  pattern (:---:),

  -- *** Miscellaneous constructors
  pattern Whole,
  (+/-),
  (...),
  interval,
  point,

  -- ** Deconstruction
  bounds,
  lower,
  lowerBound,
  upper,
  upperBound,
  imin,
  iinf,
  isup,
  imax,

  -- ** Modification
  imap,
  imapLev,
  itraverse,
  itraverseLev,
  open,
  close,
  openclosed,
  closedopen,
  openLower,
  closedLower,
  openUpper,
  closedUpper,
  setLower,
  setUpper,

  -- * Computing with intervals
  Adjacency (..),
  hull,
  hulls,
  within,
  converseAdjacency,
  adjacency,
  intersect,
  union,
  unions,
  unionsAsc,
  complement,
  difference,
  (\\),
  symmetricDifference,
  measure,
  measuring,
  hausdorff,
  isSubsetOf,

  -- * Bounds
  Extremum (..),
  opposite,
  Bound (..),
  unBound,
  Bounding (..),
  compareBounds,
  SomeBound (..),
  unSomeBound,
  oppose,

  -- * Re-exports
  OneOrTwo (..),
) where

import Algebra.Lattice.Levitated (Levitated (..), foldLevitated)
import Control.Applicative (liftA2)
import Control.DeepSeq
import Control.Monad (join)
import Data.Data
import Data.Function (on)
import Data.Functor.Const (Const (Const))
import Data.Hashable (Hashable (..))
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
(Extremum -> Extremum -> Bool)
-> (Extremum -> Extremum -> Bool) -> Eq Extremum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Extremum -> Extremum -> Bool
== :: Extremum -> Extremum -> Bool
$c/= :: Extremum -> Extremum -> Bool
/= :: Extremum -> Extremum -> Bool
Eq, Eq Extremum
Eq Extremum =>
(Extremum -> Extremum -> Ordering)
-> (Extremum -> Extremum -> Bool)
-> (Extremum -> Extremum -> Bool)
-> (Extremum -> Extremum -> Bool)
-> (Extremum -> Extremum -> Bool)
-> (Extremum -> Extremum -> Extremum)
-> (Extremum -> Extremum -> Extremum)
-> Ord Extremum
Extremum -> Extremum -> Bool
Extremum -> Extremum -> Ordering
Extremum -> Extremum -> Extremum
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Extremum -> Extremum -> Ordering
compare :: Extremum -> Extremum -> Ordering
$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
>= :: Extremum -> Extremum -> Bool
$cmax :: Extremum -> Extremum -> Extremum
max :: Extremum -> Extremum -> Extremum
$cmin :: Extremum -> Extremum -> Extremum
min :: Extremum -> Extremum -> Extremum
Ord, Int -> Extremum
Extremum -> Int
Extremum -> [Extremum]
Extremum -> Extremum
Extremum -> Extremum -> [Extremum]
Extremum -> Extremum -> Extremum -> [Extremum]
(Extremum -> Extremum)
-> (Extremum -> Extremum)
-> (Int -> Extremum)
-> (Extremum -> Int)
-> (Extremum -> [Extremum])
-> (Extremum -> Extremum -> [Extremum])
-> (Extremum -> Extremum -> [Extremum])
-> (Extremum -> Extremum -> Extremum -> [Extremum])
-> Enum Extremum
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Extremum -> Extremum
succ :: Extremum -> Extremum
$cpred :: Extremum -> Extremum
pred :: Extremum -> Extremum
$ctoEnum :: Int -> Extremum
toEnum :: Int -> Extremum
$cfromEnum :: Extremum -> Int
fromEnum :: Extremum -> Int
$cenumFrom :: Extremum -> [Extremum]
enumFrom :: Extremum -> [Extremum]
$cenumFromThen :: Extremum -> Extremum -> [Extremum]
enumFromThen :: Extremum -> Extremum -> [Extremum]
$cenumFromTo :: Extremum -> Extremum -> [Extremum]
enumFromTo :: Extremum -> Extremum -> [Extremum]
$cenumFromThenTo :: Extremum -> Extremum -> Extremum -> [Extremum]
enumFromThenTo :: Extremum -> Extremum -> Extremum -> [Extremum]
Enum, Extremum
Extremum -> Extremum -> Bounded Extremum
forall a. a -> a -> Bounded a
$cminBound :: Extremum
minBound :: Extremum
$cmaxBound :: Extremum
maxBound :: Extremum
Bounded, Int -> Extremum -> ShowS
[Extremum] -> ShowS
Extremum -> [Char]
(Int -> Extremum -> ShowS)
-> (Extremum -> [Char]) -> ([Extremum] -> ShowS) -> Show Extremum
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Extremum -> ShowS
showsPrec :: Int -> Extremum -> ShowS
$cshow :: Extremum -> [Char]
show :: Extremum -> [Char]
$cshowList :: [Extremum] -> ShowS
showList :: [Extremum] -> ShowS
Show, ReadPrec [Extremum]
ReadPrec Extremum
Int -> ReadS Extremum
ReadS [Extremum]
(Int -> ReadS Extremum)
-> ReadS [Extremum]
-> ReadPrec Extremum
-> ReadPrec [Extremum]
-> Read Extremum
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Extremum
readsPrec :: Int -> ReadS Extremum
$creadList :: ReadS [Extremum]
readList :: ReadS [Extremum]
$creadPrec :: ReadPrec Extremum
readPrec :: ReadPrec Extremum
$creadListPrec :: ReadPrec [Extremum]
readListPrec :: ReadPrec [Extremum]
Read, (forall x. Extremum -> Rep Extremum x)
-> (forall x. Rep Extremum x -> Extremum) -> Generic Extremum
forall x. Rep Extremum x -> Extremum
forall x. Extremum -> Rep Extremum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Extremum -> Rep Extremum x
from :: forall x. Extremum -> Rep Extremum x
$cto :: forall x. Rep Extremum x -> Extremum
to :: forall x. Rep Extremum x -> Extremum
Generic, Typeable Extremum
Typeable Extremum =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Extremum -> c Extremum)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Extremum)
-> (Extremum -> Constr)
-> (Extremum -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Extremum))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extremum))
-> ((forall b. Data b => b -> b) -> Extremum -> Extremum)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Extremum -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Extremum -> r)
-> (forall u. (forall d. Data d => d -> u) -> Extremum -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Extremum -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Extremum -> m Extremum)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Extremum -> m Extremum)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Extremum -> m Extremum)
-> Data Extremum
Extremum -> Constr
Extremum -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extremum -> c Extremum
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Extremum -> c Extremum
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extremum
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Extremum
$ctoConstr :: Extremum -> Constr
toConstr :: Extremum -> Constr
$cdataTypeOf :: Extremum -> DataType
dataTypeOf :: Extremum -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Extremum)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Extremum)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extremum)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Extremum)
$cgmapT :: (forall b. Data b => b -> b) -> Extremum -> Extremum
gmapT :: (forall b. Data b => b -> b) -> Extremum -> Extremum
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Extremum -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Extremum -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Extremum -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Extremum -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Extremum -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Extremum -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extremum -> m Extremum
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Extremum -> m 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 :: (a -> b) -> Bound ext a -> Bound ext b
  fmap :: forall a b. (a -> b) -> Bound ext a -> Bound ext b
fmap a -> b
f = \case
    Min a
x -> b -> Bound 'Minimum b
forall x. x -> Bound 'Minimum x
Min (a -> b
f a
x)
    Inf a
x -> b -> Bound 'Infimum b
forall x. x -> Bound 'Infimum x
Inf (a -> b
f a
x)
    Sup a
x -> b -> Bound 'Supremum b
forall x. x -> Bound 'Supremum x
Sup (a -> b
f a
x)
    Max a
x -> b -> Bound 'Maximum b
forall x. x -> Bound 'Maximum x
Max (a -> b
f a
x)

instance Foldable (Bound ext) where
  foldMap :: (Monoid m) => (a -> m) -> Bound ext a -> m
  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 :: (Applicative f) => (a -> f b) -> Bound ext a -> f (Bound ext b)
  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 -> b -> Bound ext b
b -> Bound 'Minimum b
forall x. x -> Bound 'Minimum x
Min (b -> Bound ext b) -> f b -> f (Bound ext b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    Inf a
x -> b -> Bound ext b
b -> Bound 'Infimum b
forall x. x -> Bound 'Infimum x
Inf (b -> Bound ext b) -> f b -> f (Bound ext b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    Sup a
x -> b -> Bound ext b
b -> Bound 'Supremum b
forall x. x -> Bound 'Supremum x
Sup (b -> Bound ext b) -> f b -> f (Bound ext b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    Max a
x -> b -> Bound ext b
b -> Bound 'Maximum b
forall x. x -> Bound 'Maximum x
Max (b -> Bound ext b) -> f b -> f (Bound ext b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

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

instance (Ord x) => Ord (Bound ext (Levitated x)) where
  compare ::
    (Ord x) => Bound ext (Levitated x) -> Bound ext (Levitated x) -> Ordering
  compare :: Ord x =>
Bound ext (Levitated x) -> Bound ext (Levitated x) -> Ordering
compare = Bound ext (Levitated x) -> Bound ext (Levitated x) -> Ordering
forall x (ext1 :: Extremum) (ext2 :: Extremum).
Ord x =>
Bound ext1 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 :: x -> Bound Minimum x
  bound :: forall x. x -> Bound 'Minimum x
bound = x -> Bound 'Minimum x
forall x. x -> Bound 'Minimum x
Min

  opposeBound :: Bound Minimum x -> Bound Supremum x
  opposeBound :: forall x. Bound 'Minimum x -> Bound 'Supremum x
opposeBound (Min x
x) = x -> Bound 'Supremum x
forall x. x -> Bound 'Supremum x
Sup x
x

instance Bounding Infimum where
  type Opposite Infimum = Maximum

  bound :: x -> Bound Infimum x
  bound :: forall x. x -> Bound 'Infimum x
bound = x -> Bound 'Infimum x
forall x. x -> Bound 'Infimum x
Inf

  opposeBound :: Bound Infimum x -> Bound Maximum x
  opposeBound :: forall x. Bound 'Infimum x -> Bound 'Maximum x
opposeBound (Inf x
x) = x -> Bound 'Maximum x
forall x. x -> Bound 'Maximum x
Max x
x

instance Bounding Supremum where
  type Opposite Supremum = Minimum

  bound :: x -> Bound Supremum x
  bound :: forall x. x -> Bound 'Supremum x
bound = x -> Bound 'Supremum x
forall x. x -> Bound 'Supremum x
Sup

  opposeBound :: Bound Supremum x -> Bound Minimum x
  opposeBound :: forall x. Bound 'Supremum x -> Bound 'Minimum x
opposeBound (Sup x
x) = x -> Bound 'Minimum x
forall x. x -> Bound 'Minimum x
Min x
x

instance Bounding Maximum where
  type Opposite Maximum = Infimum

  bound :: x -> Bound Maximum x
  bound :: forall x. x -> Bound 'Maximum x
bound = x -> Bound 'Maximum x
forall x. x -> Bound 'Maximum x
Max

  opposeBound :: Bound Maximum x -> Bound Infimum x
  opposeBound :: forall x. Bound 'Maximum x -> Bound 'Infimum x
opposeBound (Max x
x) = x -> Bound 'Infimum x
forall x. x -> Bound 'Infimum x
Inf x
x

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

instance (Ord x) => Ord (SomeBound (Levitated x)) where
  compare ::
    (Ord x) => SomeBound (Levitated x) -> SomeBound (Levitated x) -> Ordering
  SomeBound Bound ext (Levitated x)
b0 compare :: Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Ordering
`compare` SomeBound Bound ext (Levitated x)
b1 = Bound ext (Levitated x) -> Bound ext (Levitated x) -> Ordering
forall x (ext1 :: Extremum) (ext2 :: Extremum).
Ord x =>
Bound ext1 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) = Bound (Opposite ext) x -> SomeBound x
forall x (ext :: Extremum).
(Bounding ext, Bounding (Opposite ext)) =>
Bound ext x -> SomeBound x
SomeBound (Bound ext x -> Bound (Opposite ext) x
forall x. Bound ext x -> Bound (Opposite ext) x
forall (ext :: Extremum) x.
Bounding ext =>
Bound ext x -> Bound (Opposite ext) x
opposeBound Bound ext x
b)

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

infix 5 :<-->:

infix 5 :<--|:

infix 5 :|-->:

infix 5 :|--|:

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

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

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

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

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

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

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

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

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

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

-- |
-- 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, 'Bottom' ':|-|:' 'Top'.
pattern Whole :: (Ord x) => Interval x
pattern $mWhole :: forall {r} {x}.
Ord x =>
Interval x -> ((# #) -> r) -> ((# #) -> r) -> r
$bWhole :: forall x. Ord x => Interval x
Whole = Bottom :|-|: Top

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

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

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

instance (Ord x, Data x) => Data (Interval x) where
  gfoldl ::
    (Ord x, Data x) =>
    (forall d b. (Data d) => c (d -> b) -> d -> c b) ->
    (forall g. g -> c g) ->
    Interval x ->
    c (Interval x)
  gfoldl :: forall (c :: * -> *).
(Ord x, Data x) =>
(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 -> (Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Levitated x -> Interval x)
forall g. g -> c g
gpure Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<->:) c (Levitated x -> Levitated x -> Interval x)
-> Levitated x -> c (Levitated x -> Interval x)
forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
l c (Levitated x -> Interval x) -> Levitated x -> c (Interval x)
forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
u
    Levitated x
l :|->: Levitated x
u -> (Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Levitated x -> Interval x)
forall g. g -> c g
gpure Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|->:) c (Levitated x -> Levitated x -> Interval x)
-> Levitated x -> c (Levitated x -> Interval x)
forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
l c (Levitated x -> Interval x) -> Levitated x -> c (Interval x)
forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
u
    Levitated x
l :<-|: Levitated x
u -> (Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Levitated x -> Interval x)
forall g. g -> c g
gpure Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<-|:) c (Levitated x -> Levitated x -> Interval x)
-> Levitated x -> c (Levitated x -> Interval x)
forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
l c (Levitated x -> Interval x) -> Levitated x -> c (Interval x)
forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
u
    Levitated x
l :|-|: Levitated x
u -> (Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Levitated x -> Interval x)
forall g. g -> c g
gpure Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|-|:) c (Levitated x -> Levitated x -> Interval x)
-> Levitated x -> c (Levitated x -> Interval x)
forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
l c (Levitated x -> Interval x) -> Levitated x -> c (Interval x)
forall d b. Data d => c (d -> b) -> d -> c b
<^> Levitated x
u

  toConstr :: (Ord x, Data x) => Interval x -> Constr
  toConstr :: (Ord x, Data x) => 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 :: (Ord x, Data x) => Interval x -> DataType
  dataTypeOf :: (Ord x, Data x) => Interval x -> DataType
dataTypeOf Interval x
_ = DataType
intervalDataType

  gunfold ::
    (Ord x, Data x) =>
    (forall b r. (Data b) => c (b -> r) -> c r) ->
    (forall r. r -> c r) ->
    Constr ->
    c (Interval x)
  gunfold :: forall (c :: * -> *).
(Ord x, Data x) =>
(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 -> c (Levitated x -> Interval x) -> c (Interval x)
forall b r. Data b => c (b -> r) -> c r
k (c (Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Interval x)
forall b r. Data b => c (b -> r) -> c r
k ((Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Levitated x -> Interval x)
forall r. r -> c r
gpure Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<->:)))
    Int
1 -> c (Levitated x -> Interval x) -> c (Interval x)
forall b r. Data b => c (b -> r) -> c r
k (c (Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Interval x)
forall b r. Data b => c (b -> r) -> c r
k ((Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Levitated x -> Interval x)
forall r. r -> c r
gpure Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|->:)))
    Int
2 -> c (Levitated x -> Interval x) -> c (Interval x)
forall b r. Data b => c (b -> r) -> c r
k (c (Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Interval x)
forall b r. Data b => c (b -> r) -> c r
k ((Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Levitated x -> Interval x)
forall r. r -> c r
gpure Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:<-|:)))
    Int
3 -> c (Levitated x -> Interval x) -> c (Interval x)
forall b r. Data b => c (b -> r) -> c r
k (c (Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Interval x)
forall b r. Data b => c (b -> r) -> c r
k ((Levitated x -> Levitated x -> Interval x)
-> c (Levitated x -> Levitated x -> Interval x)
forall r. r -> c r
gpure Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
(:|-|:)))
    Int
_ -> [Char] -> c (Interval x)
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 :: (Ord x, Generic x) => Interval x -> Rep (Interval x) x1
  from :: forall x1. (Ord x, Generic x) => Interval x -> Rep (Interval x) x1
from = \case
    Levitated x
l :<->: Levitated x
u -> ((Levitated x, Extremum) -> Const (Levitated x, Extremum) x1
forall {k} a (b :: k). a -> Const a b
Const (Levitated x
l, Extremum
Infimum) Const (Levitated x, Extremum) x1
-> Const (Levitated x, Extremum) x1
-> (:*:)
     (Const (Levitated x, Extremum)) (Const (Levitated x, Extremum)) x1
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (Levitated x, Extremum) -> Const (Levitated x, Extremum) x1
forall {k} a (b :: k). a -> Const a b
Const (Levitated x
u, Extremum
Supremum))
    Levitated x
l :|->: Levitated x
u -> ((Levitated x, Extremum) -> Const (Levitated x, Extremum) x1
forall {k} a (b :: k). a -> Const a b
Const (Levitated x
l, Extremum
Minimum) Const (Levitated x, Extremum) x1
-> Const (Levitated x, Extremum) x1
-> (:*:)
     (Const (Levitated x, Extremum)) (Const (Levitated x, Extremum)) x1
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (Levitated x, Extremum) -> Const (Levitated x, Extremum) x1
forall {k} a (b :: k). a -> Const a b
Const (Levitated x
u, Extremum
Supremum))
    Levitated x
l :<-|: Levitated x
u -> ((Levitated x, Extremum) -> Const (Levitated x, Extremum) x1
forall {k} a (b :: k). a -> Const a b
Const (Levitated x
l, Extremum
Infimum) Const (Levitated x, Extremum) x1
-> Const (Levitated x, Extremum) x1
-> (:*:)
     (Const (Levitated x, Extremum)) (Const (Levitated x, Extremum)) x1
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (Levitated x, Extremum) -> Const (Levitated x, Extremum) x1
forall {k} a (b :: k). a -> Const a b
Const (Levitated x
u, Extremum
Maximum))
    Levitated x
l :|-|: Levitated x
u -> ((Levitated x, Extremum) -> Const (Levitated x, Extremum) x1
forall {k} a (b :: k). a -> Const a b
Const (Levitated x
l, Extremum
Minimum) Const (Levitated x, Extremum) x1
-> Const (Levitated x, Extremum) x1
-> (:*:)
     (Const (Levitated x, Extremum)) (Const (Levitated x, Extremum)) x1
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (Levitated x, Extremum) -> Const (Levitated x, Extremum) x1
forall {k} a (b :: k). a -> Const a b
Const (Levitated x
u, Extremum
Maximum))

  to :: (Ord x, Generic x) => Rep (Interval x) x1 -> Interval x
  to :: forall x1. (Ord x, Generic x) => Rep (Interval x) x1 -> Interval x
to (Const (Levitated x, Extremum)
l :*: Const (Levitated x, Extremum)
u) = (Levitated x, Extremum)
l (Levitated x, Extremum) -> (Levitated x, Extremum) -> Interval x
forall x.
Ord x =>
(Levitated x, Extremum) -> (Levitated x, Extremum) -> Interval x
... (Levitated x, Extremum)
u

instance (Ord x, Hashable x) => Hashable (Interval x) where
  hashWithSalt :: (Ord x, Hashable x) => Int -> Interval x -> Int
  hashWithSalt :: (Ord x, Hashable x) => Int -> Interval x -> Int
hashWithSalt Int
s = \case
    Levitated x
l :<->: Levitated x
u -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int) Int -> Levitated x -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Levitated x
l Int -> Levitated x -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Levitated x
u
    Levitated x
l :|->: Levitated x
u -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2 :: Int) Int -> Levitated x -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Levitated x
l Int -> Levitated x -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Levitated x
u
    Levitated x
l :<-|: Levitated x
u -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
3 :: Int) Int -> Levitated x -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Levitated x
l Int -> Levitated x -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Levitated x
u
    Levitated x
l :|-|: Levitated x
u -> Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
4 :: Int) Int -> Levitated x -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Levitated x
l Int -> Levitated x -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Levitated x
u

instance (Ord x, NFData x) => NFData (Interval x) where
  rnf :: (Ord x, NFData x) => Interval x -> ()
  rnf :: (Ord x, NFData x) => Interval x -> ()
rnf (Levitated x
x :---: Levitated x
y) = Levitated x
x Levitated x -> () -> ()
forall a b. a -> b -> b
`seq` Levitated x
y Levitated x -> () -> ()
forall a b. a -> b -> b
`seq` ()

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

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

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

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

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

-- | Get the lower bound of an interval
-- (with the bound expressed at the term level).
lowerBound :: (Ord x) => Interval x -> (Levitated x, Extremum)
lowerBound :: 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 Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  (Min Levitated x
l, Max Levitated x
u) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  (Inf Levitated x
l, Sup Levitated x
u) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  (Inf Levitated x
l, Max Levitated x
u) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  (Sup Levitated x
u, Min Levitated x
l) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  (Sup Levitated x
u, Inf Levitated x
l) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  (Max Levitated x
u, Min Levitated x
l) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  (Max Levitated x
u, Inf Levitated x
l) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  (Bound ext (Levitated x), Bound ext (Levitated x))
_ -> [Char] -> Interval 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 Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  (Extremum
Minimum, Extremum
Maximum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  (Extremum
Infimum, Extremum
Supremum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  (Extremum
Infimum, Extremum
Maximum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  (Extremum
Supremum, Extremum
Minimum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|->: Levitated x
u
  (Extremum
Supremum, Extremum
Infimum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u
  (Extremum
Maximum, Extremum
Minimum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:|-|: Levitated x
u
  (Extremum
Maximum, Extremum
Infimum) -> Levitated x
l Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<-|: Levitated x
u
  (Extremum, Extremum)
_ -> [Char] -> Interval x
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot make an interval with the given bounds"
 where
  l :: Levitated x
l = Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
min Levitated x
x Levitated x
y
  u :: Levitated x
u = Levitated x -> Levitated x -> Levitated x
forall a. Ord a => a -> a -> a
max Levitated x
x Levitated x
y

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

-- | 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 ((Interval x -> SomeBound (Levitated x))
-> Interval x -> Interval x -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i1 Interval x
i2, (Interval x -> SomeBound (Levitated x))
-> Interval x -> Interval x -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
i1 Interval x
i2) of
  (Ordering
LT, Ordering
LT) -> case SomeBound (Levitated x) -> Levitated x
forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
ub1 Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` SomeBound (Levitated x) -> Levitated x
forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
lb2 of
    Ordering
LT -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
Before Interval x
i1 Interval x
i2
    Ordering
EQ -> case (SomeBound (Levitated x)
ub1, SomeBound (Levitated x)
lb2) of
      (SomeBound (Max Levitated x
_), SomeBound (Min Levitated x
_)) ->
        Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Meets
          (Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x
openUpper Interval x
i1)
          (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 SomeBound (Levitated x)
ub1)
          (Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x
openLower Interval x
i2)
      (SomeBound (Levitated x), SomeBound (Levitated x))
_ -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
Before Interval x
i1 Interval x
i2
    Ordering
GT ->
      Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Overlaps
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb2))
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 SomeBound (Levitated x)
ub1)
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub1) SomeBound (Levitated x)
ub2)
  (Ordering
LT, Ordering
EQ) ->
    Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
Finishes
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb2))
      Interval x
i2
  (Ordering
LT, Ordering
GT) ->
    Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
Contains
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb2))
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 SomeBound (Levitated x)
ub2)
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub2) SomeBound (Levitated x)
ub1)
  (Ordering
EQ, Ordering
LT) ->
    Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
Starts
      Interval x
i1
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub1) SomeBound (Levitated x)
ub2)
  (Ordering
EQ, Ordering
EQ) -> Interval x -> Adjacency x
forall x. Interval x -> Adjacency x
Identical Interval x
i1
  (Ordering
EQ, Ordering
GT) ->
    Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
StartedBy
      Interval x
i2
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub2) SomeBound (Levitated x)
ub1)
  (Ordering
GT, Ordering
LT) ->
    Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
During
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb1))
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 SomeBound (Levitated x)
ub1)
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub1) SomeBound (Levitated x)
ub2)
  (Ordering
GT, Ordering
EQ) ->
    Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
FinishedBy
      (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb1))
      Interval x
i1
  (Ordering
GT, Ordering
GT) -> case SomeBound (Levitated x) -> Levitated x
forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
ub2 Levitated x -> Levitated x -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` SomeBound (Levitated x) -> Levitated x
forall x. Ord x => SomeBound x -> x
unSomeBound SomeBound (Levitated x)
lb1 of
    Ordering
GT ->
      Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
OverlappedBy
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb2 (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
lb1))
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 SomeBound (Levitated x)
ub2)
        (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (SomeBound (Levitated x) -> SomeBound (Levitated x)
forall x. SomeBound x -> SomeBound x
oppose SomeBound (Levitated x)
ub2) SomeBound (Levitated x)
ub1)
    Ordering
EQ -> case (SomeBound (Levitated x)
ub2, SomeBound (Levitated x)
lb1) of
      (SomeBound (Max Levitated x
_), SomeBound (Min Levitated x
_)) ->
        Interval x -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Interval x -> Adjacency x
MetBy
          (Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x
openUpper Interval x
i2)
          (SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval SomeBound (Levitated x)
lb1 SomeBound (Levitated x)
ub2)
          (Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x
openLower Interval x
i1)
      (SomeBound (Levitated x), SomeBound (Levitated x))
_ -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
After Interval x
i2 Interval x
i1
    Ordering
LT -> Interval x -> Interval x -> Adjacency x
forall x. Interval x -> Interval x -> Adjacency x
After Interval x
i2 Interval x
i1
 where
  (SomeBound (Levitated x)
lb1, SomeBound (Levitated x)
ub1) = Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
forall x.
Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
bounds Interval x
i1
  (SomeBound (Levitated x)
lb2, SomeBound (Levitated x)
ub2) = Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
forall x.
Interval x -> (SomeBound (Levitated x), SomeBound (Levitated x))
bounds Interval x
i2

-- | 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 Interval x -> Interval x -> Adjacency x
forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 of
  Before Interval x
i Interval x
j -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
j)
  Meets Interval x
i Interval x
_ Interval x
k -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
k)
  Overlaps Interval x
i Interval x
_ Interval x
k -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
k)
  Starts Interval x
i Interval x
j -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
j)
  During Interval x
i Interval x
_ Interval x
k -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
k)
  Finishes Interval x
i Interval x
j -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
j)
  Identical Interval x
i -> Interval x
i
  FinishedBy Interval x
i Interval x
j -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
j)
  Contains Interval x
i Interval x
_ Interval x
k -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
k)
  StartedBy Interval x
i Interval x
j -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
j)
  OverlappedBy Interval x
i Interval x
_ Interval x
k -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
k)
  MetBy Interval x
i Interval x
_ Interval x
k -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
k)
  After Interval x
i Interval x
j -> SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
forall x.
Ord x =>
SomeBound (Levitated x) -> SomeBound (Levitated x) -> Interval x
interval (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
lower Interval x
i) (Interval x -> SomeBound (Levitated x)
forall x. Ord x => Interval x -> SomeBound (Levitated x)
upper Interval x
j)

-- | 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) = NonEmpty (Interval x) -> Interval x
forall x. Ord x => NonEmpty (Interval x) -> Interval x
hulls (Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j Interval x -> [Interval x] -> NonEmpty (Interval x)
forall a. a -> [a] -> NonEmpty a
:| [Interval x]
is)

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

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

-- | Get the infimum of an interval, weakening if necessary.
iinf :: (Ord x) => Interval x -> 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
_) -> Levitated x -> Maybe (Levitated x)
forall a. a -> Maybe a
Just Levitated x
x
  (Levitated x
x :|-|: Levitated x
_) -> Levitated x -> Maybe (Levitated x)
forall a. a -> Maybe a
Just Levitated x
x
  Interval x
_ -> Maybe (Levitated 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) -> Levitated x -> Maybe (Levitated x)
forall a. a -> Maybe a
Just Levitated x
x
  (Levitated x
_ :|-|: Levitated x
x) -> Levitated x -> Maybe (Levitated x)
forall a. a -> Maybe a
Just Levitated x
x
  Interval x
_ -> Maybe (Levitated 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 Levitated x -> Levitated x -> Interval x
forall x. Ord x => Levitated x -> Levitated x -> Interval x
:<->: Levitated x
u

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

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

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

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

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

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

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

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

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

-- | Calculate the 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 Interval x -> Interval x -> Adjacency x
forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 of
  Before Interval x
_ Interval x
_ -> Maybe (Interval x)
forall a. Maybe a
Nothing
  Meets Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  Overlaps Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  Starts Interval x
i Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
i
  During Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  Finishes Interval x
_ Interval x
j -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  Identical Interval x
i -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
i
  FinishedBy Interval x
_ Interval x
j -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  Contains Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  StartedBy Interval x
i Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
i
  OverlappedBy Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  MetBy Interval x
_ Interval x
j Interval x
_ -> Interval x -> Maybe (Interval x)
forall a. a -> Maybe a
Just Interval x
j
  After Interval x
_ Interval x
_ -> Maybe (Interval x)
forall a. Maybe a
Nothing

-- | Get the union of two intervals, as either 'OneOrTwo'.
--
-- @
-- >>> union (2 :||: 5) (5 :<>: 7)
-- One (2 :|>: 7)
--
-- >>> union (2 :||: 4) (5 :<>: 7)
-- Two (2 :||: 4) (5 :<>: 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 Interval x -> Interval x -> Adjacency x
forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 of
  Before Interval x
i Interval x
j
    | (Levitated x, Extremum) -> Levitated x
forall a b. (a, b) -> a
fst (Interval x -> (Levitated x, Extremum)
forall x. Ord x => Interval x -> (Levitated x, Extremum)
upperBound Interval x
i) Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== (Levitated x, Extremum) -> Levitated x
forall a b. (a, b) -> a
fst (Interval x -> (Levitated x, Extremum)
forall x. Ord x => Interval x -> (Levitated x, Extremum)
lowerBound Interval x
j) -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j)
    | Bool
otherwise -> Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two Interval x
i Interval x
j
  Meets Interval x
i Interval x
_ Interval x
k -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
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 -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
k)
  Starts Interval x
i Interval x
j -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
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 -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
k)
  Finishes Interval x
i Interval x
j -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j)
  Identical Interval x
i -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
i
  FinishedBy Interval x
i Interval x
j -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
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 -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
k)
  StartedBy Interval x
i Interval x
j -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
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 -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
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 -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
k)
  After Interval x
i Interval x
j
    | (Levitated x, Extremum) -> Levitated x
forall a b. (a, b) -> a
fst (Interval x -> (Levitated x, Extremum)
forall x. Ord x => Interval x -> (Levitated x, Extremum)
upperBound Interval x
i) Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== (Levitated x, Extremum) -> Levitated x
forall a b. (a, b) -> a
fst (Interval x -> (Levitated x, Extremum)
forall x. Ord x => Interval x -> (Levitated x, Extremum)
lowerBound Interval x
j) -> Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One (Interval x -> Interval x -> Interval x
forall x. Ord x => Interval x -> Interval x -> Interval x
hull Interval x
i Interval x
j)
    | Bool
otherwise -> Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two Interval x
i Interval x
j

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

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

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

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

-- | 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))
(\\) = 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 :||: 5)
-- Just (Two (1 :<>: 2) (4 :||: 5))
-- @
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 Interval x -> Interval x -> OneOrTwo (Interval x)
forall x.
Ord x =>
Interval x -> Interval x -> OneOrTwo (Interval x)
`union` Interval x
i2 of
  Two Interval x
j1 Interval x
j2 -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> Interval x -> OneOrTwo (Interval x)
forall x. x -> x -> OneOrTwo x
Two Interval x
j1 Interval x
j2)
  One Interval x
u -> case Interval x
i1 Interval x -> Interval x -> Maybe (Interval x)
forall x. Ord x => Interval x -> Interval x -> Maybe (Interval x)
`intersect` Interval x
i2 of
    Maybe (Interval x)
Nothing -> OneOrTwo (Interval x) -> Maybe (OneOrTwo (Interval x))
forall a. a -> Maybe a
Just (Interval x -> OneOrTwo (Interval x)
forall x. x -> OneOrTwo x
One Interval x
u)
    Just Interval x
i -> Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
forall x.
Ord x =>
Interval x -> Interval x -> Maybe (OneOrTwo (Interval x))
difference Interval x
u Interval x
i

-- | Get the measure of an interval, or 'Nothing' if the interval is infinite.
--
-- @
-- >>> 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 = (x -> x -> x) -> Interval x -> Maybe x
forall y x.
(Ord x, Num y) =>
(x -> x -> y) -> Interval x -> Maybe y
measuring x -> x -> x
forall a. Num a => a -> a -> a
subtract

-- | Apply a function to the lower, then upper, endpoint of an interval.
--
-- @
-- >>> measuring const (-1 :<>: 1)
-- Just (-1)
--
-- >>> measuring (*) (4 :<>: 6)
-- Just 24
-- @
-- > measure == measuring subtract
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 -> y -> Maybe y
forall a. a -> Maybe a
Just (x -> x -> y
f x
l x
u)
  Levitated x
l :---: Levitated x
u
    | Levitated x
l Levitated x -> Levitated x -> Bool
forall a. Eq a => a -> a -> Bool
== Levitated x
u -> y -> Maybe y
forall a. a -> Maybe a
Just y
0
    | Bool
otherwise -> Maybe y
forall a. Maybe a
Nothing

-- | Get the distance between two intervals.
--
-- @
-- >>> 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 Interval x -> Interval x -> Adjacency x
forall x. Ord x => Interval x -> Interval x -> Adjacency x
adjacency Interval x
i1 Interval x
i2 of
  Before (Levitated x
_ :---: Levitated x
a) (Levitated x
b :---: Levitated x
_) -> Levitated x -> Maybe x
forall {a}. Levitated a -> Maybe a
levMaybe (Levitated x -> Maybe x) -> Levitated x -> Maybe x
forall a b. (a -> b) -> a -> b
$ (x -> x -> x) -> Levitated x -> Levitated x -> Levitated x
forall a b c.
(a -> b -> c) -> Levitated a -> Levitated b -> Levitated c
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
_) -> Levitated x -> Maybe x
forall {a}. Levitated a -> Maybe a
levMaybe (Levitated x -> Maybe x) -> Levitated x -> Maybe x
forall a b. (a -> b) -> a -> b
$ (x -> x -> x) -> Levitated x -> Levitated x -> Levitated x
forall a b c.
(a -> b -> c) -> Levitated a -> Levitated b -> Levitated c
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
_ -> x -> Maybe x
forall a. a -> Maybe a
Just x
0
 where
  levMaybe :: Levitated a -> Maybe a
levMaybe = Maybe a -> (a -> Maybe a) -> Maybe a -> Levitated a -> Maybe a
forall b a. b -> (a -> b) -> b -> Levitated a -> b
foldLevitated Maybe a
forall a. Maybe a
Nothing a -> Maybe a
forall a. a -> Maybe a
Just Maybe a
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 x -> x -> x
forall a. Num a => a -> a -> a
- x
r x -> x -> Interval x
forall x. Ord x => x -> x -> Interval x
:||: x
m x -> x -> x
forall a. Num a => a -> a -> a
+ x
r

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