{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Vector.VectorFamily
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Implementation of \(d\)-dimensional vectors. The implementation
-- automatically selects an optimized representation for small (up to size 4)
-- vectors.
--
--------------------------------------------------------------------------------
module Data.Geometry.Vector.VectorFamily where

import           Control.DeepSeq
import           Control.Lens                           hiding (element)
import           Control.Monad
import           Data.Aeson
import qualified Data.Foldable                          as F
import           Data.Functor.Classes
import           Data.Geometry.Vector.VectorFamilyPeano (ImplicitArity, VectorFamily (..),
                                                         VectorFamilyF)
import qualified Data.Geometry.Vector.VectorFamilyPeano as Fam
import           Data.Geometry.Vector.VectorFixed       (C (..))
import           Data.Hashable
import           Data.List
import qualified Data.List                              as L
import           Data.Proxy
import qualified Data.Vector.Fixed                      as V
import           Data.Vector.Fixed.Cont                 (Peano)
import           GHC.TypeLits
import           Linear.Affine                          (Affine (..))
import           Linear.Metric
import qualified Linear.V2                              as L2
import qualified Linear.V3                              as L3
import qualified Linear.V4                              as L4
import           Linear.Vector
import           Text.Read                              (Read (..), readListPrecDefault)

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


-- | Datatype representing d dimensional vectors. The default implementation is
-- based n VectorFixed. However, for small vectors we automatically select a
-- more efficient representation.
newtype Vector (d :: Nat) (r :: *) = MKVector { Vector d r -> VectorFamily (Peano d) r
_unV :: VectorFamily (Peano d) r }

type instance V.Dim   (Vector d)   = Fam.FromPeano (Peano d)
-- the above definition is a bit convoluted, but it allows us to make Vector an instance of
-- V.Vector having only an Arity constraint rather than an Arity2 constraint.
type instance Index   (Vector d r) = Int
type instance IxValue (Vector d r) = r

-- | Vectors are isomorphic to a definition determined by 'VectorFamily'.
unV :: Iso (Vector d r) (Vector d s) (VectorFamily (Peano d) r) (VectorFamily (Peano d) s)
unV :: p (VectorFamily (Peano d) r) (f (VectorFamily (Peano d) s))
-> p (Vector d r) (f (Vector d s))
unV = (Vector d r -> VectorFamily (Peano d) r)
-> (VectorFamily (Peano d) s -> Vector d s)
-> Iso
     (Vector d r)
     (Vector d s)
     (VectorFamily (Peano d) r)
     (VectorFamily (Peano d) s)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Vector d r -> VectorFamily (Peano d) r
forall (d :: Nat) r. Vector d r -> VectorFamily (Peano d) r
_unV VectorFamily (Peano d) s -> Vector d s
forall (d :: Nat) r. VectorFamily (Peano d) r -> Vector d r
MKVector
{-# INLINE unV #-}

-- type Arity d = (ImplicitArity (Peano d), KnownNat d)
class (ImplicitArity (Peano d), KnownNat d) => Arity d
instance (ImplicitArity (Peano d), KnownNat d) => Arity d


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

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



instance Arity d => FunctorWithIndex     Int (Vector d) where
  imap :: (Int -> a -> b) -> Vector d a -> Vector d b
imap = (Int -> a -> b) -> Vector d a -> Vector d b
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(Int -> a -> b) -> v a -> v b
V.imap
instance Arity d => FoldableWithIndex    Int (Vector d)
instance Arity d => TraversableWithIndex Int (Vector d) where
  itraverse :: (Int -> a -> f b) -> Vector d a -> f (Vector d b)
itraverse = (Int -> a -> f b) -> Vector d a -> f (Vector d b)
forall (v :: * -> *) a b (f :: * -> *).
(Vector v a, Vector v b, Applicative f) =>
(Int -> a -> f b) -> v a -> f (v b)
V.imapM


deriving instance Arity d => Additive (Vector d)
deriving instance Arity d => Metric (Vector d)
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

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

instance Arity d => Ixed (Vector d r) where
  ix :: Index (Vector d r)
-> Traversal' (Vector d r) (IxValue (Vector d r))
ix = Index (Vector d r)
-> (IxValue (Vector d r) -> f (IxValue (Vector d r)))
-> Vector d r
-> f (Vector d r)
forall (d :: Nat) r. Arity d => Int -> Traversal' (Vector d r) r
element'

instance Arity d => V.Vector (Vector d) r where
  construct :: Fun (Peano (Dim (Vector d))) r (Vector d r)
construct  = VectorFamily (Peano d) r -> Vector d r
forall (d :: Nat) r. VectorFamily (Peano d) r -> Vector d r
MKVector (VectorFamily (Peano d) r -> Vector d r)
-> Fun (Peano (FromPeano (Peano d))) r (VectorFamily (Peano d) r)
-> Fun (Peano (FromPeano (Peano d))) r (Vector d r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun (Peano (FromPeano (Peano d))) r (VectorFamily (Peano 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    = VectorFamily (Peano d) r
-> Fun (Peano (FromPeano (Peano d))) r b -> b
forall (v :: * -> *) a b.
Vector v a =>
v a -> Fun (Peano (Dim v)) a b -> b
V.inspect (VectorFamily (Peano d) r
 -> Fun (Peano (FromPeano (Peano d))) r b -> b)
-> (Vector d r -> VectorFamily (Peano d) r)
-> Vector d r
-> Fun (Peano (FromPeano (Peano d))) r b
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d r -> VectorFamily (Peano d) r
forall (d :: Nat) r. Vector d r -> VectorFamily (Peano d) r
_unV
  basicIndex :: Vector d r -> Int -> r
basicIndex = VectorFamily (Peano d) r -> Int -> r
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
V.basicIndex (VectorFamily (Peano d) r -> Int -> r)
-> (Vector d r -> VectorFamily (Peano d) r)
-> Vector d r
-> Int
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d r -> VectorFamily (Peano d) r
forall (d :: Nat) r. Vector d r -> VectorFamily (Peano d) r
_unV

-- instance (Arity d, Show r) => Show (Vector d r) where
--   show v = mconcat [ "Vector", show $ F.length v , " "
--                    , show $ F.toList v ]

-- instance (Read r, Arity d) => Read (Vector d r) where
--   readPrec     = lift readVec
--     where
--       readVec :: (Arity d, Read r) => ReadP (Vector d r)
--       readVec = do let d = natVal (Proxy :: Proxy d)
--                    _  <- string $ "Vector" <> show d <> " "
--                    rs <- readPrec_to_P readPrec minPrec
--                    case vectorFromList rs of
--                     Just v -> pure v
--                     _      -> pfail
--   readListPrec = readListPrecDefault

instance (Show r, Arity d) => Show (Vector d r) where
  showsPrec :: Int -> Vector d r -> ShowS
showsPrec = (Int -> r -> ShowS) -> ([r] -> ShowS) -> Int -> Vector d r -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> r -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [r] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance (Arity d) => Show1 (Vector d) where
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Vector d a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d Vector d a
v = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
constr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [ShowS] -> ShowS
unwordsS ((a -> ShowS) -> [a] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> a -> ShowS
sp Int
11) (Vector d a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector d a
v))
    where
      constr :: String
constr = String
"Vector" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy d -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal @d Proxy d
forall k (t :: k). Proxy t
Proxy))
      unwordsS :: [ShowS] -> ShowS
unwordsS = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id ([ShowS] -> ShowS) -> ([ShowS] -> [ShowS]) -> [ShowS] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (Char -> ShowS
showChar Char
' ')

instance (Read r, Arity d) => Read (Vector d r) where
  readPrec :: ReadPrec (Vector d r)
readPrec     = ReadPrec r -> ReadPrec [r] -> ReadPrec (Vector d r)
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec r
forall a. Read a => ReadPrec a
readPrec ReadPrec [r]
forall a. Read a => ReadPrec [a]
readListPrec
  readListPrec :: ReadPrec [Vector d r]
readListPrec = ReadPrec [Vector d r]
forall a. Read a => ReadPrec [a]
readListPrecDefault

instance (Arity d) => Read1 (Vector d) where
  liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Vector d a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
_rl = ReadPrec (Vector d a) -> ReadPrec (Vector d a)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (Vector d a) -> ReadPrec (Vector d a))
-> ReadPrec (Vector d a) -> ReadPrec (Vector d a)
forall a b. (a -> b) -> a -> b
$
      ReadPrec [a]
-> String -> ([a] -> Vector d a) -> ReadPrec (Vector d a)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith (Int -> ReadPrec a -> ReadPrec [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
d ReadPrec a
rp) String
constr (([a] -> Vector d a) -> ReadPrec (Vector d a))
-> ([a] -> Vector d a) -> ReadPrec (Vector d a)
forall a b. (a -> b) -> a -> b
$ \[a]
rs ->
        case [a] -> Maybe (Vector d a)
forall (d :: Nat) r. Arity d => [r] -> Maybe (Vector d r)
vectorFromList [a]
rs of
          Just Vector d a
p -> Vector d a
p
          Maybe (Vector d a)
_      -> String -> Vector d a
forall a. HasCallStack => String -> a
error String
"internal error in Data.Geometry.Vector read instance."
    where
      d :: Int
d = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (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))
      constr :: String
constr = String
"Vector" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
d
  liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [Vector d a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Vector d a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault



deriving instance (FromJSON r, Arity d) => FromJSON (Vector d r)
instance (ToJSON r, Arity d) => ToJSON (Vector d r) where
  toJSON :: Vector d r -> Value
toJSON     = VectorFamily (Peano d) r -> Value
forall a. ToJSON a => a -> Value
toJSON (VectorFamily (Peano d) r -> Value)
-> (Vector d r -> VectorFamily (Peano d) r) -> Vector d r -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d r -> VectorFamily (Peano d) r
forall (d :: Nat) r. Vector d r -> VectorFamily (Peano d) r
_unV
  toEncoding :: Vector d r -> Encoding
toEncoding = VectorFamily (Peano d) r -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (VectorFamily (Peano d) r -> Encoding)
-> (Vector d r -> VectorFamily (Peano d) r)
-> Vector d r
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d r -> VectorFamily (Peano d) r
forall (d :: Nat) r. Vector d r -> VectorFamily (Peano d) r
_unV

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

--------------------------------------------------------------------------------
-- * Convenience "constructors"

-- | Constant sized vector with d elements.
pattern Vector   :: VectorFamilyF (Peano d) r -> Vector d r
pattern $bVector :: VectorFamilyF (Peano d) r -> Vector d r
$mVector :: forall r (d :: Nat) r.
Vector d r -> (VectorFamilyF (Peano d) r -> r) -> (Void# -> r) -> r
Vector v = MKVector (VectorFamily v)
{-# COMPLETE Vector #-}

-- | Constant sized vector with 1 element.
pattern Vector1   :: r -> Vector 1 r
pattern $bVector1 :: r -> Vector 1 r
$mVector1 :: forall r r. Vector 1 r -> (r -> r) -> (Void# -> r) -> r
Vector1 x = (Vector (Identity x))
{-# COMPLETE Vector1 #-}

-- | Constant sized vector with 2 elements.
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 = (Vector (L2.V2 x y))
{-# COMPLETE Vector2 #-}

-- | Constant sized vector with 3 elements.
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  = (Vector (L3.V3 x y z))
{-# COMPLETE Vector3 #-}

-- | Constant sized vector with 4 elements.
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 w = (Vector (L4.V4 x y z w))
{-# COMPLETE Vector4 #-}

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

-- | \( O(n) \) Convert from a list to a non-empty vector.
vectorFromList :: Arity d => [r] -> Maybe (Vector d r)
vectorFromList :: [r] -> Maybe (Vector d r)
vectorFromList = [r] -> Maybe (Vector d r)
forall (v :: * -> *) a. Vector v a => [a] -> Maybe (v a)
V.fromListM

-- | \( O(n) \) Convert from a list to a non-empty vector.
vectorFromListUnsafe :: Arity d => [r] -> Vector d r
vectorFromListUnsafe :: [r] -> Vector d r
vectorFromListUnsafe = [r] -> Vector d r
forall (v :: * -> *) a. Vector v a => [a] -> v a
V.fromList

-- | \( O(n) \) Pop the first element off a vector.
destruct   :: (Arity d, Arity (d + 1))
           => Vector (d + 1) r -> (r, Vector d r)
destruct :: Vector (d + 1) r -> (r, Vector d r)
destruct Vector (d + 1) r
v = ([r] -> r
forall a. [a] -> a
L.head ([r] -> r) -> [r] -> r
forall a b. (a -> b) -> a -> b
$ Vector (d + 1) r -> [r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector (d + 1) r
v, [r] -> Vector d r
forall (d :: Nat) r. Arity d => [r] -> Vector d r
vectorFromListUnsafe ([r] -> Vector d r) -> ([r] -> [r]) -> [r] -> Vector d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> [r]
forall a. [a] -> [a]
tail ([r] -> Vector d r) -> [r] -> Vector d r
forall a b. (a -> b) -> a -> b
$ Vector (d + 1) r -> [r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector (d + 1) r
v)
  -- FIXME: this implementaion of tail is not particularly nice

-- | \( O(1) \) First element. Since arity is at least 1, this function is total.
head   :: (Arity d, 1 <= d) => Vector d r -> r
head :: Vector d r -> r
head = Getting r (Vector d r) r -> Vector d r -> r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting r (Vector d r) r -> Vector d r -> r)
-> Getting r (Vector d r) r -> Vector d r -> r
forall a b. (a -> b) -> a -> b
$ C 0 -> Lens' (Vector d r) r
forall (proxy :: Nat -> *) (i :: Nat) (d :: Nat) r.
(Arity d, KnownNat i, (i + 1) <= d) =>
proxy i -> Lens' (Vector d r) r
element (C 0
forall (n :: Nat). C n
C :: C 0)

--------------------------------------------------------------------------------
-- * Indexing vectors

-- | Lens into the i th element
element   :: forall proxy i d r. (Arity d, KnownNat i, (i + 1) <= d)
          => proxy i -> Lens' (Vector d r) r
element :: proxy i -> Lens' (Vector d r) r
element proxy i
_ = Traversing (->) f (Vector d r) (Vector d r) r r
-> Over (->) f (Vector d r) (Vector d r) 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 (->) f (Vector d r) (Vector d r) r r
 -> Over (->) f (Vector d r) (Vector d r) r r)
-> (Integer -> Traversing (->) f (Vector d r) (Vector d r) r r)
-> Integer
-> Over (->) f (Vector d r) (Vector d r) r r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Traversing (->) f (Vector d r) (Vector d r) r r
forall (d :: Nat) r. Arity d => Int -> Traversal' (Vector d r) r
element' (Int -> Traversing (->) f (Vector d r) (Vector d r) r r)
-> (Integer -> Int)
-> Integer
-> Traversing (->) f (Vector d r) (Vector d r) r r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Over (->) f (Vector d r) (Vector d r) r r)
-> Integer -> Over (->) f (Vector d r) (Vector d r) r r
forall a b. (a -> b) -> a -> b
$ C i -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (C i
forall (n :: Nat). C n
C :: C i)
{-# INLINE element #-}


-- | 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 = (VectorFamily (Peano d) r -> f (VectorFamily (Peano d) r))
-> Vector d r -> f (Vector d r)
forall (d :: Nat) r s.
Iso
  (Vector d r)
  (Vector d s)
  (VectorFamily (Peano d) r)
  (VectorFamily (Peano d) s)
unV((VectorFamily (Peano d) r -> f (VectorFamily (Peano d) r))
 -> Vector d r -> f (Vector d r))
-> ((r -> f r)
    -> VectorFamily (Peano d) r -> f (VectorFamily (Peano d) r))
-> (r -> f r)
-> Vector d r
-> f (Vector d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.C d -> Int -> Traversal' (VectorFamily (Peano d) r) r
forall (proxy :: Nat -> *).
Arity d =>
proxy d -> Int -> Traversal' (VectorFamily (Peano d) r) r
e (C d
forall (n :: Nat). C n
C :: C d) Int
i
  where
    e  :: Arity d => proxy d -> Int -> Traversal' (VectorFamily (Peano d) r) r
    e :: proxy d -> Int -> Traversal' (VectorFamily (Peano d) r) r
e proxy d
_ = Int
-> (r -> f r)
-> VectorFamily (Peano d) r
-> f (VectorFamily (Peano d) r)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix
{-# INLINE element' #-}

--------------------------------------------------------------------------------
-- * Snoccing and consindg

-- | \( O(n) \) Prepend an element.
cons   :: (Arity d, Arity (d+1)) => r -> Vector d r -> Vector (d + 1) r
cons :: r -> Vector d r -> Vector (d + 1) r
cons r
x = [r] -> Vector (d + 1) r
forall (d :: Nat) r. Arity d => [r] -> Vector d r
vectorFromListUnsafe ([r] -> Vector (d + 1) r)
-> (Vector d r -> [r]) -> Vector d r -> Vector (d + 1) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r
xr -> [r] -> [r]
forall a. a -> [a] -> [a]
:) ([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 (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

-- | 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 Vector d r
v r
x = [r] -> Vector (d + 1) r
forall (d :: Nat) r. Arity d => [r] -> Vector d r
vectorFromListUnsafe ([r] -> Vector (d + 1) r)
-> ([r] -> [r]) -> [r] -> Vector (d + 1) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([r] -> [r] -> [r]
forall a. [a] -> [a] -> [a]
++ [r
x]) ([r] -> Vector (d + 1) r) -> [r] -> Vector (d + 1) r
forall a b. (a -> b) -> a -> b
$ Vector d r -> [r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector d r
v
  -- FIXME: horrible implementation here as well

-- | 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 = [r] -> Vector d r
forall (d :: Nat) r. Arity d => [r] -> Vector d r
vectorFromListUnsafe ([r] -> Vector d r)
-> (Vector (d + 1) r -> [r]) -> Vector (d + 1) r -> Vector d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> [r]
forall a. [a] -> [a]
L.init ([r] -> [r])
-> (Vector (d + 1) r -> [r]) -> Vector (d + 1) r -> [r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (d + 1) r -> [r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

-- | \( O(1) \) Last element. Since the vector is non-empty, runtime bounds checks are bypassed.
last :: forall d r. (KnownNat 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
$ C d -> Lens' (Vector (d + 1) r) r
forall (proxy :: Nat -> *) (i :: Nat) (d :: Nat) r.
(Arity d, KnownNat i, (i + 1) <= d) =>
proxy i -> Lens' (Vector d r) r
element (C d
forall (n :: Nat). C n
C :: C 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) -> (C i -> Integer) -> C i -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C i -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (C i -> Int) -> C i -> Int
forall a b. (a -> b) -> a -> b
$ (C i
forall (n :: Nat). C n
C :: C i)
         in [r] -> Vector i r
forall (d :: Nat) r. Arity d => [r] -> Vector d r
vectorFromListUnsafe ([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 (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

--------------------------------------------------------------------------------
-- * Specific on 3-dimensional vectors
-- | Cross product of two three-dimensional vectors
cross       :: Num r => Vector 3 r -> Vector 3 r -> Vector 3 r
(Vector VectorFamilyF (Peano 3) r
u) cross :: Vector 3 r -> Vector 3 r -> Vector 3 r
`cross` (Vector VectorFamilyF (Peano 3) r
v) = VectorFamilyF (Peano 3) r -> Vector 3 r
forall (d :: Nat) r. VectorFamilyF (Peano d) r -> Vector d r
Vector (VectorFamilyF (Peano 3) r -> Vector 3 r)
-> VectorFamilyF (Peano 3) r -> Vector 3 r
forall a b. (a -> b) -> a -> b
$ V3 r
VectorFamilyF (Peano 3) r
u V3 r -> V3 r -> V3 r
forall a. Num a => V3 a -> V3 a -> V3 a
`L3.cross` V3 r
VectorFamilyF (Peano 3) r
v