{-# LANGUAGE UndecidableInstances  #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.SubLine
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- SubLine; a part of a line
--
--------------------------------------------------------------------------------
module Data.Geometry.SubLine
  ( SubLine(..)
  , line
  , subRange
  , fixEndPoints
  , dropExtra
  , _unBounded
  , toUnbounded
  , fromUnbounded
  , onSubLine
  , onSubLineUB
  , onSubLine2
  , onSubLine2UB
  , getEndPointsUnBounded
  , fromLine
  ) where

import           Control.Lens
import           Data.Bifunctor
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Interval
import           Data.Geometry.Line.Internal
import           Data.Geometry.Point
import           Data.Geometry.Properties
import           Data.Geometry.Vector
import qualified Data.Traversable as T
import           Data.UnBounded
import           Data.Vinyl
import           Data.Vinyl.CoRec
import           Test.QuickCheck(Arbitrary(..))

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

-- | Part of a line. The interval is ranged based on the vector of the
-- line l, and s.t.t zero is the anchorPoint of l.
data SubLine d p s r = SubLine { SubLine d p s r -> Line d r
_line     :: Line d r
                               , SubLine d p s r -> Interval p s
_subRange :: Interval p s
                               }

-- | Line part of SubLine.
line :: Lens (SubLine d1 p s r1) (SubLine d2 p s r2) (Line d1 r1) (Line d2 r2)
line :: (Line d1 r1 -> f (Line d2 r2))
-> SubLine d1 p s r1 -> f (SubLine d2 p s r2)
line = (SubLine d1 p s r1 -> Line d1 r1)
-> (SubLine d1 p s r1 -> Line d2 r2 -> SubLine d2 p s r2)
-> Lens
     (SubLine d1 p s r1) (SubLine d2 p s r2) (Line d1 r1) (Line d2 r2)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SubLine d1 p s r1 -> Line d1 r1
forall (d :: Nat) p s r. SubLine d p s r -> Line d r
_line (\SubLine d1 p s r1
sub Line d2 r2
l -> Line d2 r2 -> Interval p s -> SubLine d2 p s r2
forall (d :: Nat) p s r.
Line d r -> Interval p s -> SubLine d p s r
SubLine Line d2 r2
l (SubLine d1 p s r1 -> Interval p s
forall (d :: Nat) p s r. SubLine d p s r -> Interval p s
_subRange SubLine d1 p s r1
sub))

-- | Interval part of SubLine.
subRange :: Lens (SubLine d p1 s1 r) (SubLine d p2 s2 r) (Interval p1 s1) (Interval p2 s2)
subRange :: (Interval p1 s1 -> f (Interval p2 s2))
-> SubLine d p1 s1 r -> f (SubLine d p2 s2 r)
subRange = (SubLine d p1 s1 r -> Interval p1 s1)
-> (SubLine d p1 s1 r -> Interval p2 s2 -> SubLine d p2 s2 r)
-> Lens
     (SubLine d p1 s1 r)
     (SubLine d p2 s2 r)
     (Interval p1 s1)
     (Interval p2 s2)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SubLine d p1 s1 r -> Interval p1 s1
forall (d :: Nat) p s r. SubLine d p s r -> Interval p s
_subRange (Line d r -> Interval p2 s2 -> SubLine d p2 s2 r
forall (d :: Nat) p s r.
Line d r -> Interval p s -> SubLine d p s r
SubLine (Line d r -> Interval p2 s2 -> SubLine d p2 s2 r)
-> (SubLine d p1 s1 r -> Line d r)
-> SubLine d p1 s1 r
-> Interval p2 s2
-> SubLine d p2 s2 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubLine d p1 s1 r -> Line d r
forall (d :: Nat) p s r. SubLine d p s r -> Line d r
_line)

type instance Dimension (SubLine d p s r) = d


deriving instance (Show r, Show s, Show p, Arity d) => Show (SubLine d p s r)
-- deriving instance (Read r, Read p, Arity d) => Read (SubLine d p r)
deriving instance (Eq r, Eq s, Fractional r, Eq p, Arity d)     => Eq (SubLine d p s r)
deriving instance Arity d                   => Functor (SubLine d p s)
deriving instance Arity d                   => F.Foldable (SubLine d p s)
deriving instance Arity d                   => T.Traversable (SubLine d p s)

instance (Arbitrary r, Arbitrary p, Arbitrary s, Arity d, Ord r, Ord s, Ord p, Num r)
         => Arbitrary (SubLine d p s r) where
  arbitrary :: Gen (SubLine d p s r)
arbitrary = Line d r -> Interval p s -> SubLine d p s r
forall (d :: Nat) p s r.
Line d r -> Interval p s -> SubLine d p s r
SubLine (Line d r -> Interval p s -> SubLine d p s r)
-> Gen (Line d r) -> Gen (Interval p s -> SubLine d p s r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Line d r)
forall a. Arbitrary a => Gen a
arbitrary Gen (Interval p s -> SubLine d p s r)
-> Gen (Interval p s) -> Gen (SubLine d p s r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Interval p s)
forall a. Arbitrary a => Gen a
arbitrary

-- | Annotate the subRange with the actual ending points
fixEndPoints    :: (Num r, Arity d) => SubLine d p r r -> SubLine d (Point d r :+ p) r r
fixEndPoints :: SubLine d p r r -> SubLine d (Point d r :+ p) r r
fixEndPoints SubLine d p r r
sl = SubLine d p r r
slSubLine d p r r
-> (SubLine d p r r -> SubLine d (Point d r :+ p) r r)
-> SubLine d (Point d r :+ p) r r
forall a b. a -> (a -> b) -> b
&(Interval p r -> Identity (Interval (Point d r :+ p) r))
-> SubLine d p r r -> Identity (SubLine d (Point d r :+ p) r r)
forall (d :: Nat) p1 s1 r p2 s2.
Lens
  (SubLine d p1 s1 r)
  (SubLine d p2 s2 r)
  (Interval p1 s1)
  (Interval p2 s2)
subRange ((Interval p r -> Identity (Interval (Point d r :+ p) r))
 -> SubLine d p r r -> Identity (SubLine d (Point d r :+ p) r r))
-> (Interval p r -> Interval (Point d r :+ p) r)
-> SubLine d p r r
-> SubLine d (Point d r :+ p) r r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Interval p r -> Interval (Point d r :+ p) r
f
  where
    ptAt :: r -> Point d r
ptAt              = (r -> Line d r -> Point d r) -> Line d r -> r -> Point d r
forall a b c. (a -> b -> c) -> b -> a -> c
flip r -> Line d r -> Point d r
forall r (d :: Nat). (Num r, Arity d) => r -> Line d r -> Point d r
pointAt (SubLine d p r r
slSubLine d p r r
-> Getting (Line d r) (SubLine d p r r) (Line d r) -> Line d r
forall s a. s -> Getting a s a -> a
^.Getting (Line d r) (SubLine d p r r) (Line d r)
forall (d1 :: Nat) p s r1 (d2 :: Nat) r2.
Lens
  (SubLine d1 p s r1) (SubLine d2 p s r2) (Line d1 r1) (Line d2 r2)
line)
    label :: (r :+ p) -> r :+ (Point d r :+ p)
label (r
c :+ p
e)    = r
c r -> (Point d r :+ p) -> r :+ (Point d r :+ p)
forall core extra. core -> extra -> core :+ extra
:+ (r -> Point d r
ptAt r
c Point d r -> p -> Point d r :+ p
forall core extra. core -> extra -> core :+ extra
:+ p
e)
    f :: Interval p r -> Interval (Point d r :+ p) r
f ~(Interval EndPoint (r :+ p)
l EndPoint (r :+ p)
u) = EndPoint (r :+ (Point d r :+ p))
-> EndPoint (r :+ (Point d r :+ p)) -> Interval (Point d r :+ p) r
forall r a. EndPoint (r :+ a) -> EndPoint (r :+ a) -> Interval a r
Interval (EndPoint (r :+ p)
lEndPoint (r :+ p)
-> (EndPoint (r :+ p) -> EndPoint (r :+ (Point d r :+ p)))
-> EndPoint (r :+ (Point d r :+ p))
forall a b. a -> (a -> b) -> b
&((r :+ p) -> Identity (r :+ (Point d r :+ p)))
-> EndPoint (r :+ p) -> Identity (EndPoint (r :+ (Point d r :+ p)))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint (((r :+ p) -> Identity (r :+ (Point d r :+ p)))
 -> EndPoint (r :+ p)
 -> Identity (EndPoint (r :+ (Point d r :+ p))))
-> ((r :+ p) -> r :+ (Point d r :+ p))
-> EndPoint (r :+ p)
-> EndPoint (r :+ (Point d r :+ p))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (r :+ p) -> r :+ (Point d r :+ p)
label)
                                 (EndPoint (r :+ p)
uEndPoint (r :+ p)
-> (EndPoint (r :+ p) -> EndPoint (r :+ (Point d r :+ p)))
-> EndPoint (r :+ (Point d r :+ p))
forall a b. a -> (a -> b) -> b
&((r :+ p) -> Identity (r :+ (Point d r :+ p)))
-> EndPoint (r :+ p) -> Identity (EndPoint (r :+ (Point d r :+ p)))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint (((r :+ p) -> Identity (r :+ (Point d r :+ p)))
 -> EndPoint (r :+ p)
 -> Identity (EndPoint (r :+ (Point d r :+ p))))
-> ((r :+ p) -> r :+ (Point d r :+ p))
-> EndPoint (r :+ p)
-> EndPoint (r :+ (Point d r :+ p))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (r :+ p) -> r :+ (Point d r :+ p)
label)

-- | forget the extra information stored at the endpoints of the subline.
dropExtra :: SubLine d p s r -> SubLine d () s r
dropExtra :: SubLine d p s r -> SubLine d () s r
dropExtra = ASetter
  (SubLine d p s r) (SubLine d () s r) (Interval p s) (Interval () s)
-> (Interval p s -> Interval () s)
-> SubLine d p s r
-> SubLine d () s r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (SubLine d p s r) (SubLine d () s r) (Interval p s) (Interval () s)
forall (d :: Nat) p1 s1 r p2 s2.
Lens
  (SubLine d p1 s1 r)
  (SubLine d p2 s2 r)
  (Interval p1 s1)
  (Interval p2 s2)
subRange ((p -> ()) -> Interval p s -> Interval () s
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (() -> p -> ()
forall a b. a -> b -> a
const ()))

-- | Prism for downcasting an unbounded subline to a subline.
_unBounded :: Prism' (SubLine d p (UnBounded r) r) (SubLine d p r r)
_unBounded :: p (SubLine d p r r) (f (SubLine d p r r))
-> p (SubLine d p (UnBounded r) r)
     (f (SubLine d p (UnBounded r) r))
_unBounded = (SubLine d p r r -> SubLine d p (UnBounded r) r)
-> (SubLine d p (UnBounded r) r -> Maybe (SubLine d p r r))
-> Prism
     (SubLine d p (UnBounded r) r)
     (SubLine d p (UnBounded r) r)
     (SubLine d p r r)
     (SubLine d p r r)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' SubLine d p r r -> SubLine d p (UnBounded r) r
forall (d :: Nat) p r.
SubLine d p r r -> SubLine d p (UnBounded r) r
toUnbounded SubLine d p (UnBounded r) r -> Maybe (SubLine d p r r)
forall (d :: Nat) p r.
SubLine d p (UnBounded r) r -> Maybe (SubLine d p r r)
fromUnbounded

-- | Transform into an subline with a potentially unbounded interval
toUnbounded :: SubLine d p r r -> SubLine d p (UnBounded r) r
toUnbounded :: SubLine d p r r -> SubLine d p (UnBounded r) r
toUnbounded = ASetter
  (SubLine d p r r)
  (SubLine d p (UnBounded r) r)
  (Interval p r)
  (Interval p (UnBounded r))
-> (Interval p r -> Interval p (UnBounded r))
-> SubLine d p r r
-> SubLine d p (UnBounded r) r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (SubLine d p r r)
  (SubLine d p (UnBounded r) r)
  (Interval p r)
  (Interval p (UnBounded r))
forall (d :: Nat) p1 s1 r p2 s2.
Lens
  (SubLine d p1 s1 r)
  (SubLine d p2 s2 r)
  (Interval p1 s1)
  (Interval p2 s2)
subRange ((r -> UnBounded r) -> Interval p r -> Interval p (UnBounded r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> UnBounded r
forall a. a -> UnBounded a
Val)

-- | Try to make a potentially unbounded subline into a bounded one.
fromUnbounded               :: SubLine d p (UnBounded r) r -> Maybe (SubLine d p r r)
fromUnbounded :: SubLine d p (UnBounded r) r -> Maybe (SubLine d p r r)
fromUnbounded (SubLine Line d r
l Interval p (UnBounded r)
i) = Line d r -> Interval p r -> SubLine d p r r
forall (d :: Nat) p s r.
Line d r -> Interval p s -> SubLine d p s r
SubLine Line d r
l (Interval p r -> SubLine d p r r)
-> Maybe (Interval p r) -> Maybe (SubLine d p r r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnBounded r -> Maybe r)
-> Interval p (UnBounded r) -> Maybe (Interval p r)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM UnBounded r -> Maybe r
forall a. UnBounded a -> Maybe a
unBoundedToMaybe Interval p (UnBounded r)
i

-- | given point p, and a Subline l r such that p lies on line l, test if it
-- lies on the subline, i.e. in the interval r
onSubLine                 :: (Ord r, Fractional r, Arity d)
                          => Point d r -> SubLine d p r r -> Bool
onSubLine :: Point d r -> SubLine d p r r -> Bool
onSubLine Point d r
p (SubLine Line d r
l Interval p r
r) = case Point d r -> Line d r -> Maybe r
forall r (d :: Nat).
(Eq r, Fractional r, Arity d) =>
Point d r -> Line d r -> Maybe r
toOffset Point d r
p Line d r
l of
                              Maybe r
Nothing -> Bool
False
                              Just r
x  -> r
x r -> Interval p r -> Bool
forall r a. Ord r => r -> Interval a r -> Bool
`inInterval` Interval p r
r

-- | given point p, and a Subline l r such that p lies on line l, test if it
-- lies on the subline, i.e. in the interval r
onSubLineUB                   :: (Ord r, Fractional r)
                              => Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
Point 2 r
p onSubLineUB :: Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
`onSubLineUB` (SubLine Line 2 r
l Interval p (UnBounded r)
r) =
  Point 2 r
p Point 2 r -> Line 2 r -> Bool
forall r. (Ord r, Num r) => Point 2 r -> Line 2 r -> Bool
`onLine2` Line 2 r
l Bool -> Bool -> Bool
&&
  r -> UnBounded r
forall a. a -> UnBounded a
Val (Point 2 r -> Line 2 r -> r
forall r (d :: Nat).
(Eq r, Fractional r, Arity d) =>
Point d r -> Line d r -> r
toOffset' Point 2 r
p Line 2 r
l) UnBounded r -> Interval p (UnBounded r) -> Bool
forall r a. Ord r => r -> Interval a r -> Bool
`inInterval` Interval p (UnBounded r)
r

inSubLineIntervalUB                   :: (Ord r, Fractional r)
                              => Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
Point 2 r
p inSubLineIntervalUB :: Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
`inSubLineIntervalUB` (SubLine Line 2 r
l Interval p (UnBounded r)
r) = r -> UnBounded r
forall a. a -> UnBounded a
Val (Point 2 r -> Line 2 r -> r
forall r (d :: Nat).
(Eq r, Fractional r, Arity d) =>
Point d r -> Line d r -> r
toOffset' Point 2 r
p Line 2 r
l) UnBounded r -> Interval p (UnBounded r) -> Bool
forall r a. Ord r => r -> Interval a r -> Bool
`inInterval` Interval p (UnBounded r)
r

-- | given point p, and a Subline l r such that p lies on line l, test if it
-- lies on the subline, i.e. in the interval r
onSubLine2        :: (Ord r, Num r) => Point 2 r -> SubLine 2 p r r -> Bool
Point 2 r
p onSubLine2 :: Point 2 r -> SubLine 2 p r r -> Bool
`onSubLine2` SubLine 2 p r r
sl = r
d r -> Interval (Point 2 r :+ p) r -> Bool
forall r a. Ord r => r -> Interval a r -> Bool
`inInterval` Interval (Point 2 r :+ p) r
r
  where
    -- get the endpoints (a,b) of the subline
    SubLine Line 2 r
_ (Interval EndPoint (r :+ (Point 2 r :+ p))
s EndPoint (r :+ (Point 2 r :+ p))
e) = SubLine 2 p r r -> SubLine 2 (Point 2 r :+ p) r r
forall r (d :: Nat) p.
(Num r, Arity d) =>
SubLine d p r r -> SubLine d (Point d r :+ p) r r
fixEndPoints SubLine 2 p r r
sl
    a :: Point 2 r
a = EndPoint (r :+ (Point 2 r :+ p))
sEndPoint (r :+ (Point 2 r :+ p))
-> Getting
     (Point 2 r) (EndPoint (r :+ (Point 2 r :+ p))) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((r :+ (Point 2 r :+ p))
 -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> EndPoint (r :+ (Point 2 r :+ p))
-> Const (Point 2 r) (EndPoint (r :+ (Point 2 r :+ p)))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((r :+ (Point 2 r :+ p))
  -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
 -> EndPoint (r :+ (Point 2 r :+ p))
 -> Const (Point 2 r) (EndPoint (r :+ (Point 2 r :+ p))))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (r :+ (Point 2 r :+ p))
    -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> Getting
     (Point 2 r) (EndPoint (r :+ (Point 2 r :+ p))) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (r :+ (Point 2 r :+ p))
-> Const (Point 2 r) (r :+ (Point 2 r :+ p))
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> (r :+ (Point 2 r :+ p))
 -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (r :+ (Point 2 r :+ p))
-> Const (Point 2 r) (r :+ (Point 2 r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
    b :: Point 2 r
b = EndPoint (r :+ (Point 2 r :+ p))
eEndPoint (r :+ (Point 2 r :+ p))
-> Getting
     (Point 2 r) (EndPoint (r :+ (Point 2 r :+ p))) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((r :+ (Point 2 r :+ p))
 -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> EndPoint (r :+ (Point 2 r :+ p))
-> Const (Point 2 r) (EndPoint (r :+ (Point 2 r :+ p)))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((r :+ (Point 2 r :+ p))
  -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
 -> EndPoint (r :+ (Point 2 r :+ p))
 -> Const (Point 2 r) (EndPoint (r :+ (Point 2 r :+ p))))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (r :+ (Point 2 r :+ p))
    -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> Getting
     (Point 2 r) (EndPoint (r :+ (Point 2 r :+ p))) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (r :+ (Point 2 r :+ p))
-> Const (Point 2 r) (r :+ (Point 2 r :+ p))
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> (r :+ (Point 2 r :+ p))
 -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (r :+ (Point 2 r :+ p))
-> Const (Point 2 r) (r :+ (Point 2 r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
    d :: r
d = (Point 2 r
p Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
a) Vector 2 r -> Vector 2 r -> r
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` (Point 2 r
b Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
a)
    -- map to an interval corresponding to the length of the segment
    r :: Interval (Point 2 r :+ p) r
r = EndPoint (r :+ (Point 2 r :+ p))
-> EndPoint (r :+ (Point 2 r :+ p)) -> Interval (Point 2 r :+ p) r
forall r a. EndPoint (r :+ a) -> EndPoint (r :+ a) -> Interval a r
Interval (EndPoint (r :+ (Point 2 r :+ p))
sEndPoint (r :+ (Point 2 r :+ p))
-> (EndPoint (r :+ (Point 2 r :+ p))
    -> EndPoint (r :+ (Point 2 r :+ p)))
-> EndPoint (r :+ (Point 2 r :+ p))
forall a b. a -> (a -> b) -> b
&((r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
-> EndPoint (r :+ (Point 2 r :+ p))
-> Identity (EndPoint (r :+ (Point 2 r :+ p)))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
 -> EndPoint (r :+ (Point 2 r :+ p))
 -> Identity (EndPoint (r :+ (Point 2 r :+ p))))
-> ((r -> Identity r)
    -> (r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
-> (r -> Identity r)
-> EndPoint (r :+ (Point 2 r :+ p))
-> Identity (EndPoint (r :+ (Point 2 r :+ p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Identity r)
-> (r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p))
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((r -> Identity r)
 -> EndPoint (r :+ (Point 2 r :+ p))
 -> Identity (EndPoint (r :+ (Point 2 r :+ p))))
-> r
-> EndPoint (r :+ (Point 2 r :+ p))
-> EndPoint (r :+ (Point 2 r :+ p))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ r
0) (EndPoint (r :+ (Point 2 r :+ p))
eEndPoint (r :+ (Point 2 r :+ p))
-> (EndPoint (r :+ (Point 2 r :+ p))
    -> EndPoint (r :+ (Point 2 r :+ p)))
-> EndPoint (r :+ (Point 2 r :+ p))
forall a b. a -> (a -> b) -> b
&((r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
-> EndPoint (r :+ (Point 2 r :+ p))
-> Identity (EndPoint (r :+ (Point 2 r :+ p)))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
 -> EndPoint (r :+ (Point 2 r :+ p))
 -> Identity (EndPoint (r :+ (Point 2 r :+ p))))
-> ((r -> Identity r)
    -> (r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
-> (r -> Identity r)
-> EndPoint (r :+ (Point 2 r :+ p))
-> Identity (EndPoint (r :+ (Point 2 r :+ p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Identity r)
-> (r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p))
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((r -> Identity r)
 -> EndPoint (r :+ (Point 2 r :+ p))
 -> Identity (EndPoint (r :+ (Point 2 r :+ p))))
-> r
-> EndPoint (r :+ (Point 2 r :+ p))
-> EndPoint (r :+ (Point 2 r :+ p))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point 2 r -> Point 2 r -> r
forall r (d :: Nat).
(Num r, Arity d) =>
Point d r -> Point d r -> r
squaredEuclideanDist Point 2 r
b Point 2 r
a)


-- | given point p, and a Subline l r such that p lies on line l, test if it
-- lies on the subline, i.e. in the interval r
onSubLine2UB        :: (Ord r, Fractional r)
                    => Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
Point 2 r
p onSubLine2UB :: Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
`onSubLine2UB` SubLine 2 p (UnBounded r) r
sl = Point 2 r
p Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
forall r p.
(Ord r, Fractional r) =>
Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
`onSubLineUB` SubLine 2 p (UnBounded r) r
sl


type instance IntersectionOf (SubLine 2 p s r) (SubLine 2 q s r) = [ NoIntersection
                                                                   , Point 2 r
                                                                   , SubLine 2 p s r
                                                                   ]

{- HLINT ignore "Redundant bracket" -}
instance (Ord r, Fractional r) =>
         SubLine 2 p r r `IsIntersectableWith` SubLine 2 p r r where

  nonEmptyIntersection :: proxy (SubLine 2 p r r)
-> proxy (SubLine 2 p r r)
-> Intersection (SubLine 2 p r r) (SubLine 2 p r r)
-> Bool
nonEmptyIntersection = proxy (SubLine 2 p r r)
-> proxy (SubLine 2 p r r)
-> Intersection (SubLine 2 p r r) (SubLine 2 p r r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection

  sl :: SubLine 2 p r r
sl@(SubLine Line 2 r
l Interval p r
r) intersect :: SubLine 2 p r r
-> SubLine 2 p r r
-> Intersection (SubLine 2 p r r) (SubLine 2 p r r)
`intersect` sm :: SubLine 2 p r r
sm@(SubLine Line 2 r
m Interval p r
_) = CoRec Identity '[NoIntersection, Point 2 r, Line 2 r]
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Line 2 r
l Line 2 r -> Line 2 r -> Intersection (Line 2 r) (Line 2 r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Line 2 r
m) (Handlers
   '[NoIntersection, Point 2 r, Line 2 r]
   (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
 -> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]
forall a b. (a -> b) -> a -> b
$
         (NoIntersection
 -> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> Handler
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
     NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
      Handler
  (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
  NoIntersection
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]))
     '[Point 2 r, Line 2 r]
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
 -> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> Handler
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
     (Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\p :: Point 2 r
p@(Point Vector 2 r
_)    -> if Point 2 r -> SubLine 2 p r r -> Bool
forall r p. (Ord r, Num r) => Point 2 r -> SubLine 2 p r r -> Bool
onSubLine2 Point 2 r
p SubLine 2 p r r
sl Bool -> Bool -> Bool
&& Point 2 r -> SubLine 2 p r r -> Bool
forall r p. (Ord r, Num r) => Point 2 r -> SubLine 2 p r r -> Bool
onSubLine2 Point 2 r
p SubLine 2 p r r
sm
                                 then Point 2 r
-> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
p
                                 else NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
      Handler
  (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
  (Point 2 r)
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]))
     '[Line 2 r]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]))
     '[Point 2 r, Line 2 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Line 2 r
 -> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> Handler
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
     (Line 2 r)
forall b a. (a -> b) -> Handler b a
H (\Line 2 r
_             -> CoRec Identity '[NoIntersection, Interval p r]
-> Handlers
     '[NoIntersection, Interval p r]
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Interval p r
r Interval p r
-> Interval p r -> Intersection (Interval p r) (Interval p r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Interval p r
s'') (Handlers
   '[NoIntersection, Interval p r]
   (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
 -> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> Handlers
     '[NoIntersection, Interval p r]
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]
forall a b. (a -> b) -> a -> b
$
                                      (NoIntersection
 -> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> Handler
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
     NoIntersection
forall b a. (a -> b) -> Handler b a
H NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec -- NoIntersection
                                   Handler
  (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
  NoIntersection
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]))
     '[Interval p r]
-> Handlers
     '[NoIntersection, Interval p r]
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Interval p r
 -> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> Handler
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
     (Interval p r)
forall b a. (a -> b) -> Handler b a
H (SubLine 2 p r r
-> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (SubLine 2 p r r
 -> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
-> (Interval p r -> SubLine 2 p r r)
-> Interval p r
-> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line 2 r -> Interval p r -> SubLine 2 p r r
forall (d :: Nat) p s r.
Line d r -> Interval p s -> SubLine d p s r
SubLine Line 2 r
l)
                                   Handler
  (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
  (Interval p r)
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]))
     '[]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]))
     '[Interval p r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]))
  '[]
forall u (a :: u -> *). Rec a '[]
RNil
           )
      Handler
  (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r])
  (Line 2 r)
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]))
     '[]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]))
     '[Line 2 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler
     (CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]))
  '[]
forall u (a :: u -> *). Rec a '[]
RNil
    where
      s' :: Interval (Point 2 r :+ p) r
s'  = (SubLine 2 p r r -> SubLine 2 (Point 2 r :+ p) r r
forall r (d :: Nat) p.
(Num r, Arity d) =>
SubLine d p r r -> SubLine d (Point d r :+ p) r r
fixEndPoints SubLine 2 p r r
sm)SubLine 2 (Point 2 r :+ p) r r
-> Getting
     (Interval (Point 2 r :+ p) r)
     (SubLine 2 (Point 2 r :+ p) r r)
     (Interval (Point 2 r :+ p) r)
-> Interval (Point 2 r :+ p) r
forall s a. s -> Getting a s a -> a
^.Getting
  (Interval (Point 2 r :+ p) r)
  (SubLine 2 (Point 2 r :+ p) r r)
  (Interval (Point 2 r :+ p) r)
forall (d :: Nat) p1 s1 r p2 s2.
Lens
  (SubLine d p1 s1 r)
  (SubLine d p2 s2 r)
  (Interval p1 s1)
  (Interval p2 s2)
subRange
      s'' :: Interval p r
s'' = Interval p r -> Interval p r
forall r p. Ord r => Interval p r -> Interval p r
asProperInterval (Interval p r -> Interval p r)
-> (Interval (Point 2 r :+ p) r -> Interval p r)
-> Interval (Point 2 r :+ p) r
-> Interval p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Point 2 r :+ p) -> p)
-> Interval (Point 2 r :+ p) r -> Interval p r
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Point 2 r :+ p) -> Getting p (Point 2 r :+ p) p -> p
forall s a. s -> Getting a s a -> a
^.Getting p (Point 2 r :+ p) p
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra)
          (Interval (Point 2 r :+ p) r -> Interval p r)
-> Interval (Point 2 r :+ p) r -> Interval p r
forall a b. (a -> b) -> a -> b
$ Interval (Point 2 r :+ p) r
s'Interval (Point 2 r :+ p) r
-> (Interval (Point 2 r :+ p) r -> Interval (Point 2 r :+ p) r)
-> Interval (Point 2 r :+ p) r
forall a b. a -> (a -> b) -> b
&((r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
-> Interval (Point 2 r :+ p) r
-> Identity (Interval (Point 2 r :+ p) r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
 -> Interval (Point 2 r :+ p) r
 -> Identity (Interval (Point 2 r :+ p) r))
-> ((r -> Identity r)
    -> (r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
-> (r -> Identity r)
-> Interval (Point 2 r :+ p) r
-> Identity (Interval (Point 2 r :+ p) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Identity r)
-> (r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p))
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((r -> Identity r)
 -> Interval (Point 2 r :+ p) r
 -> Identity (Interval (Point 2 r :+ p) r))
-> r -> Interval (Point 2 r :+ p) r -> Interval (Point 2 r :+ p) r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point 2 r -> Line 2 r -> r
forall r (d :: Nat).
(Eq r, Fractional r, Arity d) =>
Point d r -> Line d r -> r
toOffset' (Interval (Point 2 r :+ p) r
s'Interval (Point 2 r :+ p) r
-> Getting (Point 2 r) (Interval (Point 2 r :+ p) r) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((r :+ (Point 2 r :+ p))
 -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> Interval (Point 2 r :+ p) r
-> Const (Point 2 r) (Interval (Point 2 r :+ p) r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((r :+ (Point 2 r :+ p))
  -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
 -> Interval (Point 2 r :+ p) r
 -> Const (Point 2 r) (Interval (Point 2 r :+ p) r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (r :+ (Point 2 r :+ p))
    -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> Getting (Point 2 r) (Interval (Point 2 r :+ p) r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (r :+ (Point 2 r :+ p))
-> Const (Point 2 r) (r :+ (Point 2 r :+ p))
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> (r :+ (Point 2 r :+ p))
 -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (r :+ (Point 2 r :+ p))
-> Const (Point 2 r) (r :+ (Point 2 r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Line 2 r
l
              Interval (Point 2 r :+ p) r
-> (Interval (Point 2 r :+ p) r -> Interval (Point 2 r :+ p) r)
-> Interval (Point 2 r :+ p) r
forall a b. a -> (a -> b) -> b
&((r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
-> Interval (Point 2 r :+ p) r
-> Identity (Interval (Point 2 r :+ p) r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
 -> Interval (Point 2 r :+ p) r
 -> Identity (Interval (Point 2 r :+ p) r))
-> ((r -> Identity r)
    -> (r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p)))
-> (r -> Identity r)
-> Interval (Point 2 r :+ p) r
-> Identity (Interval (Point 2 r :+ p) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Identity r)
-> (r :+ (Point 2 r :+ p)) -> Identity (r :+ (Point 2 r :+ p))
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core   ((r -> Identity r)
 -> Interval (Point 2 r :+ p) r
 -> Identity (Interval (Point 2 r :+ p) r))
-> r -> Interval (Point 2 r :+ p) r -> Interval (Point 2 r :+ p) r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point 2 r -> Line 2 r -> r
forall r (d :: Nat).
(Eq r, Fractional r, Arity d) =>
Point d r -> Line d r -> r
toOffset' (Interval (Point 2 r :+ p) r
s'Interval (Point 2 r :+ p) r
-> Getting (Point 2 r) (Interval (Point 2 r :+ p) r) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((r :+ (Point 2 r :+ p))
 -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> Interval (Point 2 r :+ p) r
-> Const (Point 2 r) (Interval (Point 2 r :+ p) r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((r :+ (Point 2 r :+ p))
  -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
 -> Interval (Point 2 r :+ p) r
 -> Const (Point 2 r) (Interval (Point 2 r :+ p) r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (r :+ (Point 2 r :+ p))
    -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> Getting (Point 2 r) (Interval (Point 2 r :+ p) r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (r :+ (Point 2 r :+ p))
-> Const (Point 2 r) (r :+ (Point 2 r :+ p))
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> (r :+ (Point 2 r :+ p))
 -> Const (Point 2 r) (r :+ (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (r :+ (Point 2 r :+ p))
-> Const (Point 2 r) (r :+ (Point 2 r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)   Line 2 r
l

instance (Ord r, Fractional r) =>
         SubLine 2 p (UnBounded r) r `IsIntersectableWith` SubLine 2 p (UnBounded r) r where
  nonEmptyIntersection :: proxy (SubLine 2 p (UnBounded r) r)
-> proxy (SubLine 2 p (UnBounded r) r)
-> Intersection
     (SubLine 2 p (UnBounded r) r) (SubLine 2 p (UnBounded r) r)
-> Bool
nonEmptyIntersection = proxy (SubLine 2 p (UnBounded r) r)
-> proxy (SubLine 2 p (UnBounded r) r)
-> Intersection
     (SubLine 2 p (UnBounded r) r) (SubLine 2 p (UnBounded r) r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection

  sl :: SubLine 2 p (UnBounded r) r
sl@(SubLine Line 2 r
l Interval p (UnBounded r)
r) intersect :: SubLine 2 p (UnBounded r) r
-> SubLine 2 p (UnBounded r) r
-> Intersection
     (SubLine 2 p (UnBounded r) r) (SubLine 2 p (UnBounded r) r)
`intersect` sm :: SubLine 2 p (UnBounded r) r
sm@(SubLine Line 2 r
m Interval p (UnBounded r)
_) = CoRec Identity '[NoIntersection, Point 2 r, Line 2 r]
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec
        Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Line 2 r
l Line 2 r -> Line 2 r -> Intersection (Line 2 r) (Line 2 r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Line 2 r
m) (Handlers
   '[NoIntersection, Point 2 r, Line 2 r]
   (CoRec
      Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
 -> CoRec
      Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec
        Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]
forall a b. (a -> b) -> a -> b
$
         (NoIntersection
 -> CoRec
      Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> Handler
     (CoRec
        Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
     NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
      Handler
  (CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
  NoIntersection
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]))
     '[Point 2 r, Line 2 r]
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec
        Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
 -> CoRec
      Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> Handler
     (CoRec
        Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
     (Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\p :: Point 2 r
p@(Point Vector 2 r
_)    -> if Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
forall r p.
(Ord r, Fractional r) =>
Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
inSubLineIntervalUB Point 2 r
p SubLine 2 p (UnBounded r) r
sl Bool -> Bool -> Bool
&& Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
forall r p.
(Ord r, Fractional r) =>
Point 2 r -> SubLine 2 p (UnBounded r) r -> Bool
inSubLineIntervalUB Point 2 r
p SubLine 2 p (UnBounded r) r
sm
                                 then Point 2 r
-> CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
p
                                 else NoIntersection
-> CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
      Handler
  (CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
  (Point 2 r)
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]))
     '[Line 2 r]
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]))
     '[Point 2 r, Line 2 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Line 2 r
 -> CoRec
      Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> Handler
     (CoRec
        Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
     (Line 2 r)
forall b a. (a -> b) -> Handler b a
H (\Line 2 r
_              -> CoRec Identity '[NoIntersection, Interval p (UnBounded r)]
-> Handlers
     '[NoIntersection, Interval p (UnBounded r)]
     (CoRec
        Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Interval p (UnBounded r)
r Interval p (UnBounded r)
-> Interval p (UnBounded r)
-> Intersection
     (Interval p (UnBounded r)) (Interval p (UnBounded r))
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Interval p (UnBounded r)
s'') (Handlers
   '[NoIntersection, Interval p (UnBounded r)]
   (CoRec
      Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
 -> CoRec
      Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> Handlers
     '[NoIntersection, Interval p (UnBounded r)]
     (CoRec
        Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]
forall a b. (a -> b) -> a -> b
$
                                      (NoIntersection
 -> CoRec
      Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> Handler
     (CoRec
        Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
     NoIntersection
forall b a. (a -> b) -> Handler b a
H NoIntersection
-> CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec -- NoIntersection
                                   Handler
  (CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
  NoIntersection
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]))
     '[Interval p (UnBounded r)]
-> Handlers
     '[NoIntersection, Interval p (UnBounded r)]
     (CoRec
        Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Interval p (UnBounded r)
 -> CoRec
      Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> Handler
     (CoRec
        Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
     (Interval p (UnBounded r))
forall b a. (a -> b) -> Handler b a
H (SubLine 2 p (UnBounded r) r
-> CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (SubLine 2 p (UnBounded r) r
 -> CoRec
      Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
-> (Interval p (UnBounded r) -> SubLine 2 p (UnBounded r) r)
-> Interval p (UnBounded r)
-> CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line 2 r -> Interval p (UnBounded r) -> SubLine 2 p (UnBounded r) r
forall (d :: Nat) p s r.
Line d r -> Interval p s -> SubLine d p s r
SubLine Line 2 r
l)
                                   Handler
  (CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
  (Interval p (UnBounded r))
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]))
     '[]
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]))
     '[Interval p (UnBounded r)]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler
     (CoRec
        Identity
        '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]))
  '[]
forall u (a :: u -> *). Rec a '[]
RNil
           )
      Handler
  (CoRec
     Identity '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r])
  (Line 2 r)
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]))
     '[]
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]))
     '[Line 2 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler
     (CoRec
        Identity
        '[NoIntersection, Point 2 r, SubLine 2 p (UnBounded r) r]))
  '[]
forall u (a :: u -> *). Rec a '[]
RNil
    where
      -- convert to points, then convert back to 'r' values (but now w.r.t. l)
      s' :: Interval p (UnBounded (Point 2 r))
s'  = SubLine 2 p (UnBounded r) r -> Interval p (UnBounded (Point 2 r))
forall r (d :: Nat) p.
(Num r, Arity d) =>
SubLine d p (UnBounded r) r -> Interval p (UnBounded (Point d r))
getEndPointsUnBounded SubLine 2 p (UnBounded r) r
sm
      s'' :: Interval p (UnBounded r)
s'' = (UnBounded (Point 2 r) -> UnBounded r)
-> Interval p (UnBounded (Point 2 r)) -> Interval p (UnBounded r)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Point 2 r -> r) -> UnBounded (Point 2 r) -> UnBounded r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point 2 r -> r
f) Interval p (UnBounded (Point 2 r))
s'
      f :: Point 2 r -> r
f = (Point 2 r -> Line 2 r -> r) -> Line 2 r -> Point 2 r -> r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point 2 r -> Line 2 r -> r
forall r (d :: Nat).
(Eq r, Fractional r, Arity d) =>
Point d r -> Line d r -> r
toOffset' Line 2 r
l

-- | Get the endpoints of an unbounded interval
getEndPointsUnBounded    :: (Num r, Arity d) => SubLine d p (UnBounded r) r
                         -> Interval p (UnBounded (Point d r))
getEndPointsUnBounded :: SubLine d p (UnBounded r) r -> Interval p (UnBounded (Point d r))
getEndPointsUnBounded SubLine d p (UnBounded r) r
sl = (UnBounded r -> UnBounded (Point d r))
-> Interval p (UnBounded r) -> Interval p (UnBounded (Point d r))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((r -> Point d r) -> UnBounded r -> UnBounded (Point d r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> Point d r
f) (Interval p (UnBounded r) -> Interval p (UnBounded (Point d r)))
-> Interval p (UnBounded r) -> Interval p (UnBounded (Point d r))
forall a b. (a -> b) -> a -> b
$ SubLine d p (UnBounded r) r
slSubLine d p (UnBounded r) r
-> Getting
     (Interval p (UnBounded r))
     (SubLine d p (UnBounded r) r)
     (Interval p (UnBounded r))
-> Interval p (UnBounded r)
forall s a. s -> Getting a s a -> a
^.Getting
  (Interval p (UnBounded r))
  (SubLine d p (UnBounded r) r)
  (Interval p (UnBounded r))
forall (d :: Nat) p1 s1 r p2 s2.
Lens
  (SubLine d p1 s1 r)
  (SubLine d p2 s2 r)
  (Interval p1 s1)
  (Interval p2 s2)
subRange
  where
    f :: r -> Point d r
f = (r -> Line d r -> Point d r) -> Line d r -> r -> Point d r
forall a b c. (a -> b -> c) -> b -> a -> c
flip r -> Line d r -> Point d r
forall r (d :: Nat). (Num r, Arity d) => r -> Line d r -> Point d r
pointAt (SubLine d p (UnBounded r) r
slSubLine d p (UnBounded r) r
-> Getting (Line d r) (SubLine d p (UnBounded r) r) (Line d r)
-> Line d r
forall s a. s -> Getting a s a -> a
^.Getting (Line d r) (SubLine d p (UnBounded r) r) (Line d r)
forall (d1 :: Nat) p s r1 (d2 :: Nat) r2.
Lens
  (SubLine d1 p s r1) (SubLine d2 p s r2) (Line d1 r1) (Line d2 r2)
line)

-- | Create a SubLine that covers the original line from -infinity to +infinity.
fromLine   :: Arity d => Line d r -> SubLine d () (UnBounded r) r
fromLine :: Line d r -> SubLine d () (UnBounded r) r
fromLine Line d r
l = Line d r
-> Interval () (UnBounded r) -> SubLine d () (UnBounded r) r
forall (d :: Nat) p s r.
Line d r -> Interval p s -> SubLine d p s r
SubLine Line d r
l ((UnBounded r :+ ())
-> (UnBounded r :+ ()) -> Interval () (UnBounded r)
forall r a. (r :+ a) -> (r :+ a) -> Interval a r
ClosedInterval (UnBounded r -> UnBounded r :+ ()
forall a. a -> a :+ ()
ext UnBounded r
forall a. UnBounded a
MinInfinity) (UnBounded r -> UnBounded r :+ ()
forall a. a -> a :+ ()
ext UnBounded r
forall a. UnBounded a
MaxInfinity))


-- testL :: SubLine 2 () (UnBounded Rational)
-- testL = SubLine (horizontalLine 0) (Interval (Closed (only 0)) (Open $ only 10))

-- horL :: SubLine 2 () (UnBounded Rational)
-- horL = fromLine $ horizontalLine 0


-- test = (testL^.subRange) `intersect` (horL^.subRange)

-- toOffset (Point2 minInfinity minInfinity) (horizontalLine 0)
-- testzz = let f  = bimap (fmap Val) (const ())
--          in

-- testz :: SubLine 2 () Rational Rational
-- testz = SubLine (Line (Point2 0 0) (Vector2 10 0))
--                 (Interval (Closed (0 % 1 :+ ())) (Closed (1 % 1 :+ ())))