--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Interval.Internal
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Intervals
--
--------------------------------------------------------------------------------
{-# LANGUAGE UndecidableInstances #-}
module HGeometry.Interval.Internal
  ( Interval(Interval,ClosedInterval,OpenInterval)
  , ClosedInterval, OpenInterval
  , asClosedInterval, asOpenInterval, asAnInterval
  , isIntervalOfType
  , Interval_x_IntervalIntersection(..)
  ) where

import Control.Lens
import Control.Monad (guard)
import HGeometry.Intersection
import HGeometry.Interval.Class
import HGeometry.Interval.EndPoint ()
import HGeometry.Point
import HGeometry.Properties
import HGeometry.Vector
import Text.Read
import GHC.Generics (Generic)
import Control.DeepSeq

--------------------------------------------------------------------------------
-- | Data type representing intervals
newtype Interval endPoint r = MkInterval (Vector 2 (endPoint r))
  deriving newtype (Interval endPoint r -> Interval endPoint r -> Bool
(Interval endPoint r -> Interval endPoint r -> Bool)
-> (Interval endPoint r -> Interval endPoint r -> Bool)
-> Eq (Interval endPoint r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (endPoint :: k -> *) (r :: k).
Eq (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Bool
$c== :: forall k (endPoint :: k -> *) (r :: k).
Eq (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Bool
== :: Interval endPoint r -> Interval endPoint r -> Bool
$c/= :: forall k (endPoint :: k -> *) (r :: k).
Eq (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Bool
/= :: Interval endPoint r -> Interval endPoint r -> Bool
Eq,Eq (Interval endPoint r)
Eq (Interval endPoint r) =>
(Interval endPoint r -> Interval endPoint r -> Ordering)
-> (Interval endPoint r -> Interval endPoint r -> Bool)
-> (Interval endPoint r -> Interval endPoint r -> Bool)
-> (Interval endPoint r -> Interval endPoint r -> Bool)
-> (Interval endPoint r -> Interval endPoint r -> Bool)
-> (Interval endPoint r
    -> Interval endPoint r -> Interval endPoint r)
-> (Interval endPoint r
    -> Interval endPoint r -> Interval endPoint r)
-> Ord (Interval endPoint r)
Interval endPoint r -> Interval endPoint r -> Bool
Interval endPoint r -> Interval endPoint r -> Ordering
Interval endPoint r -> Interval endPoint r -> Interval endPoint r
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 k (endPoint :: k -> *) (r :: k).
Ord (endPoint r) =>
Eq (Interval endPoint r)
forall k (endPoint :: k -> *) (r :: k).
Ord (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Bool
forall k (endPoint :: k -> *) (r :: k).
Ord (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Ordering
forall k (endPoint :: k -> *) (r :: k).
Ord (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Interval endPoint r
$ccompare :: forall k (endPoint :: k -> *) (r :: k).
Ord (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Ordering
compare :: Interval endPoint r -> Interval endPoint r -> Ordering
$c< :: forall k (endPoint :: k -> *) (r :: k).
Ord (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Bool
< :: Interval endPoint r -> Interval endPoint r -> Bool
$c<= :: forall k (endPoint :: k -> *) (r :: k).
Ord (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Bool
<= :: Interval endPoint r -> Interval endPoint r -> Bool
$c> :: forall k (endPoint :: k -> *) (r :: k).
Ord (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Bool
> :: Interval endPoint r -> Interval endPoint r -> Bool
$c>= :: forall k (endPoint :: k -> *) (r :: k).
Ord (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Bool
>= :: Interval endPoint r -> Interval endPoint r -> Bool
$cmax :: forall k (endPoint :: k -> *) (r :: k).
Ord (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Interval endPoint r
max :: Interval endPoint r -> Interval endPoint r -> Interval endPoint r
$cmin :: forall k (endPoint :: k -> *) (r :: k).
Ord (endPoint r) =>
Interval endPoint r -> Interval endPoint r -> Interval endPoint r
min :: Interval endPoint r -> Interval endPoint r -> Interval endPoint r
Ord,Interval endPoint r -> ()
(Interval endPoint r -> ()) -> NFData (Interval endPoint r)
forall a. (a -> ()) -> NFData a
forall k (endPoint :: k -> *) (r :: k).
NFData (endPoint r) =>
Interval endPoint r -> ()
$crnf :: forall k (endPoint :: k -> *) (r :: k).
NFData (endPoint r) =>
Interval endPoint r -> ()
rnf :: Interval endPoint r -> ()
NFData)
  deriving stock ((forall x. Interval endPoint r -> Rep (Interval endPoint r) x)
-> (forall x. Rep (Interval endPoint r) x -> Interval endPoint r)
-> Generic (Interval endPoint r)
forall x. Rep (Interval endPoint r) x -> Interval endPoint r
forall x. Interval endPoint r -> Rep (Interval endPoint r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (endPoint :: k -> *) (r :: k) x.
Rep (Interval endPoint r) x -> Interval endPoint r
forall k (endPoint :: k -> *) (r :: k) x.
Interval endPoint r -> Rep (Interval endPoint r) x
$cfrom :: forall k (endPoint :: k -> *) (r :: k) x.
Interval endPoint r -> Rep (Interval endPoint r) x
from :: forall x. Interval endPoint r -> Rep (Interval endPoint r) x
$cto :: forall k (endPoint :: k -> *) (r :: k) x.
Rep (Interval endPoint r) x -> Interval endPoint r
to :: forall x. Rep (Interval endPoint r) x -> Interval endPoint r
Generic)

type instance NumType (Interval endPoint r) = r

-- | Construct an interval
pattern Interval     :: endPoint r -> endPoint r -> Interval endPoint r
pattern $bInterval :: forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
$mInterval :: forall {r} {k} {endPoint :: k -> *} {r :: k}.
Interval endPoint r
-> (endPoint r -> endPoint r -> r) -> ((# #) -> r) -> r
Interval s t = MkInterval (Vector2 s t)
{-# COMPLETE Interval #-}


-- | Cosed intervals (using a boxed representation)
type ClosedInterval r = Interval (EndPoint Closed) r

-- | Construct a closed interval
pattern ClosedInterval     :: r -> r -> ClosedInterval r
pattern $bClosedInterval :: forall r. r -> r -> ClosedInterval r
$mClosedInterval :: forall {r} {r}.
ClosedInterval r -> (r -> r -> r) -> ((# #) -> r) -> r
ClosedInterval s t = Interval (ClosedE s) (ClosedE t)
{-# COMPLETE ClosedInterval #-}


-- | Open intervals (using a boxed representation)
type OpenInterval r   = Interval (EndPoint Open) r

-- | Construct an open ended interval
pattern OpenInterval     :: r -> r -> OpenInterval r
pattern $bOpenInterval :: forall r. r -> r -> OpenInterval r
$mOpenInterval :: forall {r} {r}.
OpenInterval r -> (r -> r -> r) -> ((# #) -> r) -> r
OpenInterval s t = Interval (OpenE s) (OpenE t)
{-# COMPLETE OpenInterval #-}


instance Functor endPoint => Functor (Interval endPoint) where
  fmap :: forall a b. (a -> b) -> Interval endPoint a -> Interval endPoint b
fmap a -> b
f (Interval endPoint a
s endPoint a
t) = endPoint b -> endPoint b -> Interval endPoint b
forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
Interval ((a -> b) -> endPoint a -> endPoint b
forall a b. (a -> b) -> endPoint a -> endPoint b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f endPoint a
s) ((a -> b) -> endPoint a -> endPoint b
forall a b. (a -> b) -> endPoint a -> endPoint b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f endPoint a
t)
instance Foldable endPoint => Foldable (Interval endPoint) where
  foldMap :: forall m a. Monoid m => (a -> m) -> Interval endPoint a -> m
foldMap a -> m
f (Interval endPoint a
s endPoint a
t) = (a -> m) -> endPoint a -> m
forall m a. Monoid m => (a -> m) -> endPoint a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f endPoint a
s m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> endPoint a -> m
forall m a. Monoid m => (a -> m) -> endPoint a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f endPoint a
t
instance Traversable endPoint => Traversable (Interval endPoint) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Interval endPoint a -> f (Interval endPoint b)
traverse a -> f b
f (Interval endPoint a
s endPoint a
t) = endPoint b -> endPoint b -> Interval endPoint b
forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
Interval (endPoint b -> endPoint b -> Interval endPoint b)
-> f (endPoint b) -> f (endPoint b -> Interval endPoint b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> endPoint a -> f (endPoint b)
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) -> endPoint a -> f (endPoint b)
traverse a -> f b
f endPoint a
s f (endPoint b -> Interval endPoint b)
-> f (endPoint b) -> f (Interval endPoint b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> endPoint a -> f (endPoint b)
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) -> endPoint a -> f (endPoint b)
traverse a -> f b
f endPoint a
t

instance ( EndPoint_ (endPoint r), IxValue (endPoint r) ~ r
         ) => HasStart (Interval endPoint r) r where
  start :: Lens' (Interval endPoint r) r
start = (endPoint r -> f (endPoint r))
-> Interval endPoint r -> f (Interval endPoint r)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
startPoint((endPoint r -> f (endPoint r))
 -> Interval endPoint r -> f (Interval endPoint r))
-> ((r -> f r) -> endPoint r -> f (endPoint r))
-> (r -> f r)
-> Interval endPoint r
-> f (Interval endPoint r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> f r) -> endPoint r -> f (endPoint r)
(IxValue (endPoint r) -> f (IxValue (endPoint r)))
-> endPoint r -> f (endPoint r)
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens
  (endPoint r)
  (endPoint r)
  (IxValue (endPoint r))
  (IxValue (endPoint r))
_endPoint
instance ( EndPoint_ (endPoint r), IxValue (endPoint r) ~ r
         ) => HasEnd (Interval endPoint r) r where
  end :: Lens' (Interval endPoint r) r
end = (endPoint r -> f (endPoint r))
-> Interval endPoint r -> f (Interval endPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
endPoint((endPoint r -> f (endPoint r))
 -> Interval endPoint r -> f (Interval endPoint r))
-> ((r -> f r) -> endPoint r -> f (endPoint r))
-> (r -> f r)
-> Interval endPoint r
-> f (Interval endPoint r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> f r) -> endPoint r -> f (endPoint r)
(IxValue (endPoint r) -> f (IxValue (endPoint r)))
-> endPoint r -> f (endPoint r)
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens
  (endPoint r)
  (endPoint r)
  (IxValue (endPoint r))
  (IxValue (endPoint r))
_endPoint

instance HasStartPoint (Interval endPoint r) (endPoint r) where
  startPoint :: Lens' (Interval endPoint r) (endPoint r)
startPoint = (Interval endPoint r -> endPoint r)
-> (Interval endPoint r -> endPoint r -> Interval endPoint r)
-> Lens' (Interval endPoint r) (endPoint r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Interval endPoint r
s endPoint r
_) -> endPoint r
s) (\(Interval endPoint r
_ endPoint r
t) endPoint r
s -> endPoint r -> endPoint r -> Interval endPoint r
forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
Interval endPoint r
s endPoint r
t)

instance HasEndPoint (Interval endPoint r) (endPoint r) where
  endPoint :: Lens' (Interval endPoint r) (endPoint r)
endPoint = (Interval endPoint r -> endPoint r)
-> (Interval endPoint r -> endPoint r -> Interval endPoint r)
-> Lens' (Interval endPoint r) (endPoint r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Interval endPoint r
_ endPoint r
t) -> endPoint r
t) (\(Interval endPoint r
s endPoint r
_) endPoint r
t -> endPoint r -> endPoint r -> Interval endPoint r
forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
Interval endPoint r
s endPoint r
t)

type instance StartPointOf (Interval endPoint r) = endPoint r
type instance EndPointOf   (Interval endPoint r) = endPoint r

instance ( EndPoint_ (endPoint r), IxValue (endPoint r) ~ r
         ) => IntervalLike_ (Interval endPoint r) r where

instance ( EndPoint_ (endPoint r), IxValue (endPoint r) ~ r
         ) => Interval_ (Interval endPoint r) r where

instance ( EndPoint_ (endPoint r), IxValue (endPoint r) ~ r
         ) => ConstructableInterval_ (Interval endPoint r) r where
  mkInterval :: StartPointOf (Interval endPoint r)
-> EndPointOf (Interval endPoint r) -> Interval endPoint r
mkInterval = endPoint r -> endPoint r -> Interval endPoint r
StartPointOf (Interval endPoint r)
-> EndPointOf (Interval endPoint r) -> Interval endPoint r
forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
Interval

instance ClosedInterval_ (ClosedInterval r) r
instance ConstructableClosedInterval_ (ClosedInterval r) r

instance OpenInterval_ (OpenInterval r) r
instance ConstructableOpenInterval_ (OpenInterval r) r

--------------------------------------------------------------------------------

instance ( Show (endPoint r)
         ) => Show (Interval endPoint r) where
  showsPrec :: Int -> Interval endPoint r -> ShowS
showsPrec Int
k (Interval endPoint r
s endPoint r
t) = Bool -> ShowS -> ShowS
showParen (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                                 String -> ShowS
showString String
"Interval "
                               ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> endPoint r -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) endPoint r
s
                               ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                               ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> endPoint r -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) endPoint r
t

-- | application precedence
app_prec :: Int
app_prec :: Int
app_prec = Int
10

instance Read (endPoint r) => Read (Interval endPoint r) where
  readPrec :: ReadPrec (Interval endPoint r)
readPrec = ReadPrec (Interval endPoint r) -> ReadPrec (Interval endPoint r)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Interval endPoint r) -> ReadPrec (Interval endPoint r))
-> ReadPrec (Interval endPoint r) -> ReadPrec (Interval endPoint r)
forall a b. (a -> b) -> a -> b
$ (Int
-> ReadPrec (Interval endPoint r) -> ReadPrec (Interval endPoint r)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
app_prec (ReadPrec (Interval endPoint r) -> ReadPrec (Interval endPoint r))
-> ReadPrec (Interval endPoint r) -> ReadPrec (Interval endPoint r)
forall a b. (a -> b) -> a -> b
$ do
                          Ident "Interval" <- ReadPrec Lexeme
lexP
                          p <- step readPrec
                          q <- step readPrec
                          return (Interval p q))


--------------------------------------------------------------------------------

-- | Try to interpret the interval as an OpenInterval, i.e. with both endpoints open
asOpenInterval   :: Interval_ interval r => interval -> Maybe (OpenInterval r)
asOpenInterval :: forall interval r.
Interval_ interval r =>
interval -> Maybe (OpenInterval r)
asOpenInterval interval
i
  | EndPointType -> EndPointType -> interval -> Bool
forall interval r.
Interval_ interval r =>
EndPointType -> EndPointType -> interval -> Bool
isIntervalOfType EndPointType
Open EndPointType
Open interval
i = OpenInterval r -> Maybe (OpenInterval r)
forall a. a -> Maybe a
Just (OpenInterval r -> Maybe (OpenInterval r))
-> OpenInterval r -> Maybe (OpenInterval r)
forall a b. (a -> b) -> a -> b
$ r -> r -> OpenInterval r
forall r. r -> r -> OpenInterval r
OpenInterval (interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasStart seg p => Lens' seg p
Lens' interval r
start) (interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasEnd seg p => Lens' seg p
Lens' interval r
end)
  | Bool
otherwise                    = Maybe (OpenInterval r)
forall a. Maybe a
Nothing
{-# INLINE asOpenInterval #-}

-- | Try to interpret the interval as a ClosedInterval, i.e. with both endpoints Closed
asClosedInterval   :: Interval_ interval r => interval -> Maybe (ClosedInterval r)
asClosedInterval :: forall interval r.
Interval_ interval r =>
interval -> Maybe (ClosedInterval r)
asClosedInterval interval
i
  | EndPointType -> EndPointType -> interval -> Bool
forall interval r.
Interval_ interval r =>
EndPointType -> EndPointType -> interval -> Bool
isIntervalOfType EndPointType
Closed EndPointType
Closed interval
i = ClosedInterval r -> Maybe (ClosedInterval r)
forall a. a -> Maybe a
Just (ClosedInterval r -> Maybe (ClosedInterval r))
-> ClosedInterval r -> Maybe (ClosedInterval r)
forall a b. (a -> b) -> a -> b
$ r -> r -> ClosedInterval r
forall r. r -> r -> ClosedInterval r
ClosedInterval (interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasStart seg p => Lens' seg p
Lens' interval r
start) (interval
iinterval -> Getting r interval r -> r
forall s a. s -> Getting a s a -> a
^.Getting r interval r
forall seg p. HasEnd seg p => Lens' seg p
Lens' interval r
end)
  | Bool
otherwise                        = Maybe (ClosedInterval r)
forall a. Maybe a
Nothing
{-# INLINE asClosedInterval #-}

-- | convert into an interval whose endpoints are explicitly tagged.
asAnInterval   :: Interval_ interval r => interval -> Interval AnEndPoint r
asAnInterval :: forall interval r.
Interval_ interval r =>
interval -> Interval AnEndPoint r
asAnInterval interval
i = StartPointOf (Interval AnEndPoint r)
-> EndPointOf (Interval AnEndPoint r) -> Interval AnEndPoint r
forall interval point.
ConstructableInterval_ interval point =>
StartPointOf interval -> EndPointOf interval -> interval
mkInterval (StartPointOf interval
-> AnEndPoint (IxValue (StartPointOf interval))
forall endPoint.
EndPoint_ endPoint =>
endPoint -> AnEndPoint (IxValue endPoint)
asAnEndPoint (StartPointOf interval
 -> AnEndPoint (IxValue (StartPointOf interval)))
-> StartPointOf interval
-> AnEndPoint (IxValue (StartPointOf interval))
forall a b. (a -> b) -> a -> b
$ interval
iinterval
-> Getting (StartPointOf interval) interval (StartPointOf interval)
-> StartPointOf interval
forall s a. s -> Getting a s a -> a
^.Getting (StartPointOf interval) interval (StartPointOf interval)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' interval (StartPointOf interval)
startPoint) (EndPointOf interval -> AnEndPoint (IxValue (EndPointOf interval))
forall endPoint.
EndPoint_ endPoint =>
endPoint -> AnEndPoint (IxValue endPoint)
asAnEndPoint (EndPointOf interval -> AnEndPoint (IxValue (EndPointOf interval)))
-> EndPointOf interval
-> AnEndPoint (IxValue (EndPointOf interval))
forall a b. (a -> b) -> a -> b
$ interval
iinterval
-> Getting (EndPointOf interval) interval (EndPointOf interval)
-> EndPointOf interval
forall s a. s -> Getting a s a -> a
^.Getting (EndPointOf interval) interval (EndPointOf interval)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' interval (EndPointOf interval)
endPoint)

-- | Test if the interval is of a particular type
isIntervalOfType       :: Interval_ interval r
                       => EndPointType -- ^ startPoint type
                       -> EndPointType -- ^ endPoint type
                       -> interval -> Bool
isIntervalOfType :: forall interval r.
Interval_ interval r =>
EndPointType -> EndPointType -> interval -> Bool
isIntervalOfType EndPointType
s EndPointType
t interval
i = StartPointOf interval -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType (interval
iinterval
-> Getting (StartPointOf interval) interval (StartPointOf interval)
-> StartPointOf interval
forall s a. s -> Getting a s a -> a
^.Getting (StartPointOf interval) interval (StartPointOf interval)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' interval (StartPointOf interval)
startPoint) EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
s Bool -> Bool -> Bool
&&  EndPointOf interval -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType (interval
iinterval
-> Getting (EndPointOf interval) interval (EndPointOf interval)
-> EndPointOf interval
forall s a. s -> Getting a s a -> a
^.Getting (EndPointOf interval) interval (EndPointOf interval)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' interval (EndPointOf interval)
endPoint) EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
t
{-# INLINE isIntervalOfType #-}

--------------------------------------------------------------------------------


-- type instance IntersectionOf r (Interval endPoint r) = [NoIntersection, r]
-- GHC does not understand the r here cannot be 'Interval endPoint r' itself :(













-- type instance IntersectionOf (Interval point r) (Interval point r)
--   = [NoIntersection, Interval point r]

-- instance Ord r => Interval a r `HasIntersectionWith` Interval b r
-- instance Ord r => Interval point r `IsIntersectableWith` Interval point r where

--   nonEmptyIntersection = defaultNonEmptyIntersection

--   (GInterval r) `intersect` (GInterval s) = match (r' `intersect` s') $
--          H (\NoIntersection -> coRec NoIntersection)
--       :& H (\(Range l u)    -> coRec . GInterval $ Range (l&unEndPoint %~ g)
--                                                          (u&unEndPoint %~ g) )
--       :& RNil
--     where
--       r' :: Range (Arg r (r :+ Either a b))
--       r' = fmap (\(x :+ a) -> Arg x (x :+ Left a))  r
--       s' :: Range (Arg r (r :+ Either a b))
--       s' = fmap (\(x :+ b) -> Arg x (x :+ Right b)) s

--       g (Arg _ x) = x

type instance Intersection (Point 1 r) (Interval endPoint r) = Maybe r

instance Ord r => Point 1 r `HasIntersectionWith` ClosedInterval r where
  (Point1 r
q) intersects :: Point 1 r -> ClosedInterval r -> Bool
`intersects` ClosedInterval r
int = ClosedInterval r
intClosedInterval r -> Getting r (ClosedInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (ClosedInterval r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (ClosedInterval r) r
start r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
q Bool -> Bool -> Bool
&& r
q r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosedInterval r
intClosedInterval r -> Getting r (ClosedInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (ClosedInterval r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (ClosedInterval r) r
end
instance Ord r => Point 1 r `HasIntersectionWith` OpenInterval r where
  (Point1 r
q) intersects :: Point 1 r -> OpenInterval r -> Bool
`intersects` OpenInterval r
int = OpenInterval r
intOpenInterval r -> Getting r (OpenInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (OpenInterval r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (OpenInterval r) r
start r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< r
q Bool -> Bool -> Bool
&& r
q r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< OpenInterval r
intOpenInterval r -> Getting r (OpenInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (OpenInterval r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (OpenInterval r) r
end

instance Ord r
         => Point 1 r `HasIntersectionWith` Interval AnEndPoint r where
  (Point1 r
q) intersects :: Point 1 r -> Interval AnEndPoint r -> Bool
`intersects` Interval AnEndPoint r
int = EndPointType -> r -> r -> Bool
compare' (Interval AnEndPoint r
intInterval AnEndPoint r
-> Getting EndPointType (Interval AnEndPoint r) EndPointType
-> EndPointType
forall s a. s -> Getting a s a -> a
^.(AnEndPoint r -> Const EndPointType (AnEndPoint r))
-> Interval AnEndPoint r
-> Const EndPointType (Interval AnEndPoint r)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (Interval AnEndPoint r) (AnEndPoint r)
startPoint((AnEndPoint r -> Const EndPointType (AnEndPoint r))
 -> Interval AnEndPoint r
 -> Const EndPointType (Interval AnEndPoint r))
-> ((EndPointType -> Const EndPointType EndPointType)
    -> AnEndPoint r -> Const EndPointType (AnEndPoint r))
-> Getting EndPointType (Interval AnEndPoint r) EndPointType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AnEndPoint r -> EndPointType)
-> (EndPointType -> Const EndPointType EndPointType)
-> AnEndPoint r
-> Const EndPointType (AnEndPoint r)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to AnEndPoint r -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType) (Interval AnEndPoint r
intInterval AnEndPoint r -> Getting r (Interval AnEndPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval AnEndPoint r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (Interval AnEndPoint r) r
start) r
q
                             Bool -> Bool -> Bool
&& EndPointType -> r -> r -> Bool
compare' (Interval AnEndPoint r
intInterval AnEndPoint r
-> Getting EndPointType (Interval AnEndPoint r) EndPointType
-> EndPointType
forall s a. s -> Getting a s a -> a
^.(AnEndPoint r -> Const EndPointType (AnEndPoint r))
-> Interval AnEndPoint r
-> Const EndPointType (Interval AnEndPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval AnEndPoint r) (AnEndPoint r)
endPoint((AnEndPoint r -> Const EndPointType (AnEndPoint r))
 -> Interval AnEndPoint r
 -> Const EndPointType (Interval AnEndPoint r))
-> ((EndPointType -> Const EndPointType EndPointType)
    -> AnEndPoint r -> Const EndPointType (AnEndPoint r))
-> Getting EndPointType (Interval AnEndPoint r) EndPointType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AnEndPoint r -> EndPointType)
-> (EndPointType -> Const EndPointType EndPointType)
-> AnEndPoint r
-> Const EndPointType (AnEndPoint r)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to AnEndPoint r -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType)   r
q            (Interval AnEndPoint r
intInterval AnEndPoint r -> Getting r (Interval AnEndPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval AnEndPoint r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (Interval AnEndPoint r) r
end)
    where
      compare' :: EndPointType -> r -> r -> Bool
compare' = \case
        EndPointType
Open   -> r -> r -> Bool
forall a. Ord a => a -> a -> Bool
(<)
        EndPointType
Closed -> r -> r -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

-- | intersect implementation
intersectImpl  :: HasIntersectionWith (Point 1 r) i => Point 1 r -> i -> Maybe r
q :: Point 1 r
q@(Point1 r
q') intersectImpl :: forall r i.
HasIntersectionWith (Point 1 r) i =>
Point 1 r -> i -> Maybe r
`intersectImpl` i
int | Point 1 r
q Point 1 r -> i -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` i
int = r -> Maybe r
forall a. a -> Maybe a
Just r
q'
                                  | Bool
otherwise          = Maybe r
forall a. Maybe a
Nothing

instance Ord r => Point 1 r `IsIntersectableWith` ClosedInterval r where
  intersect :: Point 1 r
-> ClosedInterval r -> Intersection (Point 1 r) (ClosedInterval r)
intersect = Point 1 r -> ClosedInterval r -> Maybe r
Point 1 r
-> ClosedInterval r -> Intersection (Point 1 r) (ClosedInterval r)
forall r i.
HasIntersectionWith (Point 1 r) i =>
Point 1 r -> i -> Maybe r
intersectImpl
instance Ord r => Point 1 r `IsIntersectableWith` OpenInterval r where
  intersect :: Point 1 r
-> OpenInterval r -> Intersection (Point 1 r) (OpenInterval r)
intersect = Point 1 r -> OpenInterval r -> Maybe r
Point 1 r
-> OpenInterval r -> Intersection (Point 1 r) (OpenInterval r)
forall r i.
HasIntersectionWith (Point 1 r) i =>
Point 1 r -> i -> Maybe r
intersectImpl
instance Ord r
         => Point 1 r `IsIntersectableWith` Interval AnEndPoint r where
  intersect :: Point 1 r
-> Interval AnEndPoint r
-> Intersection (Point 1 r) (Interval AnEndPoint r)
intersect = Point 1 r -> Interval AnEndPoint r -> Maybe r
Point 1 r
-> Interval AnEndPoint r
-> Intersection (Point 1 r) (Interval AnEndPoint r)
forall r i.
HasIntersectionWith (Point 1 r) i =>
Point 1 r -> i -> Maybe r
intersectImpl


-- type instance Intersection (ClosedInterval r) (ClosedInterval r) =
--   Maybe (IntersectionOf (ClosedInterval r) (ClosedInterval r))

-- data instance IntersectionOf (ClosedInterval r) (ClosedInterval r) =
--     ClosedInterval_x_ClosedInterval_Point     !r
--   | ClosedInterval_x_ClosedInterval_Contained !(ClosedInterval r)
--   | ClosedInterval_x_ClosedInterval_Partial   !(ClosedInterval r)

-- deriving stock instance (Eq r) => Eq (IntersectionOf (ClosedInterval r) (ClosedInterval r) )
-- deriving stock instance (Show r) => Show (IntersectionOf (ClosedInterval r) (ClosedInterval r) )

--------------------------------------------------------------------------------
-- * Representing Interval intersections

-- | Data type representing intersections of intervals of the same type
data Interval_x_IntervalIntersection r interval =
    Interval_x_Interval_Point     !r
  | Interval_x_Interval_Contained !interval
  | Interval_x_Interval_Partial   !interval
  deriving (Int -> Interval_x_IntervalIntersection r interval -> ShowS
[Interval_x_IntervalIntersection r interval] -> ShowS
Interval_x_IntervalIntersection r interval -> String
(Int -> Interval_x_IntervalIntersection r interval -> ShowS)
-> (Interval_x_IntervalIntersection r interval -> String)
-> ([Interval_x_IntervalIntersection r interval] -> ShowS)
-> Show (Interval_x_IntervalIntersection r interval)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall r interval.
(Show r, Show interval) =>
Int -> Interval_x_IntervalIntersection r interval -> ShowS
forall r interval.
(Show r, Show interval) =>
[Interval_x_IntervalIntersection r interval] -> ShowS
forall r interval.
(Show r, Show interval) =>
Interval_x_IntervalIntersection r interval -> String
$cshowsPrec :: forall r interval.
(Show r, Show interval) =>
Int -> Interval_x_IntervalIntersection r interval -> ShowS
showsPrec :: Int -> Interval_x_IntervalIntersection r interval -> ShowS
$cshow :: forall r interval.
(Show r, Show interval) =>
Interval_x_IntervalIntersection r interval -> String
show :: Interval_x_IntervalIntersection r interval -> String
$cshowList :: forall r interval.
(Show r, Show interval) =>
[Interval_x_IntervalIntersection r interval] -> ShowS
showList :: [Interval_x_IntervalIntersection r interval] -> ShowS
Show,Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
(Interval_x_IntervalIntersection r interval
 -> Interval_x_IntervalIntersection r interval -> Bool)
-> (Interval_x_IntervalIntersection r interval
    -> Interval_x_IntervalIntersection r interval -> Bool)
-> Eq (Interval_x_IntervalIntersection r interval)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall r interval.
(Eq r, Eq interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
$c== :: forall r interval.
(Eq r, Eq interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
== :: Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
$c/= :: forall r interval.
(Eq r, Eq interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
/= :: Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
Eq,Eq (Interval_x_IntervalIntersection r interval)
Eq (Interval_x_IntervalIntersection r interval) =>
(Interval_x_IntervalIntersection r interval
 -> Interval_x_IntervalIntersection r interval -> Ordering)
-> (Interval_x_IntervalIntersection r interval
    -> Interval_x_IntervalIntersection r interval -> Bool)
-> (Interval_x_IntervalIntersection r interval
    -> Interval_x_IntervalIntersection r interval -> Bool)
-> (Interval_x_IntervalIntersection r interval
    -> Interval_x_IntervalIntersection r interval -> Bool)
-> (Interval_x_IntervalIntersection r interval
    -> Interval_x_IntervalIntersection r interval -> Bool)
-> (Interval_x_IntervalIntersection r interval
    -> Interval_x_IntervalIntersection r interval
    -> Interval_x_IntervalIntersection r interval)
-> (Interval_x_IntervalIntersection r interval
    -> Interval_x_IntervalIntersection r interval
    -> Interval_x_IntervalIntersection r interval)
-> Ord (Interval_x_IntervalIntersection r interval)
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Ordering
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
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 r interval.
(Ord r, Ord interval) =>
Eq (Interval_x_IntervalIntersection r interval)
forall r interval.
(Ord r, Ord interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
forall r interval.
(Ord r, Ord interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Ordering
forall r interval.
(Ord r, Ord interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
$ccompare :: forall r interval.
(Ord r, Ord interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Ordering
compare :: Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Ordering
$c< :: forall r interval.
(Ord r, Ord interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
< :: Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
$c<= :: forall r interval.
(Ord r, Ord interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
<= :: Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
$c> :: forall r interval.
(Ord r, Ord interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
> :: Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
$c>= :: forall r interval.
(Ord r, Ord interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
>= :: Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval -> Bool
$cmax :: forall r interval.
(Ord r, Ord interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
max :: Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
$cmin :: forall r interval.
(Ord r, Ord interval) =>
Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
min :: Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
-> Interval_x_IntervalIntersection r interval
Ord,(forall a b.
 (a -> b)
 -> Interval_x_IntervalIntersection r a
 -> Interval_x_IntervalIntersection r b)
-> (forall a b.
    a
    -> Interval_x_IntervalIntersection r b
    -> Interval_x_IntervalIntersection r a)
-> Functor (Interval_x_IntervalIntersection r)
forall a b.
a
-> Interval_x_IntervalIntersection r b
-> Interval_x_IntervalIntersection r a
forall a b.
(a -> b)
-> Interval_x_IntervalIntersection r a
-> Interval_x_IntervalIntersection r b
forall r a b.
a
-> Interval_x_IntervalIntersection r b
-> Interval_x_IntervalIntersection r a
forall r a b.
(a -> b)
-> Interval_x_IntervalIntersection r a
-> Interval_x_IntervalIntersection r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall r a b.
(a -> b)
-> Interval_x_IntervalIntersection r a
-> Interval_x_IntervalIntersection r b
fmap :: forall a b.
(a -> b)
-> Interval_x_IntervalIntersection r a
-> Interval_x_IntervalIntersection r b
$c<$ :: forall r a b.
a
-> Interval_x_IntervalIntersection r b
-> Interval_x_IntervalIntersection r a
<$ :: forall a b.
a
-> Interval_x_IntervalIntersection r b
-> Interval_x_IntervalIntersection r a
Functor,(forall m. Monoid m => Interval_x_IntervalIntersection r m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> Interval_x_IntervalIntersection r a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> Interval_x_IntervalIntersection r a -> m)
-> (forall a b.
    (a -> b -> b) -> b -> Interval_x_IntervalIntersection r a -> b)
-> (forall a b.
    (a -> b -> b) -> b -> Interval_x_IntervalIntersection r a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> Interval_x_IntervalIntersection r a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> Interval_x_IntervalIntersection r a -> b)
-> (forall a.
    (a -> a -> a) -> Interval_x_IntervalIntersection r a -> a)
-> (forall a.
    (a -> a -> a) -> Interval_x_IntervalIntersection r a -> a)
-> (forall a. Interval_x_IntervalIntersection r a -> [a])
-> (forall a. Interval_x_IntervalIntersection r a -> Bool)
-> (forall a. Interval_x_IntervalIntersection r a -> Int)
-> (forall a.
    Eq a =>
    a -> Interval_x_IntervalIntersection r a -> Bool)
-> (forall a. Ord a => Interval_x_IntervalIntersection r a -> a)
-> (forall a. Ord a => Interval_x_IntervalIntersection r a -> a)
-> (forall a. Num a => Interval_x_IntervalIntersection r a -> a)
-> (forall a. Num a => Interval_x_IntervalIntersection r a -> a)
-> Foldable (Interval_x_IntervalIntersection r)
forall a. Eq a => a -> Interval_x_IntervalIntersection r a -> Bool
forall a. Num a => Interval_x_IntervalIntersection r a -> a
forall a. Ord a => Interval_x_IntervalIntersection r a -> a
forall m. Monoid m => Interval_x_IntervalIntersection r m -> m
forall a. Interval_x_IntervalIntersection r a -> Bool
forall a. Interval_x_IntervalIntersection r a -> Int
forall a. Interval_x_IntervalIntersection r a -> [a]
forall a. (a -> a -> a) -> Interval_x_IntervalIntersection r a -> a
forall r a.
Eq a =>
a -> Interval_x_IntervalIntersection r a -> Bool
forall r a. Num a => Interval_x_IntervalIntersection r a -> a
forall r a. Ord a => Interval_x_IntervalIntersection r a -> a
forall r m. Monoid m => Interval_x_IntervalIntersection r m -> m
forall m a.
Monoid m =>
(a -> m) -> Interval_x_IntervalIntersection r a -> m
forall r a. Interval_x_IntervalIntersection r a -> Bool
forall r a. Interval_x_IntervalIntersection r a -> Int
forall r a. Interval_x_IntervalIntersection r a -> [a]
forall b a.
(b -> a -> b) -> b -> Interval_x_IntervalIntersection r a -> b
forall a b.
(a -> b -> b) -> b -> Interval_x_IntervalIntersection r a -> b
forall r a.
(a -> a -> a) -> Interval_x_IntervalIntersection r a -> a
forall r m a.
Monoid m =>
(a -> m) -> Interval_x_IntervalIntersection r a -> m
forall r b a.
(b -> a -> b) -> b -> Interval_x_IntervalIntersection r a -> b
forall r a b.
(a -> b -> b) -> b -> Interval_x_IntervalIntersection r a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall r m. Monoid m => Interval_x_IntervalIntersection r m -> m
fold :: forall m. Monoid m => Interval_x_IntervalIntersection r m -> m
$cfoldMap :: forall r m a.
Monoid m =>
(a -> m) -> Interval_x_IntervalIntersection r a -> m
foldMap :: forall m a.
Monoid m =>
(a -> m) -> Interval_x_IntervalIntersection r a -> m
$cfoldMap' :: forall r m a.
Monoid m =>
(a -> m) -> Interval_x_IntervalIntersection r a -> m
foldMap' :: forall m a.
Monoid m =>
(a -> m) -> Interval_x_IntervalIntersection r a -> m
$cfoldr :: forall r a b.
(a -> b -> b) -> b -> Interval_x_IntervalIntersection r a -> b
foldr :: forall a b.
(a -> b -> b) -> b -> Interval_x_IntervalIntersection r a -> b
$cfoldr' :: forall r a b.
(a -> b -> b) -> b -> Interval_x_IntervalIntersection r a -> b
foldr' :: forall a b.
(a -> b -> b) -> b -> Interval_x_IntervalIntersection r a -> b
$cfoldl :: forall r b a.
(b -> a -> b) -> b -> Interval_x_IntervalIntersection r a -> b
foldl :: forall b a.
(b -> a -> b) -> b -> Interval_x_IntervalIntersection r a -> b
$cfoldl' :: forall r b a.
(b -> a -> b) -> b -> Interval_x_IntervalIntersection r a -> b
foldl' :: forall b a.
(b -> a -> b) -> b -> Interval_x_IntervalIntersection r a -> b
$cfoldr1 :: forall r a.
(a -> a -> a) -> Interval_x_IntervalIntersection r a -> a
foldr1 :: forall a. (a -> a -> a) -> Interval_x_IntervalIntersection r a -> a
$cfoldl1 :: forall r a.
(a -> a -> a) -> Interval_x_IntervalIntersection r a -> a
foldl1 :: forall a. (a -> a -> a) -> Interval_x_IntervalIntersection r a -> a
$ctoList :: forall r a. Interval_x_IntervalIntersection r a -> [a]
toList :: forall a. Interval_x_IntervalIntersection r a -> [a]
$cnull :: forall r a. Interval_x_IntervalIntersection r a -> Bool
null :: forall a. Interval_x_IntervalIntersection r a -> Bool
$clength :: forall r a. Interval_x_IntervalIntersection r a -> Int
length :: forall a. Interval_x_IntervalIntersection r a -> Int
$celem :: forall r a.
Eq a =>
a -> Interval_x_IntervalIntersection r a -> Bool
elem :: forall a. Eq a => a -> Interval_x_IntervalIntersection r a -> Bool
$cmaximum :: forall r a. Ord a => Interval_x_IntervalIntersection r a -> a
maximum :: forall a. Ord a => Interval_x_IntervalIntersection r a -> a
$cminimum :: forall r a. Ord a => Interval_x_IntervalIntersection r a -> a
minimum :: forall a. Ord a => Interval_x_IntervalIntersection r a -> a
$csum :: forall r a. Num a => Interval_x_IntervalIntersection r a -> a
sum :: forall a. Num a => Interval_x_IntervalIntersection r a -> a
$cproduct :: forall r a. Num a => Interval_x_IntervalIntersection r a -> a
product :: forall a. Num a => Interval_x_IntervalIntersection r a -> a
Foldable,Functor (Interval_x_IntervalIntersection r)
Foldable (Interval_x_IntervalIntersection r)
(Functor (Interval_x_IntervalIntersection r),
 Foldable (Interval_x_IntervalIntersection r)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b)
 -> Interval_x_IntervalIntersection r a
 -> f (Interval_x_IntervalIntersection r b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Interval_x_IntervalIntersection r (f a)
    -> f (Interval_x_IntervalIntersection r a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b)
    -> Interval_x_IntervalIntersection r a
    -> m (Interval_x_IntervalIntersection r b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Interval_x_IntervalIntersection r (m a)
    -> m (Interval_x_IntervalIntersection r a))
-> Traversable (Interval_x_IntervalIntersection r)
forall r. Functor (Interval_x_IntervalIntersection r)
forall r. Foldable (Interval_x_IntervalIntersection r)
forall r (m :: * -> *) a.
Monad m =>
Interval_x_IntervalIntersection r (m a)
-> m (Interval_x_IntervalIntersection r a)
forall r (f :: * -> *) a.
Applicative f =>
Interval_x_IntervalIntersection r (f a)
-> f (Interval_x_IntervalIntersection r a)
forall r (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Interval_x_IntervalIntersection r a
-> m (Interval_x_IntervalIntersection r b)
forall r (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Interval_x_IntervalIntersection r a
-> f (Interval_x_IntervalIntersection r b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Interval_x_IntervalIntersection r (m a)
-> m (Interval_x_IntervalIntersection r a)
forall (f :: * -> *) a.
Applicative f =>
Interval_x_IntervalIntersection r (f a)
-> f (Interval_x_IntervalIntersection r a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Interval_x_IntervalIntersection r a
-> m (Interval_x_IntervalIntersection r b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Interval_x_IntervalIntersection r a
-> f (Interval_x_IntervalIntersection r b)
$ctraverse :: forall r (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Interval_x_IntervalIntersection r a
-> f (Interval_x_IntervalIntersection r b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Interval_x_IntervalIntersection r a
-> f (Interval_x_IntervalIntersection r b)
$csequenceA :: forall r (f :: * -> *) a.
Applicative f =>
Interval_x_IntervalIntersection r (f a)
-> f (Interval_x_IntervalIntersection r a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Interval_x_IntervalIntersection r (f a)
-> f (Interval_x_IntervalIntersection r a)
$cmapM :: forall r (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Interval_x_IntervalIntersection r a
-> m (Interval_x_IntervalIntersection r b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Interval_x_IntervalIntersection r a
-> m (Interval_x_IntervalIntersection r b)
$csequence :: forall r (m :: * -> *) a.
Monad m =>
Interval_x_IntervalIntersection r (m a)
-> m (Interval_x_IntervalIntersection r a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Interval_x_IntervalIntersection r (m a)
-> m (Interval_x_IntervalIntersection r a)
Traversable)

type instance Intersection (Interval endPoint r) (Interval endPoint r) =
  Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))

--------------------------------------------------------------------------------
-- * HasIntersection

----------------------------------------
-- ** Closed Interval

instance ( Ord r
         , IxValue (endPoint r) ~ r, EndPoint_ (endPoint r)
         ) => ClosedInterval r `HasIntersectionWith` Interval endPoint r where
  {-# SPECIALIZE instance Ord r => ClosedInterval r `HasIntersectionWith` ClosedInterval r #-}
  {-# SPECIALIZE instance Ord r => ClosedInterval r `HasIntersectionWith` OpenInterval r #-}
  {-# SPECIALIZE instance Ord r => ClosedInterval r `HasIntersectionWith` Interval AnEndPoint r #-}
  ClosedInterval r
intA intersects :: ClosedInterval r -> Interval endPoint r -> Bool
`intersects` Interval endPoint r
intB = case (ClosedInterval r
intAClosedInterval r -> Getting r (ClosedInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (ClosedInterval r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (ClosedInterval r) r
start) r -> Interval endPoint r -> Ordering
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> Ordering
`compareInterval` Interval endPoint r
intB of
    Ordering
LT -> case (ClosedInterval r
intAClosedInterval r -> Getting r (ClosedInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (ClosedInterval r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (ClosedInterval r) r
end) r -> Interval endPoint r -> Ordering
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> Ordering
`compareInterval` Interval endPoint r
intB of
            Ordering
LT -> Bool
False
            Ordering
EQ -> Bool
True
            Ordering
GT -> Bool
True
    Ordering
EQ -> Bool
True
    Ordering
GT -> Bool
False -- by invariant, intA^.end >= intA.start, so they don't intersect


----------------------------------------
-- ** Open intervals

instance Ord r => OpenInterval r  `HasIntersectionWith` OpenInterval r where
  OpenInterval r
intA intersects :: OpenInterval r -> OpenInterval r -> Bool
`intersects` OpenInterval r
intB = case (OpenInterval r
intAOpenInterval r -> Getting r (OpenInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (OpenInterval r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (OpenInterval r) r
start) r -> OpenInterval r -> Ordering
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> Ordering
`compareInterval` OpenInterval r
intB of
    Ordering
LT -> case (OpenInterval r
intAOpenInterval r -> Getting r (OpenInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (OpenInterval r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (OpenInterval r) r
end) r -> OpenInterval r -> Ordering
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> Ordering
`compareInterval` OpenInterval r
intB of
            Ordering
LT -> Bool
False
            Ordering
EQ -> Bool
True -- IntB is non-empty
            Ordering
GT -> OpenInterval r
intBOpenInterval r -> Getting r (OpenInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (OpenInterval r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (OpenInterval r) r
start r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< OpenInterval r
intBOpenInterval r -> Getting r (OpenInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (OpenInterval r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (OpenInterval r) r
end -- intB needs to be non-empty
    Ordering
EQ -> Bool
True -- IntB is non-empty
    Ordering
GT -> Bool
False -- by invariant, intA^.end >= intA.start, so they don't intersect
  {-# INLINE intersects #-}

instance Ord r => OpenInterval r  `HasIntersectionWith` ClosedInterval r where
  intersects :: OpenInterval r -> ClosedInterval r -> Bool
intersects OpenInterval r
intA ClosedInterval r
intB = ClosedInterval r -> OpenInterval r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
intersects ClosedInterval r
intB OpenInterval r
intA
  {-# INLINE intersects #-}

instance Ord r => OpenInterval r  `HasIntersectionWith` Interval AnEndPoint r where
  OpenInterval r
intA intersects :: OpenInterval r -> Interval AnEndPoint r -> Bool
`intersects` Interval AnEndPoint r
intB = case (OpenInterval r
intAOpenInterval r -> Getting r (OpenInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (OpenInterval r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (OpenInterval r) r
start) r -> Interval AnEndPoint r -> Ordering
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> Ordering
`compareInterval` Interval AnEndPoint r
intB of
      Ordering
LT -> case (OpenInterval r
intAOpenInterval r -> Getting r (OpenInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (OpenInterval r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (OpenInterval r) r
end) r -> Interval AnEndPoint r -> Ordering
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> Ordering
`compareInterval` Interval AnEndPoint r
intB of
              Ordering
LT -> Bool
False
              Ordering
EQ -> OpenInterval r
intAOpenInterval r -> Getting r (OpenInterval r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (OpenInterval r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (OpenInterval r) r
end r -> r -> Bool
forall a. Ord a => a -> a -> Bool
> Interval AnEndPoint r
intBInterval AnEndPoint r -> Getting r (Interval AnEndPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval AnEndPoint r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (Interval AnEndPoint r) r
start -- we do need to be propertly larger
              Ordering
GT -> EndPointType -> EndPointType -> Interval AnEndPoint r -> Bool
forall interval r.
Interval_ interval r =>
EndPointType -> EndPointType -> interval -> Bool
isIntervalOfType EndPointType
Open EndPointType
Open Interval AnEndPoint r
intB
                    Bool -> Bool -> Bool
`implies` (Interval AnEndPoint r
intBInterval AnEndPoint r -> Getting r (Interval AnEndPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval AnEndPoint r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (Interval AnEndPoint r) r
start r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< Interval AnEndPoint r
intBInterval AnEndPoint r -> Getting r (Interval AnEndPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval AnEndPoint r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (Interval AnEndPoint r) r
end) -- intB needs to be non-empty
      Ordering
EQ -> Bool
True -- IntB is non-empty
      Ordering
GT -> Bool
False -- by invariant, intA^.end >= intA.start, so they don't intersect
    where
      Bool
p implies :: Bool -> Bool -> Bool
`implies` Bool
q = Bool -> Bool
not Bool
p Bool -> Bool -> Bool
|| Bool
q
  {-# INLINE intersects #-}

----------------------------------------
-- * Mixed

instance Ord r => Interval AnEndPoint r `HasIntersectionWith` Interval AnEndPoint r where
  Interval AnEndPoint r
intA intersects :: Interval AnEndPoint r -> Interval AnEndPoint r -> Bool
`intersects` Interval AnEndPoint r
intB = case (Interval AnEndPoint r
intAInterval AnEndPoint r -> Getting r (Interval AnEndPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval AnEndPoint r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (Interval AnEndPoint r) r
start) r -> Interval AnEndPoint r -> CompareInterval
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> CompareInterval
`compareIntervalExact` Interval AnEndPoint r
intB of
      CompareInterval
Before   -> case (Interval AnEndPoint r
intAInterval AnEndPoint r -> Getting r (Interval AnEndPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval AnEndPoint r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (Interval AnEndPoint r) r
end) r -> Interval AnEndPoint r -> CompareInterval
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> CompareInterval
`compareIntervalExact` Interval AnEndPoint r
intB of
                    CompareInterval
Before   -> Bool
False
                    CompareInterval
OnStart  -> AnEndPoint r -> Bool
isClosed (Interval AnEndPoint r
intAInterval AnEndPoint r
-> Getting (AnEndPoint r) (Interval AnEndPoint r) (AnEndPoint r)
-> AnEndPoint r
forall s a. s -> Getting a s a -> a
^.Getting (AnEndPoint r) (Interval AnEndPoint r) (AnEndPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval AnEndPoint r) (AnEndPoint r)
endPoint) Bool -> Bool -> Bool
&& AnEndPoint r -> Bool
isClosed (Interval AnEndPoint r
intBInterval AnEndPoint r
-> Getting (AnEndPoint r) (Interval AnEndPoint r) (AnEndPoint r)
-> AnEndPoint r
forall s a. s -> Getting a s a -> a
^.Getting (AnEndPoint r) (Interval AnEndPoint r) (AnEndPoint r)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (Interval AnEndPoint r) (AnEndPoint r)
startPoint)
                    CompareInterval
Interior -> Bool
True
                    CompareInterval
OnEnd    -> Bool
True
                    CompareInterval
After    -> Bool
True
      CompareInterval
OnStart  -> Bool
True  -- by invariant, both a and B are non-empty, so they share
                        -- their endpoint they both contain the point start+eps
      CompareInterval
Interior -> Bool
True -- by invariant intA is non-empty, so intA^.start+eps inside intB
      CompareInterval
OnEnd    -> AnEndPoint r -> Bool
isClosed (Interval AnEndPoint r
intAInterval AnEndPoint r
-> Getting (AnEndPoint r) (Interval AnEndPoint r) (AnEndPoint r)
-> AnEndPoint r
forall s a. s -> Getting a s a -> a
^.Getting (AnEndPoint r) (Interval AnEndPoint r) (AnEndPoint r)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (Interval AnEndPoint r) (AnEndPoint r)
startPoint) Bool -> Bool -> Bool
&& AnEndPoint r -> Bool
isClosed (Interval AnEndPoint r
intBInterval AnEndPoint r
-> Getting (AnEndPoint r) (Interval AnEndPoint r) (AnEndPoint r)
-> AnEndPoint r
forall s a. s -> Getting a s a -> a
^.Getting (AnEndPoint r) (Interval AnEndPoint r) (AnEndPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval AnEndPoint r) (AnEndPoint r)
endPoint)
      CompareInterval
After    -> Bool
False -- by invariant, intA^.end >= intA.start, so they don't intersect
    where
      isClosed :: AnEndPoint r -> Bool
isClosed = (EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Closed) (EndPointType -> Bool)
-> (AnEndPoint r -> EndPointType) -> AnEndPoint r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnEndPoint r -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType
  {-# INLINE intersects #-}

instance Ord r => Interval AnEndPoint r `HasIntersectionWith` ClosedInterval r where
  intersects :: Interval AnEndPoint r -> ClosedInterval r -> Bool
intersects Interval AnEndPoint r
intA ClosedInterval r
intB = ClosedInterval r -> Interval AnEndPoint r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
intersects ClosedInterval r
intB Interval AnEndPoint r
intA
  {-# INLINE intersects #-}

instance Ord r => Interval AnEndPoint r `HasIntersectionWith` OpenInterval r where
  intersects :: Interval AnEndPoint r -> OpenInterval r -> Bool
intersects Interval AnEndPoint r
intA OpenInterval r
intB = OpenInterval r -> Interval AnEndPoint r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
intersects OpenInterval r
intB Interval AnEndPoint r
intA
  {-# INLINE intersects #-}

--------------------------------------------------------------------------------
-- * IsIntersectableWith implementations

-- | Implementation of interval intersection
intersectIntervalImpl     :: ( Ord r, IxValue (endPoint r) ~ r
                             , EndPoint_ (endPoint r)
                             )
                          => Interval endPoint r -> Interval endPoint r
                          -> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
intersectIntervalImpl :: forall r (endPoint :: * -> *).
(Ord r, IxValue (endPoint r) ~ r, EndPoint_ (endPoint r)) =>
Interval endPoint r
-> Interval endPoint r
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
intersectIntervalImpl Interval endPoint r
a Interval endPoint r
b = case (Interval endPoint r
aInterval endPoint r -> Getting r (Interval endPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval endPoint r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (Interval endPoint r) r
start) r -> Interval endPoint r -> CompareInterval
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> CompareInterval
`compareIntervalExact` Interval endPoint r
b of
    CompareInterval
Before   -> case (Interval endPoint r
aInterval endPoint r -> Getting r (Interval endPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval endPoint r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (Interval endPoint r) r
end) r -> Interval endPoint r -> CompareInterval
forall r interval.
(Ord r, Interval_ interval r) =>
r -> interval -> CompareInterval
`compareIntervalExact` Interval endPoint r
b of
        CompareInterval
Before   -> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. Maybe a
Nothing
        CompareInterval
OnStart  -> do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ endPoint r -> Bool
isClosed (Interval endPoint r
aInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
endPoint) Bool -> Bool -> Bool
&& endPoint r -> Bool
isClosed (Interval endPoint r
bInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
startPoint)
                       Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Interval_x_IntervalIntersection r (Interval endPoint r)
 -> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r)))
-> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a b. (a -> b) -> a -> b
$ r -> Interval_x_IntervalIntersection r (Interval endPoint r)
forall r interval. r -> Interval_x_IntervalIntersection r interval
Interval_x_Interval_Point (Interval endPoint r
aInterval endPoint r -> Getting r (Interval endPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval endPoint r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (Interval endPoint r) r
end)
        CompareInterval
Interior -> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. a -> Maybe a
Just Interval_x_IntervalIntersection r (Interval endPoint r)
partialBA
        CompareInterval
OnEnd
          | endPoint r -> Bool
isClosed (Interval endPoint r
aInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
endPoint) Bool -> Bool -> Bool
|| endPoint r -> Bool
isOpen (Interval endPoint r
bInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
endPoint) ->
                          Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. a -> Maybe a
Just (Interval_x_IntervalIntersection r (Interval endPoint r)
 -> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r)))
-> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a b. (a -> b) -> a -> b
$ Interval endPoint r
-> Interval_x_IntervalIntersection r (Interval endPoint r)
forall r interval.
interval -> Interval_x_IntervalIntersection r interval
Interval_x_Interval_Contained Interval endPoint r
b
          | Bool
otherwise  -> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. a -> Maybe a
Just Interval_x_IntervalIntersection r (Interval endPoint r)
partialBA
            -- if b's endpoint is "contained" in that of b, i.e. if
            -- a is closed, or if b is open, then b is fully contained.
        CompareInterval
After    -> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. a -> Maybe a
Just (Interval_x_IntervalIntersection r (Interval endPoint r)
 -> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r)))
-> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a b. (a -> b) -> a -> b
$ Interval endPoint r
-> Interval_x_IntervalIntersection r (Interval endPoint r)
forall r interval.
interval -> Interval_x_IntervalIntersection r interval
Interval_x_Interval_Contained Interval endPoint r
b

    CompareInterval
OnStart
      | endPoint r -> Bool
isClosed (Interval endPoint r
bInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
startPoint) Bool -> Bool -> Bool
|| endPoint r -> Bool
isOpen (Interval endPoint r
aInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
startPoint) ->
                      Interval_x_IntervalIntersection r (Interval endPoint r)
-> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
aInteriorCase (Interval endPoint r
-> Interval_x_IntervalIntersection r (Interval endPoint r)
forall r interval.
interval -> Interval_x_IntervalIntersection r interval
Interval_x_Interval_Contained Interval endPoint r
a)
                                    (Interval endPoint r
-> Interval_x_IntervalIntersection r (Interval endPoint r)
forall r interval.
interval -> Interval_x_IntervalIntersection r interval
Interval_x_Interval_Contained Interval endPoint r
b)
      | Bool
otherwise  -> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
aInteriorCase Interval_x_IntervalIntersection r (Interval endPoint r)
partialAB Interval_x_IntervalIntersection r (Interval endPoint r)
partialAB

    CompareInterval
Interior -> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
aInteriorCase (Interval endPoint r
-> Interval_x_IntervalIntersection r (Interval endPoint r)
forall r interval.
interval -> Interval_x_IntervalIntersection r interval
Interval_x_Interval_Contained Interval endPoint r
a) Interval_x_IntervalIntersection r (Interval endPoint r)
partialAB
    CompareInterval
OnEnd    -> do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ endPoint r -> Bool
isClosed (Interval endPoint r
aInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
startPoint) Bool -> Bool -> Bool
&& endPoint r -> Bool
isClosed (Interval endPoint r
bInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
endPoint)
                   Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Interval_x_IntervalIntersection r (Interval endPoint r)
 -> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r)))
-> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a b. (a -> b) -> a -> b
$ r -> Interval_x_IntervalIntersection r (Interval endPoint r)
forall r interval. r -> Interval_x_IntervalIntersection r interval
Interval_x_Interval_Point (Interval endPoint r
aInterval endPoint r -> Getting r (Interval endPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval endPoint r) r
forall seg p. HasStart seg p => Lens' seg p
Lens' (Interval endPoint r) r
start)
    CompareInterval
After    -> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. Maybe a
Nothing -- by invariant, a^.end >= a.start, so they don't intersect
  where
    isClosed :: endPoint r -> Bool
isClosed = (EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Closed) (EndPointType -> Bool)
-> (endPoint r -> EndPointType) -> endPoint r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. endPoint r -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType
    isOpen :: endPoint r -> Bool
isOpen = Bool -> Bool
not (Bool -> Bool) -> (endPoint r -> Bool) -> endPoint r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. endPoint r -> Bool
isClosed

    -- the case when the startpoint of a is contained in B or coincides witht the start of
    -- B the argument is how to actually construct a contained interval
    aInteriorCase :: Interval_x_IntervalIntersection r (Interval endPoint r)
-> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
aInteriorCase Interval_x_IntervalIntersection r (Interval endPoint r)
containedA Interval_x_IntervalIntersection r (Interval endPoint r)
partialAB' = case (Interval endPoint r
aInterval endPoint r -> Getting r (Interval endPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval endPoint r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (Interval endPoint r) r
end) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Interval endPoint r
bInterval endPoint r -> Getting r (Interval endPoint r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Interval endPoint r) r
forall seg p. HasEnd seg p => Lens' seg p
Lens' (Interval endPoint r) r
end) of
      Ordering
LT -> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. a -> Maybe a
Just Interval_x_IntervalIntersection r (Interval endPoint r)
containedA
      Ordering
EQ
        | endPoint r -> Bool
isClosed (Interval endPoint r
bInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
endPoint) Bool -> Bool -> Bool
|| endPoint r -> Bool
isOpen (Interval endPoint r
aInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
endPoint) -> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. a -> Maybe a
Just Interval_x_IntervalIntersection r (Interval endPoint r)
containedA
        | Bool
otherwise                                      -> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. a -> Maybe a
Just Interval_x_IntervalIntersection r (Interval endPoint r)
partialAB
      Ordering
GT -> Interval_x_IntervalIntersection r (Interval endPoint r)
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
forall a. a -> Maybe a
Just Interval_x_IntervalIntersection r (Interval endPoint r)
partialAB'

    partialAB :: Interval_x_IntervalIntersection r (Interval endPoint r)
partialAB = Interval endPoint r
-> Interval_x_IntervalIntersection r (Interval endPoint r)
forall r interval.
interval -> Interval_x_IntervalIntersection r interval
Interval_x_Interval_Partial (Interval endPoint r
 -> Interval_x_IntervalIntersection r (Interval endPoint r))
-> Interval endPoint r
-> Interval_x_IntervalIntersection r (Interval endPoint r)
forall a b. (a -> b) -> a -> b
$ endPoint r -> endPoint r -> Interval endPoint r
forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
Interval (Interval endPoint r
aInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
startPoint) (Interval endPoint r
bInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
endPoint)
    partialBA :: Interval_x_IntervalIntersection r (Interval endPoint r)
partialBA = Interval endPoint r
-> Interval_x_IntervalIntersection r (Interval endPoint r)
forall r interval.
interval -> Interval_x_IntervalIntersection r interval
Interval_x_Interval_Partial (Interval endPoint r
 -> Interval_x_IntervalIntersection r (Interval endPoint r))
-> Interval endPoint r
-> Interval_x_IntervalIntersection r (Interval endPoint r)
forall a b. (a -> b) -> a -> b
$ endPoint r -> endPoint r -> Interval endPoint r
forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
Interval (Interval endPoint r
bInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
startPoint) (Interval endPoint r
aInterval endPoint r
-> Getting (endPoint r) (Interval endPoint r) (endPoint r)
-> endPoint r
forall s a. s -> Getting a s a -> a
^.Getting (endPoint r) (Interval endPoint r) (endPoint r)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (Interval endPoint r) (endPoint r)
endPoint)


----------------------------------------
-- ** IsIntersectable

instance Ord r => ClosedInterval r `IsIntersectableWith` ClosedInterval r where
  intersect :: ClosedInterval r
-> ClosedInterval r
-> Intersection (ClosedInterval r) (ClosedInterval r)
intersect = ClosedInterval r
-> ClosedInterval r
-> Maybe (Interval_x_IntervalIntersection r (ClosedInterval r))
ClosedInterval r
-> ClosedInterval r
-> Intersection (ClosedInterval r) (ClosedInterval r)
forall r (endPoint :: * -> *).
(Ord r, IxValue (endPoint r) ~ r, EndPoint_ (endPoint r)) =>
Interval endPoint r
-> Interval endPoint r
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
intersectIntervalImpl

  -- intA `intersect` intB = case (intA^.start) `compareInterval` intB of
  --     LT -> case (intA^.end) `compareInterval` intB of
  --             LT -> Nothing
  --             EQ -> Just $ mkInterval' (intB^.start) (intA^.end)
  --             GT -> Just $ ClosedInterval_x_ClosedInterval_Contained intB
  --               -- intB is fully contained
  --     EQ -> case (intA^.end) `compareInterval` intB of
  --             LT -> error "intersecting intervals; invariant failed, intA should be swapped?"
  --             EQ -> Just $ ClosedInterval_x_ClosedInterval_Contained intA
  --             GT -> Just $ if intA^.start == intB^.start then
  --                            ClosedInterval_x_ClosedInterval_Contained intB
  --                          else mkInterval' (intA^.start) (intB^.end)
  --     GT -> Nothing -- by invariant, intA^.end > intA.start, so they don't intersect
  --   where
  --     mkInterval' l r
  --       | l == r    = ClosedInterval_x_ClosedInterval_Point l
  --       | otherwise = ClosedInterval_x_ClosedInterval_Partial $ ClosedInterval l r

instance Ord r => OpenInterval r `IsIntersectableWith` OpenInterval r where
  intersect :: OpenInterval r
-> OpenInterval r -> Intersection (OpenInterval r) (OpenInterval r)
intersect = OpenInterval r
-> OpenInterval r
-> Maybe (Interval_x_IntervalIntersection r (OpenInterval r))
OpenInterval r
-> OpenInterval r -> Intersection (OpenInterval r) (OpenInterval r)
forall r (endPoint :: * -> *).
(Ord r, IxValue (endPoint r) ~ r, EndPoint_ (endPoint r)) =>
Interval endPoint r
-> Interval endPoint r
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
intersectIntervalImpl

instance Ord r => Interval AnEndPoint r `IsIntersectableWith` Interval AnEndPoint r where
  intersect :: Interval AnEndPoint r
-> Interval AnEndPoint r
-> Intersection (Interval AnEndPoint r) (Interval AnEndPoint r)
intersect = Interval AnEndPoint r
-> Interval AnEndPoint r
-> Maybe
     (Interval_x_IntervalIntersection r (Interval AnEndPoint r))
Interval AnEndPoint r
-> Interval AnEndPoint r
-> Intersection (Interval AnEndPoint r) (Interval AnEndPoint r)
forall r (endPoint :: * -> *).
(Ord r, IxValue (endPoint r) ~ r, EndPoint_ (endPoint r)) =>
Interval endPoint r
-> Interval endPoint r
-> Maybe (Interval_x_IntervalIntersection r (Interval endPoint r))
intersectIntervalImpl