{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DefaultSignatures #-}
{-# OPTIONS_GHC -Wno-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Point.Class
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A class of types that can act as \(d\)-dimensional points.
--
--------------------------------------------------------------------------------
module HGeometry.Point.Class
  ( HasVector(..)
  , HasCoordinates(..)
  , Affine_(..)
  , Point_(..), pattern Point1_, pattern Point2_, pattern Point3_, pattern Point4_
  , ConstructablePoint_(..)
  , origin
  , pointFromList
  , coord
  , xCoord, yCoord, zCoord, wCoord
  , dCoord

  -- , projectPoint
  -- , PointFor
  , HasPoints(..), HasPoints'
  ) where

import           Control.Lens
import           Data.Default
import           Data.Function (on)
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Proxy (Proxy(..))
import           GHC.TypeNats
import           HGeometry.Ext
import           HGeometry.Properties
import           HGeometry.Vector
import qualified Linear.Affine as Linear

-- $setup
-- >>> import HGeometry.Point
-- >>> :{
-- let myVector :: Vector 3 Int
--     myVector = Vector3 1 2 3
--     myPoint = Point myVector
-- :}


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

-- | Type class for types, usually points, that have a Lens to interpret the
-- point as a vector.
class HasVector point point' where
  -- | Lens to access the vector corresponding to this point.
  --
  -- >>> myPoint ^. vector
  -- Vector3 1 2 3
  -- >>> ( myPoint & vector .~ Vector3 3 2 1  ) :: Point 3 Int
  -- Point3 3 2 1
  -- >>> (myPoint & coordinates %~ show ) :: Point 3 String
  -- Point3 "1" "2" "3"
  vector :: ( Dimension point ~ d
            , NumType point ~ r
            , Dimension point' ~  d
            , NumType point' ~ s
            )
         => Lens point point' (Vector d r) (Vector d s)

type instance Dimension (Linear.Point v r) = Dimension (v r)
type instance NumType (Linear.Point v r)   = r

instance ( Vector_ (v r) d r
         , Vector_ (v s) d s
         ) => HasVector (Linear.Point v r) (Linear.Point v s) where
  vector :: forall (d :: Nat) r s.
(Dimension (Point v r) ~ d, NumType (Point v r) ~ r,
 Dimension (Point v s) ~ d, NumType (Point v s) ~ s) =>
Lens (Point v r) (Point v s) (Vector d r) (Vector d s)
vector = (Point v r -> Vector d r)
-> (Point v r -> Vector d s -> Point v s)
-> Lens (Point v r) (Point v s) (Vector d r) (Vector d s)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(Linear.P v r
v) -> v r
vv r -> Getting (Vector d r) (v r) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.(Vector d r -> Const (Vector d r) (Vector d r))
-> v r -> Const (Vector d r) (v r)
Getting (Vector d r) (v r) (Vector d r)
forall vector vector' (d :: Nat) r s.
AsVector_ vector vector' d r s =>
Iso vector vector' (Vector d r) (Vector d s)
Iso (v r) (v r) (Vector d r) (Vector d r)
_Vector)
                (\Point v r
_ Vector d s
v -> v s -> Point v s
forall (f :: * -> *) a. f a -> Point f a
Linear.P (v s -> Point v s) -> v s -> Point v s
forall a b. (a -> b) -> a -> b
$ Vector d s
vVector d s -> Getting (v s) (Vector d s) (v s) -> v s
forall s a. s -> Getting a s a -> a
^.AnIso (v s) (v s) (Vector d s) (Vector d s)
-> Iso (Vector d s) (Vector d s) (v s) (v s)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso (v s) (v s) (Vector d s) (Vector d s)
forall vector vector' (d :: Nat) r s.
AsVector_ vector vector' d r s =>
Iso vector vector' (Vector d r) (Vector d s)
Iso (v s) (v s) (Vector d s) (Vector d s)
_Vector)
  {-# INLINE vector #-}

-- | Class for point types that have a type changing traversal over
-- all coordinates.
class ( Has_ Vector_ (Dimension point) (NumType point)
      , Has_ Vector_ (Dimension point') (NumType point')
      , HasComponents (Vector (Dimension point') (NumType point))
                      (Vector (Dimension point') (NumType point'))
      , Dimension point ~ Dimension point'
      , HasVector point point'
      )
      => HasCoordinates point point' where
  -- | Traversal over *all* coordinates of the points. Coordinates are 1-indexed.
  --
  -- >>> imapMOf_ coordinates (\i x -> print (i,x)) (Point2 10 20 :: Point 2 Int)
  -- (1,10)
  -- (2,20)
  -- >>> itraverseOf coordinates (\i x -> print (i,x)) (Point2 10 20) :: IO (Point 2 ())
  -- (1,10)
  -- (2,20)
  -- Point2 () ()
  -- >>> over coordinates (+1) $ Point2 10 20 :: Point 2 Int
  -- Point2 11 21
  coordinates :: IndexedTraversal1 Int point point' (NumType point) (NumType point')
  coordinates = (Vector (Dimension point') (NumType point)
 -> f (Vector (Dimension point') (NumType point')))
-> point -> f point'
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point' ~ d,
 NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens
  point
  point'
  (Vector (Dimension point') (NumType point))
  (Vector (Dimension point') (NumType point'))
vector  ((Vector (Dimension point') (NumType point)
  -> f (Vector (Dimension point') (NumType point')))
 -> point -> f point')
-> (p (NumType point) (f (NumType point'))
    -> Vector (Dimension point') (NumType point)
    -> f (Vector (Dimension point') (NumType point')))
-> p (NumType point) (f (NumType point'))
-> point
-> f point'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int)
-> (Indexed Int (NumType point) (f (NumType point'))
    -> Vector (Dimension point') (NumType point)
    -> f (Vector (Dimension point') (NumType point')))
-> p (NumType point) (f (NumType point'))
-> Vector (Dimension point') (NumType point)
-> f (Vector (Dimension point') (NumType point'))
forall j (p :: * -> * -> *) i a b r.
Indexable j p =>
(i -> j) -> (Indexed i a b -> r) -> p a b -> r
reindexed (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Indexed Int (NumType point) (f (NumType point'))
-> Vector (Dimension point') (NumType point)
-> f (Vector (Dimension point') (NumType point'))
Indexed
  Int
  (IxValue (Vector (Dimension point') (NumType point)))
  (f (IxValue (Vector (Dimension point') (NumType point'))))
-> Vector (Dimension point') (NumType point)
-> f (Vector (Dimension point') (NumType point'))
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int
  (Vector (Dimension point') (NumType point))
  (Vector (Dimension point') (NumType point'))
  (IxValue (Vector (Dimension point') (NumType point)))
  (IxValue (Vector (Dimension point') (NumType point')))
components
  {-# INLINE coordinates #-}



-- | Affine space; essentially the same as Linear.Affine, but for
-- points of kind Type rather than (Type -> Type).
class ( Additive_ (Vector d r) d r
      , HasCoordinates point point
      , d ~ Dimension point
      , r ~ NumType point
      ) => Affine_ point d r | point -> d
                             , point -> r where
  {-# MINIMAL #-}

  -- | p .-. q represents the vector from q to p
  (.-.) :: Num r => point -> point -> Vector d r
  default (.-.) :: (HasVector point point, Num r) => point -> point -> Vector d r
  point
p .-. point
q = (point
ppoint -> Getting (Vector d r) point (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point (Vector d r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector d r) (Vector d r)
vector) Vector d r -> Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^-^ (point
qpoint -> Getting (Vector d r) point (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) point (Vector d r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector d r) (Vector d r)
vector)
  {-# INLINE (.-.) #-}

  -- | add a vector to a point
  --
  -- >>> myPoint .+^ Vector3 100 200 300
  -- Point3 101 202 303
  (.+^) :: Num r => point -> Vector d r -> point
  default (.+^) :: (HasVector point point, Num r) => point -> Vector d r -> point
  point
p .+^ Vector d r
v = point
ppoint -> (point -> point) -> point
forall a b. a -> (a -> b) -> b
&(Vector d r -> Identity (Vector d r)) -> point -> Identity point
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector d r) (Vector d r)
vector ((Vector d r -> Identity (Vector d r)) -> point -> Identity point)
-> (Vector d r -> Vector d r) -> point -> point
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Vector d r -> Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^+^ Vector d r
v)
  {-# INLINE (.+^) #-}

  -- | subtract a vector from a point
  --
  -- >>> myPoint .-^ Vector3 100 200 300
  -- Point3 (-99) (-198) (-297)
  (.-^) :: Num r => point -> Vector d r -> point
  point
p .-^ Vector d r
v = point
p point -> Vector d r -> point
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated Vector d r
v
  {-# INLINE (.-^) #-}

instance ( d ~ Dimension (v r)
         , r ~ IxValue (v r)
         , s ~ IxValue (v s)
         , d ~ Dimension (v s)
         , Vector_ (v r) d r
         , Vector_ (v s) d s
         , Has_ Vector_ d r
         , Has_ Vector_ d s
         , HasComponents (Vector d r) (Vector d s)
         ) => HasCoordinates (Linear.Point v r) (Linear.Point v s)

instance ( d ~ Dimension (v r)
         , r ~ IxValue (v r)
         , Vector_ (v r) d r
         , Additive_ (Vector d r) d r
         ) => Affine_ (Linear.Point v r) d r where

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

-- | A class representing points in d-dimensional space.
class ( Affine_ point d r
      , HasVector point point
      ) => Point_ point d r where
  {-# MINIMAL #-}

  -- | Get the coordinate in a given dimension. This operation is unsafe in the
  -- sense that no bounds are checked. Consider using `coord` instead.
  --
  -- >>> myPoint ^.. coord' 2
  -- [2]
  coord'   :: Int -> IndexedTraversal' Int point r
  coord' Int
i = (Vector d r -> f (Vector d r)) -> point -> f point
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector d r) (Vector d r)
vector ((Vector d r -> f (Vector d r)) -> point -> f point)
-> (p r (f r) -> Vector d r -> f (Vector d r))
-> p r (f r)
-> point
-> f point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p r (f r) -> Vector d r -> f (Vector d r)
elem'
    where
      -- elem' :: IndexedTraversal' Int (VectorFor point) r
      elem' :: p r (f r) -> Vector d r -> f (Vector d r)
elem' = Int -> IndexedTraversal' Int (Vector d r) r
forall vector (d :: Nat) r.
Vector_ vector d r =>
Int -> IndexedTraversal' Int vector r
component' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                -- vectors are 0 indexed, whereas we are 1 indexed.
  {-# INLINE coord' #-}


-- | Type class for constructable points
class Point_ point d r => ConstructablePoint_ point d r where
  {-# MINIMAL fromVector #-}

  -- | Construct a point from a vector
  --
  -- >>> fromVector (Vector4 1 2 3 4) :: Point 4 Int
  -- Point4 1 2 3 4
  fromVector :: Vector d r -> point


-- | Get the coordinate in a given dimension
--
-- >>> myPoint ^. coord @2
-- 2
-- >>> myPoint & coord @1 .~ 10
-- Point3 10 2 3
-- >>> myPoint & coord @3 %~ (+1)
-- Point3 1 2 4
coord :: forall i point d r. (1 <= i, i <= d, KnownNat i, Point_ point d r)
      => IndexedLens' Int point r
coord :: forall (i :: Nat) point (d :: Nat) r.
(1 <= i, i <= d, KnownNat i, Point_ point d r) =>
IndexedLens' Int point r
coord = Traversing p f point point r r -> Over p f point point r r
forall (p :: * -> * -> *) (f :: * -> *) s t a.
(HasCallStack, Conjoined p, Functor f) =>
Traversing p f s t a a -> Over p f s t a a
singular (Traversing p f point point r r -> Over p f point point r r)
-> Traversing p f point point r r -> Over p f point point r r
forall a b. (a -> b) -> a -> b
$ Int -> IndexedTraversal' Int point r
forall point (d :: Nat) r.
Point_ point d r =>
Int -> IndexedTraversal' Int point r
coord' (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nat -> Int) -> (Proxy i -> Nat) -> Proxy i -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy i -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (Proxy i -> Int) -> Proxy i -> Int
forall a b. (a -> b) -> a -> b
$ forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @i)
{-# INLINE coord #-}


instance ( d ~ Dimension (v r)
         , r ~ IxValue (v r)
         , Vector_ (v r) d r
         , Additive_ (Vector d r) d r
         ) => Point_ (Linear.Point v r) d r

instance ( d ~ Dimension (v r)
         , r ~ IxValue (v r)
         , Vector_ (v r) d r
         , Additive_ (Vector d r) d r
         ) => ConstructablePoint_ (Linear.Point v r) d r where
  fromVector :: Vector d r -> Point v r
fromVector = v r -> Point v r
forall (f :: * -> *) a. f a -> Point f a
Linear.P (v r -> Point v r)
-> (Vector d r -> v r) -> Vector d r -> Point v r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview (v r) (Vector d r) -> Vector d r -> v r
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (v r) (Vector d r)
forall vector vector' (d :: Nat) r s.
AsVector_ vector vector' d r s =>
Iso vector vector' (Vector d r) (Vector d s)
Iso (v r) (v r) (Vector d r) (Vector d r)
_Vector
  {-# INLINE fromVector #-}

-- | Point representing the origin in d dimensions
--
-- >>> origin :: Point 4 Int
-- Point4 0 0 0 0
origin :: forall point d r. (Num r, ConstructablePoint_ point d r) => point
origin :: forall point (d :: Nat) r.
(Num r, ConstructablePoint_ point d r) =>
point
origin = Vector d r -> point
forall point (d :: Nat) r.
ConstructablePoint_ point d r =>
Vector d r -> point
fromVector Vector d r
forall r vector (d :: Nat). (Num r, Additive_ vector d r) => vector
zero
{-# INLINE origin #-}

-- | A pattern synonym for 1 dimensional points.
pattern Point1_   :: Point_ point 1 r => r -> point
pattern $mPoint1_ :: forall {r} {point} {r}.
Point_ point 1 r =>
point -> (r -> r) -> ((# #) -> r) -> r
Point1_ x <- (view xCoord -> x)
--   where
--     Point1_ x = fromVector $ Vector1 x
-- {-# INLINE Point1_ #-}
{-# COMPLETE Point1_ #-}

-- | A pattern synonym for 2 dimensional points.
pattern Point2_     :: ( Point_ point 2 r
                       ) => r -> r -> point
pattern $mPoint2_ :: forall {r} {point} {r}.
Point_ point 2 r =>
point -> (r -> r -> r) -> ((# #) -> r) -> r
Point2_ x y <- (view vector -> Vector2 x y)
--  where
--    Point2_ x y = fromVector $ Vector2 x y
-- {-# INLINE Point2_ #-}
{-# COMPLETE Point2_ #-}


-- | A pattern synonym for 3 dimensional points.
pattern Point3_       :: ( Point_ point 3 r
                         ) => r -> r -> r -> point
pattern $mPoint3_ :: forall {r} {point} {r}.
Point_ point 3 r =>
point -> (r -> r -> r -> r) -> ((# #) -> r) -> r
Point3_ x y z <- (view vector -> Vector3 x y z)
--   where
--     Point3_ x y z = fromVector $ Vector3 x y z
-- {-# INLINE Point3_ #-}
{-# COMPLETE Point3_ #-}

-- | A bidirectional pattern synonym for 4 dimensional points.
pattern Point4_         :: ( Point_ point 4 r
                           ) => r -> r -> r -> r -> point
pattern $mPoint4_ :: forall {r} {point} {r}.
Point_ point 4 r =>
point -> (r -> r -> r -> r -> r) -> ((# #) -> r) -> r
Point4_ x y z w <- (view vector -> Vector4 x y z w)
--   where
--     Point4_ x y z w = fromVector $ Vector4 x y z w
-- {-# INLINE Point4_ #-}
{-# COMPLETE Point4_ #-}


-- | Constructs a point from a list of coordinates. The length of the
-- list has to match the dimension exactly.
--
-- >>> pointFromList [1,2,3] :: Maybe (Point 3 Int)
-- Just (Point3 1 2 3)
-- >>> pointFromList [1] :: Maybe (Point 3 Int)
-- Nothing
-- >>> pointFromList [1,2,3,4] :: Maybe (Point 3 Int)
-- Nothing
pointFromList :: ( ConstructablePoint_ point d r
                 , Vector_ (Vector d r) d r
                 ) => [r] -> Maybe point
pointFromList :: forall point (d :: Nat) r.
(ConstructablePoint_ point d r, Vector_ (Vector d r) d r) =>
[r] -> Maybe point
pointFromList = (Vector d r -> point) -> Maybe (Vector d r) -> Maybe point
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector d r -> point
forall point (d :: Nat) r.
ConstructablePoint_ point d r =>
Vector d r -> point
fromVector (Maybe (Vector d r) -> Maybe point)
-> ([r] -> Maybe (Vector d r)) -> [r] -> Maybe point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> Maybe (Vector d r)
forall vector (d :: Nat) r.
Vector_ vector d r =>
[r] -> Maybe vector
vectorFromList
{-# INLINE pointFromList #-}

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

-- | Shorthand to access the first coordinate
--
-- >>> myPoint ^. xCoord
-- 1
-- >>> Point2 1 (2 :: Int) & xCoord .~ 10
-- Point2 10 2
xCoord :: (1 <= d, Point_ point d r) => IndexedLens' Int point r
xCoord :: forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
xCoord = forall (i :: Nat) point (d :: Nat) r.
(1 <= i, i <= d, KnownNat i, Point_ point d r) =>
IndexedLens' Int point r
coord @1
{-# INLINABLE xCoord #-}

-- | Shorthand to access the second coordinate
--
-- >>> Point2 1 (2 :: Int) ^. yCoord
-- 2
-- >>> myPoint & yCoord %~ (+1)
-- Point3 1 3 3
yCoord :: (2 <= d, Point_ point d r) => IndexedLens' Int point r
yCoord :: forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
yCoord = forall (i :: Nat) point (d :: Nat) r.
(1 <= i, i <= d, KnownNat i, Point_ point d r) =>
IndexedLens' Int point r
coord @2
{-# INLINABLE yCoord #-}

-- | Shorthand to access the third coordinate
--
-- >>> myPoint ^. zCoord
-- 3
-- >>> myPoint & zCoord %~ (+1)
-- Point3 1 2 4
zCoord :: (3 <= d, Point_ point d r) => IndexedLens' Int point r
zCoord :: forall (d :: Nat) point r.
(3 <= d, Point_ point d r) =>
IndexedLens' Int point r
zCoord = forall (i :: Nat) point (d :: Nat) r.
(1 <= i, i <= d, KnownNat i, Point_ point d r) =>
IndexedLens' Int point r
coord @3
{-# INLINABLE zCoord #-}

-- | Shorthand to access the fourth coordinate
--
-- >>> (Point4 1 2 3 4 :: Point 4 Int) ^. wCoord
-- 4
-- >>> (Point4 1 2 3 4 :: Point 4 Int) & wCoord %~ (+1)
-- Point4 1 2 3 5
wCoord :: (4 <= d, Point_ point d r) => IndexedLens' Int point r
wCoord :: forall (d :: Nat) point r.
(4 <= d, Point_ point d r) =>
IndexedLens' Int point r
wCoord = forall (i :: Nat) point (d :: Nat) r.
(1 <= i, i <= d, KnownNat i, Point_ point d r) =>
IndexedLens' Int point r
coord @4
{-# INLINABLE wCoord #-}

-- | Shorthand to access the last coordinate
--
-- >>> (Point2 1 2 :: Point 2 Int) ^. dCoord
-- 2
-- >>> (Point4 1 2 3 4 :: Point 4 Int) ^. dCoord
-- 4
-- >>> (Point4 1 2 3 4 :: Point 4 Int) & dCoord %~ (+1)
-- Point4 1 2 3 5
dCoord :: forall point d r. (1 <= d, Point_ point d r) => IndexedLens' Int point r
dCoord :: forall point (d :: Nat) r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
dCoord = forall (i :: Nat) point (d :: Nat) r.
(1 <= i, i <= d, KnownNat i, Point_ point d r) =>
IndexedLens' Int point r
coord @d

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

-- | Data types that store points
class HasPoints s t point point' | s -> point
                                 , t -> point' where
  -- | Traversal over all points in the structure
  --
  -- >>> let xs = NonEmpty.fromList [Point2 10 10, Point2 20 (30 :: Int)]
  -- >>> xs^..allPoints
  -- [Point2 10 10,Point2 20 30]
  -- >>> over allPoints (.+^ Vector2 10 10) xs :: NonEmpty.NonEmpty (Point 2 Int)
  -- Point2 20 20 :| [Point2 30 40]
  allPoints :: ( Point_ point  d r
               , Point_ point' d r'
               , NumType s ~ r
               , NumType t ~ r'
               , Dimension s ~ d, Dimension t ~ d
               ) => Traversal1 s t point point'

instance HasPoints (NonEmpty.NonEmpty point) (NonEmpty.NonEmpty point') point point' where
  allPoints :: forall (d :: Nat) r r'.
(Point_ point d r, Point_ point' d r',
 NumType (NonEmpty point) ~ r, NumType (NonEmpty point') ~ r',
 Dimension (NonEmpty point) ~ d, Dimension (NonEmpty point') ~ d) =>
Traversal1 (NonEmpty point) (NonEmpty point') point point'
allPoints = (point -> f point') -> NonEmpty point -> f (NonEmpty point')
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse1

-- | Shorthand for 'HasPoints s s point point'
type HasPoints' s point = HasPoints s s point point

instance HasPoints (Linear.Point v r) (Linear.Point v' r')
                   (Linear.Point v r) (Linear.Point v' r') where
  allPoints :: forall (d :: Nat) r r'.
(Point_ (Point v r) d r, Point_ (Point v' r') d r',
 NumType (Point v r) ~ r, NumType (Point v' r') ~ r',
 Dimension (Point v r) ~ d, Dimension (Point v' r') ~ d) =>
Traversal1 (Point v r) (Point v' r') (Point v r) (Point v' r')
allPoints = (Point v r -> f (Point v' r')) -> Point v r -> f (Point v' r')
forall a. a -> a
id


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

instance HasVector point point' => HasVector (point :+ extra) (point' :+ extra) where
  vector :: forall (d :: Nat) r s.
(Dimension (point :+ extra) ~ d, NumType (point :+ extra) ~ r,
 Dimension (point' :+ extra) ~ d, NumType (point' :+ extra) ~ s) =>
Lens (point :+ extra) (point' :+ extra) (Vector d r) (Vector d s)
vector = (point -> f point') -> (point :+ extra) -> f (point' :+ extra)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core((point -> f point') -> (point :+ extra) -> f (point' :+ extra))
-> ((Vector d r -> f (Vector d s)) -> point -> f point')
-> (Vector d r -> f (Vector d s))
-> (point :+ extra)
-> f (point' :+ extra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector d r -> f (Vector d s)) -> point -> f point'
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point' ~ d,
 NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point' (Vector d r) (Vector d s)
vector
  {-# INLINE vector #-}

instance HasCoordinates point point' => HasCoordinates (point :+ extra) (point' :+ extra) where
  coordinates :: IndexedTraversal1
  Int
  (point :+ extra)
  (point' :+ extra)
  (NumType (point :+ extra))
  (NumType (point' :+ extra))
coordinates = (point -> f point') -> (point :+ extra) -> f (point' :+ extra)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core((point -> f point') -> (point :+ extra) -> f (point' :+ extra))
-> (p (NumType point) (f (NumType point')) -> point -> f point')
-> p (NumType point) (f (NumType point'))
-> (point :+ extra)
-> f (point' :+ extra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p (NumType point) (f (NumType point')) -> point -> f point'
forall point point'.
HasCoordinates point point' =>
IndexedTraversal1 Int point point' (NumType point) (NumType point')
IndexedTraversal1 Int point point' (NumType point) (NumType point')
coordinates
  {-# INLINE coordinates #-}

instance Affine_ point d r => Affine_ (point :+ extra) d r where
  .-. :: Num r => (point :+ extra) -> (point :+ extra) -> Vector d r
(.-.)   = point -> point -> Vector d r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
(.-.) (point -> point -> Vector d r)
-> ((point :+ extra) -> point)
-> (point :+ extra)
-> (point :+ extra)
-> Vector d r
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting point (point :+ extra) point -> (point :+ extra) -> point
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting point (point :+ extra) point
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core
  {-# INLINE (.-.) #-}
  point :+ extra
p .+^ :: Num r => (point :+ extra) -> Vector d r -> point :+ extra
.+^ Vector d r
v = point :+ extra
p(point :+ extra)
-> ((point :+ extra) -> point :+ extra) -> point :+ extra
forall a b. a -> (a -> b) -> b
&(point -> Identity point)
-> (point :+ extra) -> Identity (point :+ extra)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core ((point -> Identity point)
 -> (point :+ extra) -> Identity (point :+ extra))
-> (point -> point) -> (point :+ extra) -> point :+ extra
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (point -> Vector d r -> point
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector d r
v)
  {-# INLINE (.+^) #-}

instance (Point_ point d r) => Point_ (point :+ extra) d r where
  {-# SPECIALIZE instance Point_ point d r => Point_ (point :+ ()) d r #-}

instance (ConstructablePoint_ point d r, Default extra)
          => ConstructablePoint_ (point :+ extra) d r where
  {-# SPECIALIZE instance ConstructablePoint_ point d r
                          => ConstructablePoint_ (point :+ ()) d r #-}
  fromVector :: Vector d r -> point :+ extra
fromVector Vector d r
v = Vector d r -> point
forall point (d :: Nat) r.
ConstructablePoint_ point d r =>
Vector d r -> point
fromVector Vector d r
v point -> extra -> point :+ extra
forall core extra. core -> extra -> core :+ extra
:+ extra
forall a. Default a => a
def