{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Vector.VectorFixed
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.Geometry.Vector.VectorFixed where

import           Control.DeepSeq
import           Control.Lens hiding (element)
import           Data.Aeson
import qualified Data.Foldable as F
import           Data.Proxy
import qualified Data.Vector.Fixed as V
import           Data.Vector.Fixed (Arity)
import           Data.Functor.Classes
import           Data.Vector.Fixed.Boxed
import           GHC.Generics (Generic)
import           GHC.TypeLits
import           Linear.Affine (Affine(..))
import           Linear.Metric
import qualified Linear.V2 as L2
import qualified Linear.V3 as L3
import           Linear.Vector

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

-- | A proxy which can be used for the coordinates.
data C (n :: Nat) = C deriving (Int -> C n -> ShowS
[C n] -> ShowS
C n -> String
(Int -> C n -> ShowS)
-> (C n -> String) -> ([C n] -> ShowS) -> Show (C n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat). Int -> C n -> ShowS
forall (n :: Nat). [C n] -> ShowS
forall (n :: Nat). C n -> String
showList :: [C n] -> ShowS
$cshowList :: forall (n :: Nat). [C n] -> ShowS
show :: C n -> String
$cshow :: forall (n :: Nat). C n -> String
showsPrec :: Int -> C n -> ShowS
$cshowsPrec :: forall (n :: Nat). Int -> C n -> ShowS
Show,ReadPrec [C n]
ReadPrec (C n)
Int -> ReadS (C n)
ReadS [C n]
(Int -> ReadS (C n))
-> ReadS [C n] -> ReadPrec (C n) -> ReadPrec [C n] -> Read (C n)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (n :: Nat). ReadPrec [C n]
forall (n :: Nat). ReadPrec (C n)
forall (n :: Nat). Int -> ReadS (C n)
forall (n :: Nat). ReadS [C n]
readListPrec :: ReadPrec [C n]
$creadListPrec :: forall (n :: Nat). ReadPrec [C n]
readPrec :: ReadPrec (C n)
$creadPrec :: forall (n :: Nat). ReadPrec (C n)
readList :: ReadS [C n]
$creadList :: forall (n :: Nat). ReadS [C n]
readsPrec :: Int -> ReadS (C n)
$creadsPrec :: forall (n :: Nat). Int -> ReadS (C n)
Read,C n -> C n -> Bool
(C n -> C n -> Bool) -> (C n -> C n -> Bool) -> Eq (C n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: Nat). C n -> C n -> Bool
/= :: C n -> C n -> Bool
$c/= :: forall (n :: Nat). C n -> C n -> Bool
== :: C n -> C n -> Bool
$c== :: forall (n :: Nat). C n -> C n -> Bool
Eq,Eq (C n)
Eq (C n)
-> (C n -> C n -> Ordering)
-> (C n -> C n -> Bool)
-> (C n -> C n -> Bool)
-> (C n -> C n -> Bool)
-> (C n -> C n -> Bool)
-> (C n -> C n -> C n)
-> (C n -> C n -> C n)
-> Ord (C n)
C n -> C n -> Bool
C n -> C n -> Ordering
C n -> C n -> C n
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 (n :: Nat). Eq (C n)
forall (n :: Nat). C n -> C n -> Bool
forall (n :: Nat). C n -> C n -> Ordering
forall (n :: Nat). C n -> C n -> C n
min :: C n -> C n -> C n
$cmin :: forall (n :: Nat). C n -> C n -> C n
max :: C n -> C n -> C n
$cmax :: forall (n :: Nat). C n -> C n -> C n
>= :: C n -> C n -> Bool
$c>= :: forall (n :: Nat). C n -> C n -> Bool
> :: C n -> C n -> Bool
$c> :: forall (n :: Nat). C n -> C n -> Bool
<= :: C n -> C n -> Bool
$c<= :: forall (n :: Nat). C n -> C n -> Bool
< :: C n -> C n -> Bool
$c< :: forall (n :: Nat). C n -> C n -> Bool
compare :: C n -> C n -> Ordering
$ccompare :: forall (n :: Nat). C n -> C n -> Ordering
$cp1Ord :: forall (n :: Nat). Eq (C n)
Ord)

--------------------------------------------------------------------------------
-- * d dimensional Vectors

-- | Datatype representing d dimensional vectors. Our implementation wraps the
-- implementation provided by fixed-vector.
newtype Vector (d :: Nat)  (r :: *) = Vector { Vector d r -> Vec d r
_unV :: Vec d r }
                                    deriving ((forall x. Vector d r -> Rep (Vector d r) x)
-> (forall x. Rep (Vector d r) x -> Vector d r)
-> Generic (Vector d r)
forall x. Rep (Vector d r) x -> Vector d r
forall x. Vector d r -> Rep (Vector d r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (d :: Nat) r x. Rep (Vector d r) x -> Vector d r
forall (d :: Nat) r x. Vector d r -> Rep (Vector d r) x
$cto :: forall (d :: Nat) r x. Rep (Vector d r) x -> Vector d r
$cfrom :: forall (d :: Nat) r x. Vector d r -> Rep (Vector d r) x
Generic)

unV :: Lens' (Vector d r) (Vec d r)
unV :: (Vec d r -> f (Vec d r)) -> Vector d r -> f (Vector d r)
unV = (Vector d r -> Vec d r)
-> (Vector d r -> Vec d r -> Vector d r)
-> Lens (Vector d r) (Vector d r) (Vec d r) (Vec d r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Vector d r -> Vec d r
forall (d :: Nat) r. Vector d r -> Vec d r
_unV ((Vec d r -> Vector d r) -> Vector d r -> Vec d r -> Vector d r
forall a b. a -> b -> a
const Vec d r -> Vector d r
forall (d :: Nat) r. Vec d r -> Vector d r
Vector)

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

-- | Lens into the i th element
element   :: forall proxy i d r. (Arity d, Arity i, (i + 1) <= d)
          => proxy i -> Lens' (Vector d r) r
element :: proxy i -> Lens' (Vector d r) r
element proxy i
_ = Proxy i -> (r -> f r) -> Vector d r -> f (Vector d r)
forall (v :: * -> *) a (k :: Nat) (f :: * -> *)
       (proxy :: Nat -> *).
(Vector v a, KnownNat k, (k + 1) <= Dim v, Functor f) =>
proxy k -> (a -> f a) -> v a -> f (v a)
V.elementTy (Proxy i
forall k (t :: k). Proxy t
Proxy :: Proxy i)

-- | Similar to 'element' above. Except that we don't have a static guarantee
-- that the index is in bounds. Hence, we can only return a Traversal
element'   :: forall d r. Arity d => Int -> Traversal' (Vector d r) r
element' :: Int -> Traversal' (Vector d r) r
element' Int
i r -> f r
f Vector d r
v
  | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Integer -> Int
forall a. Num a => Integer -> a
fromInteger (C d -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (C d
forall (n :: Nat). C n
C :: C d)) = r -> f r
f (Vector d r
v Vector d r -> Int -> r
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.! Int
i)
                                                 f r -> (r -> Vector d r) -> f (Vector d r)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \r
a -> Vector d r
vVector d r -> (Vector d r -> Vector d r) -> Vector d r
forall a b. a -> (a -> b) -> b
&Int -> (r -> Identity r) -> Vector d r -> Identity (Vector d r)
forall (v :: * -> *) a (f :: * -> *).
(Vector v a, Functor f) =>
Int -> (a -> f a) -> v a -> f (v a)
V.element Int
i ((r -> Identity r) -> Vector d r -> Identity (Vector d r))
-> r -> Vector d r -> Vector d r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ r
a
       -- Implementation based on that of Ixed Vector in Control.Lens.At
  | Bool
otherwise                                     = Vector d r -> f (Vector d r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector d r
v


vectorFromList :: Arity d => [a] -> Maybe (Vector d a)
vectorFromList :: [a] -> Maybe (Vector d a)
vectorFromList = (Vec d a -> Vector d a) -> Maybe (Vec d a) -> Maybe (Vector d a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vec d a -> Vector d a
forall (d :: Nat) r. Vec d r -> Vector d r
Vector (Maybe (Vec d a) -> Maybe (Vector d a))
-> ([a] -> Maybe (Vec d a)) -> [a] -> Maybe (Vector d a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (Vec d a)
forall (v :: * -> *) a. Vector v a => [a] -> Maybe (v a)
V.fromListM

vectorFromListUnsafe :: Arity d => [a] -> Vector d a
vectorFromListUnsafe :: [a] -> Vector d a
vectorFromListUnsafe = Vec d a -> Vector d a
forall (d :: Nat) r. Vec d r -> Vector d r
Vector (Vec d a -> Vector d a) -> ([a] -> Vec d a) -> [a] -> Vector d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vec d a
forall (v :: * -> *) a. Vector v a => [a] -> v a
V.fromList


instance (Show r, Arity d) => Show (Vector d r) where
  show :: Vector d r -> String
show (Vector Vec d r
v) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [ String
"Vector", Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Vec d r -> Int
forall (v :: * -> *) a. KnownNat (Dim v) => v a -> Int
V.length Vec d r
v , String
" "
                            , [r] -> String
forall a. Show a => a -> String
show ([r] -> String) -> [r] -> String
forall a b. (a -> b) -> a -> b
$ Vec d r -> [r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vec d r
v
                            ]

deriving instance (Eq r, Arity d)   => Eq (Vector d r)

-- FIXME: Upstream Eq1 instance to 'fixed-vector' package.
instance Arity d => Eq1 (Vector d) where
  liftEq :: (a -> b -> Bool) -> Vector d a -> Vector d b -> Bool
liftEq a -> b -> Bool
eq (Vector Vec d a
lhs) (Vector Vec d b
rhs) = Vec d Bool -> Bool
forall (v :: * -> *). Vector v Bool => v Bool -> Bool
V.and (Vec d Bool -> Bool) -> Vec d Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> b -> Bool) -> Vec d a -> Vec d b -> Vec d Bool
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
V.zipWith a -> b -> Bool
eq Vec d a
lhs Vec d b
rhs

deriving instance (Ord r, Arity d)  => Ord (Vector d r)
-- deriving instance Arity d  => Functor (Vector d)

-- for some weird reason, implemeting this myself yields is faster code
instance Arity d  => Functor (Vector d) where
  fmap :: (a -> b) -> Vector d a -> Vector d b
fmap a -> b
f (Vector Vec d a
v) = Vec d b -> Vector d b
forall (d :: Nat) r. Vec d r -> Vector d r
Vector (Vec d b -> Vector d b) -> Vec d b -> Vector d b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Vec d a -> Vec d b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Vec d a
v

deriving instance Arity d  => Foldable (Vector d)
deriving instance Arity d  => Applicative (Vector d)

instance Arity d => Traversable (Vector d) where
  traverse :: (a -> f b) -> Vector d a -> f (Vector d b)
traverse a -> f b
f (Vector Vec d a
v) = Vec d b -> Vector d b
forall (d :: Nat) r. Vec d r -> Vector d r
Vector (Vec d b -> Vector d b) -> f (Vec d b) -> f (Vector d b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Vec d a -> f (Vec d b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Vec d a
v

deriving instance (Arity d, NFData r) => NFData (Vector d r)


instance Arity d => Additive (Vector d) where
  zero :: Vector d a
zero = a -> Vector d a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
0
  (Vector Vec d a
u) ^+^ :: Vector d a -> Vector d a -> Vector d a
^+^ (Vector Vec d a
v) = Vec d a -> Vector d a
forall (d :: Nat) r. Vec d r -> Vector d r
Vector (Vec d a -> Vector d a) -> Vec d a -> Vector d a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> Vec d a -> Vec d a -> Vec d a
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
V.zipWith a -> a -> a
forall a. Num a => a -> a -> a
(+) Vec d a
u Vec d a
v

instance Arity d => Affine (Vector d) where
  type Diff (Vector d) = Vector d

  Vector d a
u .-. :: Vector d a -> Vector d a -> Diff (Vector d) a
.-. Vector d a
v = Vector d a
u Vector d a -> Vector d a -> Vector d a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Vector d a
v
  Vector d a
p .+^ :: Vector d a -> Diff (Vector d) a -> Vector d a
.+^ Diff (Vector d) a
v = Vector d a
p Vector d a -> Vector d a -> Vector d a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Diff (Vector d) a
Vector d a
v


instance Arity d => Metric (Vector d)

type instance V.Dim (Vector d) = d

instance Arity d => V.Vector (Vector d) r where
  construct :: Fun (Peano (Dim (Vector d))) r (Vector d r)
construct  = Vec d r -> Vector d r
forall (d :: Nat) r. Vec d r -> Vector d r
Vector (Vec d r -> Vector d r)
-> Fun (Peano d) r (Vec d r) -> Fun (Peano d) r (Vector d r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun (Peano d) r (Vec d r)
forall (v :: * -> *) a. Vector v a => Fun (Peano (Dim v)) a (v a)
V.construct
  inspect :: Vector d r -> Fun (Peano (Dim (Vector d))) r b -> b
inspect    = Vec d r -> Fun (Peano d) r b -> b
forall (v :: * -> *) a b.
Vector v a =>
v a -> Fun (Peano (Dim v)) a b -> b
V.inspect (Vec d r -> Fun (Peano d) r b -> b)
-> (Vector d r -> Vec d r) -> Vector d r -> Fun (Peano d) r b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d r -> Vec d r
forall (d :: Nat) r. Vector d r -> Vec d r
_unV
  basicIndex :: Vector d r -> Int -> r
basicIndex = Vec d r -> Int -> r
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.basicIndex (Vec d r -> Int -> r)
-> (Vector d r -> Vec d r) -> Vector d r -> Int -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d r -> Vec d r
forall (d :: Nat) r. Vector d r -> Vec d r
_unV

instance (FromJSON r, Arity d, KnownNat d)  => FromJSON (Vector d r) where
  parseJSON :: Value -> Parser (Vector d r)
parseJSON Value
y = Value -> Parser [r]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
y Parser [r] -> ([r] -> Parser (Vector d r)) -> Parser (Vector d r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[r]
xs -> case [r] -> Maybe (Vector d r)
forall (d :: Nat) a. Arity d => [a] -> Maybe (Vector d a)
vectorFromList [r]
xs of
                  Maybe (Vector d r)
Nothing -> String -> Parser (Vector d r)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Vector d r))
-> ([String] -> String) -> [String] -> Parser (Vector d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> Parser (Vector d r))
-> [String] -> Parser (Vector d r)
forall a b. (a -> b) -> a -> b
$
                    [ String
"FromJSON (Vector d a), wrong number of elements. Expected "
                    , Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Proxy d -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
                    , String
" elements but found "
                    , Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [r] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [r]
xs
                    , String
"."
                    ]
                  Just Vector d r
v -> Vector d r -> Parser (Vector d r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector d r
v

instance (ToJSON r, Arity d) => ToJSON (Vector d r) where
  toJSON :: Vector d r -> Value
toJSON     = [r] -> Value
forall a. ToJSON a => a -> Value
toJSON     ([r] -> Value) -> (Vector d r -> [r]) -> Vector d r -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d r -> [r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
  toEncoding :: Vector d r -> Encoding
toEncoding = [r] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding ([r] -> Encoding) -> (Vector d r -> [r]) -> Vector d r -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d r -> [r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

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

-- | Get the head and tail of a vector
destruct            :: (Arity d, Arity (d + 1), 1 <= (d + 1))
                    => Vector (d + 1) r -> (r, Vector d r)
destruct :: Vector (d + 1) r -> (r, Vector d r)
destruct (Vector Vec (d + 1) r
v) = (Vec (d + 1) r -> r
forall (v :: * -> *) a. (Vector v a, 1 <= Dim v) => v a -> a
V.head Vec (d + 1) r
v, Vec d r -> Vector d r
forall (d :: Nat) r. Vec d r -> Vector d r
Vector (Vec d r -> Vector d r) -> Vec d r -> Vector d r
forall a b. (a -> b) -> a -> b
$ Vec (d + 1) r -> Vec d r
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a, Dim v ~ (Dim w + 1)) =>
v a -> w a
V.tail Vec (d + 1) r
v)


-- | Cross product of two three-dimensional vectors
cross       :: Num r => Vector 3 r -> Vector 3 r -> Vector 3 r
Vector 3 r
u cross :: Vector 3 r -> Vector 3 r -> Vector 3 r
`cross` Vector 3 r
v = V3 r -> Vector 3 r
forall a. V3 a -> Vector 3 a
fromV3 (V3 r -> Vector 3 r) -> V3 r -> Vector 3 r
forall a b. (a -> b) -> a -> b
$ Vector 3 r -> V3 r
forall a. Vector 3 a -> V3 a
toV3 Vector 3 r
u V3 r -> V3 r -> V3 r
forall a. Num a => V3 a -> V3 a -> V3 a
`L3.cross` Vector 3 r -> V3 r
forall a. Vector 3 a -> V3 a
toV3 Vector 3 r
v


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

-- | Vonversion to a Linear.V2
toV2                :: Vector 2 a -> L2.V2 a
toV2 :: Vector 2 a -> V2 a
toV2 ~(Vector2 a
a a
b) = a -> a -> V2 a
forall a. a -> a -> V2 a
L2.V2 a
a a
b

-- | Conversion to a Linear.V3
toV3                  :: Vector 3 a -> L3.V3 a
toV3 :: Vector 3 a -> V3 a
toV3 ~(Vector3 a
a a
b a
c) = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
L3.V3 a
a a
b a
c

-- | Conversion from a Linear.V3
fromV3               :: L3.V3 a -> Vector 3 a
fromV3 :: V3 a -> Vector 3 a
fromV3 (L3.V3 a
a a
b a
c) = a -> a -> a -> Vector 3 a
forall r. r -> r -> r -> Vector 3 r
v3 a
a a
b a
c

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

-- | Add an element at the back of the vector
snoc :: (Arity (d + 1), Arity d) => Vector d r -> r -> Vector (d + 1) r
snoc :: Vector d r -> r -> Vector (d + 1) r
snoc = (r -> Vector d r -> Vector (d + 1) r)
-> Vector d r -> r -> Vector (d + 1) r
forall a b c. (a -> b -> c) -> b -> a -> c
flip r -> Vector d r -> Vector (d + 1) r
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a, Dim w ~ (Dim v + 1)) =>
a -> v a -> w a
V.snoc

-- | Get a vector of the first d - 1 elements.
init :: (Arity d, Arity (d + 1)) => Vector (d + 1) r -> Vector d r
init :: Vector (d + 1) r -> Vector d r
init = Vec d r -> Vector d r
forall (d :: Nat) r. Vec d r -> Vector d r
Vector (Vec d r -> Vector d r)
-> (Vector (d + 1) r -> Vec d r) -> Vector (d + 1) r -> Vector d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vec d r -> Vec d r
forall (v :: * -> *) a. Vector v a => v a -> v a
V.reverse (Vec d r -> Vec d r)
-> (Vector (d + 1) r -> Vec d r) -> Vector (d + 1) r -> Vec d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vec (d + 1) r -> Vec d r
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a, Dim v ~ (Dim w + 1)) =>
v a -> w a
V.tail (Vec (d + 1) r -> Vec d r)
-> (Vector (d + 1) r -> Vec (d + 1) r)
-> Vector (d + 1) r
-> Vec d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vec (d + 1) r -> Vec (d + 1) r
forall (v :: * -> *) a. Vector v a => v a -> v a
V.reverse (Vec (d + 1) r -> Vec (d + 1) r)
-> (Vector (d + 1) r -> Vec (d + 1) r)
-> Vector (d + 1) r
-> Vec (d + 1) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (d + 1) r -> Vec (d + 1) r
forall (d :: Nat) r. Vector d r -> Vec d r
_unV

last :: forall d r. (Arity d, Arity (d + 1)) => Vector (d + 1) r -> r
last :: Vector (d + 1) r -> r
last = Getting r (Vector (d + 1) r) r -> Vector (d + 1) r -> r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting r (Vector (d + 1) r) r -> Vector (d + 1) r -> r)
-> Getting r (Vector (d + 1) r) r -> Vector (d + 1) r -> r
forall a b. (a -> b) -> a -> b
$ Proxy d -> Lens' (Vector (d + 1) r) r
forall (proxy :: Nat -> *) (i :: Nat) (d :: Nat) r.
(Arity d, Arity i, (i + 1) <= d) =>
proxy i -> Lens' (Vector d r) r
element (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)

-- | Get a prefix of i elements of a vector
prefix :: forall i d r. (Arity d, Arity i, i <= d)
       => Vector d r -> Vector i r
prefix :: Vector d r -> Vector i r
prefix = let i :: Int
i = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Proxy i -> Integer) -> Proxy i -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy i -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy i -> Int) -> Proxy i -> Int
forall a b. (a -> b) -> a -> b
$ (Proxy i
forall k (t :: k). Proxy t
Proxy :: Proxy i)
         in [r] -> Vector i r
forall (v :: * -> *) a. Vector v a => [a] -> v a
V.fromList ([r] -> Vector i r)
-> (Vector d r -> [r]) -> Vector d r -> Vector i r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [r] -> [r]
forall a. Int -> [a] -> [a]
take Int
i ([r] -> [r]) -> (Vector d r -> [r]) -> Vector d r -> [r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d r -> [r]
forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList

--------------------------------------------------------------------------------
-- * Functions specific to two and three dimensional vectors.

-- | Construct a 2 dimensional vector
v2     :: r -> r -> Vector 2 r
v2 :: r -> r -> Vector 2 r
v2 r
a r
b = Vec 2 r -> Vector 2 r
forall (d :: Nat) r. Vec d r -> Vector d r
Vector (Vec 2 r -> Vector 2 r) -> Vec 2 r -> Vector 2 r
forall a b. (a -> b) -> a -> b
$ r -> r -> Vec 2 r
forall (v :: * -> *) a. (Vector v a, Dim v ~ 2) => a -> a -> v a
V.mk2 r
a r
b

-- | Construct a 3 dimensional vector
v3      :: r -> r -> r -> Vector 3 r
v3 :: r -> r -> r -> Vector 3 r
v3 r
a r
b r
c = Vec 3 r -> Vector 3 r
forall (d :: Nat) r. Vec d r -> Vector d r
Vector (Vec 3 r -> Vector 3 r) -> Vec 3 r -> Vector 3 r
forall a b. (a -> b) -> a -> b
$ r -> r -> r -> Vec 3 r
forall (v :: * -> *) a.
(Vector v a, Dim v ~ 3) =>
a -> a -> a -> v a
V.mk3 r
a r
b r
c

-- | Destruct a 2 dim vector into a pair
_unV2 :: Vector 2 r -> (r,r)
_unV2 :: Vector 2 r -> (r, r)
_unV2 Vector 2 r
v = let [r
x,r
y] = Vector 2 r -> [r]
forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList Vector 2 r
v in (r
x,r
y)

_unV3 :: Vector 3 r -> (r,r,r)
_unV3 :: Vector 3 r -> (r, r, r)
_unV3 Vector 3 r
v = let [r
x,r
y,r
z] = Vector 3 r -> [r]
forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList Vector 3 r
v in (r
x,r
y,r
z)

-- | Pattern synonym for two and three dim vectors
pattern Vector2       :: r -> r -> Vector 2 r
pattern $bVector2 :: r -> r -> Vector 2 r
$mVector2 :: forall r r. Vector 2 r -> (r -> r -> r) -> (Void# -> r) -> r
Vector2 x y   <- (_unV2 -> (x,y))
  where
    Vector2 r
x r
y = r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
v2 r
x r
y
{-# COMPLETE Vector2 #-}

pattern Vector3       :: r -> r -> r -> Vector 3 r
pattern $bVector3 :: r -> r -> r -> Vector 3 r
$mVector3 :: forall r r. Vector 3 r -> (r -> r -> r -> r) -> (Void# -> r) -> r
Vector3 x y z <- (_unV3 -> (x,y,z))
  where
    Vector3 r
x r
y r
z = r -> r -> r -> Vector 3 r
forall r. r -> r -> r -> Vector 3 r
v3 r
x r
y r
z
{-# COMPLETE Vector3 #-}


pattern Vector4         :: r -> r -> r -> r -> Vector 4 r
pattern $bVector4 :: r -> r -> r -> r -> Vector 4 r
$mVector4 :: forall r r.
Vector 4 r -> (r -> r -> r -> r -> r) -> (Void# -> r) -> r
Vector4 x y z a <- (V.toList -> [x,y,z,a])
  where
    Vector4 r
x r
y r
z r
a = r -> r -> r -> r -> Vector 4 r
forall (v :: * -> *) a.
(Vector v a, Dim v ~ 4) =>
a -> a -> a -> a -> v a
V.mk4 r
x r
y r
z r
a
{-# COMPLETE Vector4 #-}