{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Vector.VectorFamilyPeano
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.Geometry.Vector.VectorFamilyPeano
  ( ImplicitArity
  , VectorFamily(VectorFamily)
  , VectorFamilyF
  , FromPeano
  , Two
  ) where

import           Control.Applicative (liftA2)
import           Control.DeepSeq
import           Control.Lens hiding (element)
import           Data.Aeson (FromJSON(..),ToJSON(..))
-- import           Data.Aeson (ToJSON(..),FromJSON(..))
import qualified Data.Foldable as F
import qualified Data.Geometry.Vector.VectorFixed as FV
import           Data.Proxy
import           Data.Functor.Classes
import qualified Data.Vector.Fixed as V
import           Data.Vector.Fixed.Cont (PeanoNum(..), Fun(..))
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           Data.Hashable

--------------------------------------------------------------------------------
-- * Natural number stuff

type One = S Z
type Two = S One
type Three = S Two
type Four = S Three
type Many d = S (S (S (S (S d))))


type family FromPeano (d :: PeanoNum) :: Nat where
  FromPeano Z     = 0
  FromPeano (S d) = 1 + FromPeano d


data SingPeano (d :: PeanoNum) where
  SZ :: SingPeano Z
  SS :: !(SingPeano d) -> SingPeano (S d)

class ImplicitPeano (d :: PeanoNum) where
  implicitPeano :: SingPeano d
instance ImplicitPeano Z where
  implicitPeano :: SingPeano 'Z
implicitPeano = SingPeano 'Z
SZ
instance ImplicitPeano d => ImplicitPeano (S d) where
  implicitPeano :: SingPeano ('S d)
implicitPeano = SingPeano d -> SingPeano ('S d)
forall (d :: PeanoNum). SingPeano d -> SingPeano ('S d)
SS SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano

--------------------------------------------------------------------------------
-- * 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 VectorFamily (d :: PeanoNum) (r :: *) =
  VectorFamily { VectorFamily d r -> VectorFamilyF d r
_unVF :: VectorFamilyF d r }

-- | Mapping between the implementation type, and the actual implementation.
type family VectorFamilyF (d :: PeanoNum) :: * -> * where
  VectorFamilyF Z        = Const ()
  VectorFamilyF One      = Identity
  VectorFamilyF Two      = L2.V2
  VectorFamilyF Three    = L3.V3
  VectorFamilyF Four     = L4.V4
  VectorFamilyF (Many d) = FV.Vector (FromPeano (Many d))

type instance V.Dim (VectorFamily d)  = FromPeano d
type instance Index   (VectorFamily d r) = Int
type instance IxValue (VectorFamily d r) = r

type instance V.Dim L2.V2 = 2
type instance V.Dim L3.V3 = 3
type instance V.Dim L4.V4 = 4

unVF :: Lens (VectorFamily  d r) (VectorFamily d t)
             (VectorFamilyF d r) (VectorFamilyF d t)
unVF :: (VectorFamilyF d r -> f (VectorFamilyF d t))
-> VectorFamily d r -> f (VectorFamily d t)
unVF = (VectorFamily d r -> VectorFamilyF d r)
-> (VectorFamily d r -> VectorFamilyF d t -> VectorFamily d t)
-> Lens
     (VectorFamily d r)
     (VectorFamily d t)
     (VectorFamilyF d r)
     (VectorFamilyF d t)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens VectorFamily d r -> VectorFamilyF d r
forall (d :: PeanoNum) r. VectorFamily d r -> VectorFamilyF d r
_unVF ((VectorFamilyF d t -> VectorFamily d t)
-> VectorFamily d r -> VectorFamilyF d t -> VectorFamily d t
forall a b. a -> b -> a
const VectorFamilyF d t -> VectorFamily d t
forall (d :: PeanoNum) r. VectorFamilyF d r -> VectorFamily d r
VectorFamily)
{-# INLINE unVF #-}

-- type ImplicitArity d = (ImplicitPeano d, V.Arity (FromPeano d))
class (ImplicitPeano d, V.Arity (FromPeano d)) => ImplicitArity d
instance (ImplicitPeano d, V.Arity (FromPeano d)) => ImplicitArity d

instance (Eq r, ImplicitArity d) => Eq (VectorFamily d r) where
  (VectorFamily VectorFamilyF d r
u) == :: VectorFamily d r -> VectorFamily d r -> Bool
== (VectorFamily VectorFamilyF d r
v) = case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
        SingPeano d
SZ                         -> Const () r
VectorFamilyF d r
u Const () r -> Const () r -> Bool
forall a. Eq a => a -> a -> Bool
== Const () r
VectorFamilyF d r
v
        (SS SingPeano d
SZ)                    -> Identity r
VectorFamilyF d r
u Identity r -> Identity r -> Bool
forall a. Eq a => a -> a -> Bool
== Identity r
VectorFamilyF d r
v
        (SS (SS SingPeano d
SZ))               -> V2 r
VectorFamilyF d r
u V2 r -> V2 r -> Bool
forall a. Eq a => a -> a -> Bool
== V2 r
VectorFamilyF d r
v
        (SS (SS (SS SingPeano d
SZ)))          -> V3 r
VectorFamilyF d r
u V3 r -> V3 r -> Bool
forall a. Eq a => a -> a -> Bool
== V3 r
VectorFamilyF d r
v
        (SS (SS (SS (SS SingPeano d
SZ))))     -> V4 r
VectorFamilyF d r
u V4 r -> V4 r -> Bool
forall a. Eq a => a -> a -> Bool
== V4 r
VectorFamilyF d r
v
        (SS (SS (SS (SS (SS SingPeano d
_))))) -> Vector (FromPeano d) r
VectorFamilyF d r
u Vector (FromPeano d) r -> Vector (FromPeano d) r -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (FromPeano d) r
VectorFamilyF d r
v
  {-# INLINE (==) #-}

instance (ImplicitArity d) => Eq1 (VectorFamily d) where
  liftEq :: (a -> b -> Bool) -> VectorFamily d a -> VectorFamily d b -> Bool
liftEq a -> b -> Bool
eq (VectorFamily VectorFamilyF d a
u) (VectorFamily VectorFamilyF d b
v) = case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
        SingPeano d
SZ                         -> (a -> b -> Bool) -> Const () a -> Const () b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq Const () a
VectorFamilyF d a
u Const () b
VectorFamilyF d b
v
        (SS SingPeano d
SZ)                    -> (a -> b -> Bool) -> Identity a -> Identity b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq Identity a
VectorFamilyF d a
u Identity b
VectorFamilyF d b
v
        (SS (SS SingPeano d
SZ))               -> (a -> b -> Bool) -> V2 a -> V2 b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq V2 a
VectorFamilyF d a
u V2 b
VectorFamilyF d b
v
        (SS (SS (SS SingPeano d
SZ)))          -> (a -> b -> Bool) -> V3 a -> V3 b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq V3 a
VectorFamilyF d a
u V3 b
VectorFamilyF d b
v
        (SS (SS (SS (SS SingPeano d
SZ))))     -> (a -> b -> Bool) -> V4 a -> V4 b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq V4 a
VectorFamilyF d a
u V4 b
VectorFamilyF d b
v
        (SS (SS (SS (SS (SS SingPeano d
_))))) -> (a -> b -> Bool)
-> Vector (FromPeano d) a -> Vector (FromPeano d) b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq Vector (FromPeano d) a
VectorFamilyF d a
u Vector (FromPeano d) b
VectorFamilyF d b
v

instance (Ord r, ImplicitArity d) => Ord (VectorFamily d r) where
  (VectorFamily VectorFamilyF d r
u) compare :: VectorFamily d r -> VectorFamily d r -> Ordering
`compare` (VectorFamily VectorFamilyF d r
v) = case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
        SingPeano d
SZ                         -> Const () r
VectorFamilyF d r
u Const () r -> Const () r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Const () r
VectorFamilyF d r
v
        (SS SingPeano d
SZ)                    -> Identity r
VectorFamilyF d r
u Identity r -> Identity r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Identity r
VectorFamilyF d r
v
        (SS (SS SingPeano d
SZ))               -> V2 r
VectorFamilyF d r
u V2 r -> V2 r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` V2 r
VectorFamilyF d r
v
        (SS (SS (SS SingPeano d
SZ)))          -> V3 r
VectorFamilyF d r
u V3 r -> V3 r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` V3 r
VectorFamilyF d r
v
        (SS (SS (SS (SS SingPeano d
SZ))))     -> V4 r
VectorFamilyF d r
u V4 r -> V4 r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` V4 r
VectorFamilyF d r
v
        (SS (SS (SS (SS (SS SingPeano d
_))))) -> Vector (FromPeano d) r
VectorFamilyF d r
u Vector (FromPeano d) r -> Vector (FromPeano d) r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Vector (FromPeano d) r
VectorFamilyF d r
v
  {-# INLINE compare #-}


instance ImplicitArity d => Functor (VectorFamily d) where
  fmap :: (a -> b) -> VectorFamily d a -> VectorFamily d b
fmap a -> b
f = VectorFamilyF d b -> VectorFamily d b
forall (d :: PeanoNum) r. VectorFamilyF d r -> VectorFamily d r
VectorFamily (VectorFamilyF d b -> VectorFamily d b)
-> (VectorFamily d a -> VectorFamilyF d b)
-> VectorFamily d a
-> VectorFamily d b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> VectorFamilyF d a -> VectorFamilyF d b
g a -> b
f (VectorFamilyF d a -> VectorFamilyF d b)
-> (VectorFamily d a -> VectorFamilyF d a)
-> VectorFamily d a
-> VectorFamilyF d b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VectorFamily d a -> VectorFamilyF d a
forall (d :: PeanoNum) r. VectorFamily d r -> VectorFamilyF d r
_unVF
    where g :: (a -> b) -> VectorFamilyF d a -> VectorFamilyF d b
g = case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
                SingPeano d
SZ                         -> (a -> b) -> VectorFamilyF d a -> VectorFamilyF d b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (SS SingPeano d
SZ)                    -> (a -> b) -> VectorFamilyF d a -> VectorFamilyF d b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (SS (SS SingPeano d
SZ))               -> (a -> b) -> VectorFamilyF d a -> VectorFamilyF d b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (SS (SS (SS SingPeano d
SZ)))          -> (a -> b) -> VectorFamilyF d a -> VectorFamilyF d b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (SS (SS (SS (SS SingPeano d
SZ))))     -> (a -> b) -> VectorFamilyF d a -> VectorFamilyF d b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (SS (SS (SS (SS (SS SingPeano d
_))))) -> (a -> b) -> VectorFamilyF d a -> VectorFamilyF d b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  {-# INLINE fmap #-}


instance ImplicitArity d => Foldable (VectorFamily d) where
  foldMap :: (a -> m) -> VectorFamily d a -> m
foldMap a -> m
f = (a -> m) -> VectorFamilyF d a -> m
g a -> m
f (VectorFamilyF d a -> m)
-> (VectorFamily d a -> VectorFamilyF d a) -> VectorFamily d a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VectorFamily d a -> VectorFamilyF d a
forall (d :: PeanoNum) r. VectorFamily d r -> VectorFamilyF d r
_unVF
    where g :: (a -> m) -> VectorFamilyF d a -> m
g = case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
                SingPeano d
SZ                         -> (a -> m) -> VectorFamilyF d a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                (SS SingPeano d
SZ)                    -> (a -> m) -> VectorFamilyF d a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                (SS (SS SingPeano d
SZ))               -> (a -> m) -> VectorFamilyF d a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                (SS (SS (SS SingPeano d
SZ)))          -> (a -> m) -> VectorFamilyF d a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                (SS (SS (SS (SS SingPeano d
SZ))))     -> (a -> m) -> VectorFamilyF d a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                (SS (SS (SS (SS (SS SingPeano d
_))))) -> (a -> m) -> VectorFamilyF d a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
  {-# INLINE foldMap #-}

instance ImplicitArity d => Traversable (VectorFamily d) where
  traverse :: (a -> f b) -> VectorFamily d a -> f (VectorFamily d b)
traverse a -> f b
f = (VectorFamilyF d b -> VectorFamily d b)
-> f (VectorFamilyF d b) -> f (VectorFamily d b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VectorFamilyF d b -> VectorFamily d b
forall (d :: PeanoNum) r. VectorFamilyF d r -> VectorFamily d r
VectorFamily (f (VectorFamilyF d b) -> f (VectorFamily d b))
-> (VectorFamily d a -> f (VectorFamilyF d b))
-> VectorFamily d a
-> f (VectorFamily d b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> VectorFamilyF d a -> f (VectorFamilyF d b)
g a -> f b
f (VectorFamilyF d a -> f (VectorFamilyF d b))
-> (VectorFamily d a -> VectorFamilyF d a)
-> VectorFamily d a
-> f (VectorFamilyF d b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VectorFamily d a -> VectorFamilyF d a
forall (d :: PeanoNum) r. VectorFamily d r -> VectorFamilyF d r
_unVF
    where g :: (a -> f b) -> VectorFamilyF d a -> f (VectorFamilyF d b)
g = case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
                SingPeano d
SZ                         -> (a -> f b) -> VectorFamilyF d a -> f (VectorFamilyF d b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                (SS SingPeano d
SZ)                    -> (a -> f b) -> VectorFamilyF d a -> f (VectorFamilyF d b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                (SS (SS SingPeano d
SZ))               -> (a -> f b) -> VectorFamilyF d a -> f (VectorFamilyF d b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                (SS (SS (SS SingPeano d
SZ)))          -> (a -> f b) -> VectorFamilyF d a -> f (VectorFamilyF d b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                (SS (SS (SS (SS SingPeano d
SZ))))     -> (a -> f b) -> VectorFamilyF d a -> f (VectorFamilyF d b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                (SS (SS (SS (SS (SS SingPeano d
_))))) -> (a -> f b) -> VectorFamilyF d a -> f (VectorFamilyF d b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
  {-# INLINE traverse #-}

instance ImplicitArity d => Applicative (VectorFamily d) where
  pure :: a -> VectorFamily d a
pure = VectorFamilyF d a -> VectorFamily d a
forall (d :: PeanoNum) r. VectorFamilyF d r -> VectorFamily d r
VectorFamily (VectorFamilyF d a -> VectorFamily d a)
-> (a -> VectorFamilyF d a) -> a -> VectorFamily d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
                SingPeano d
SZ                         -> a -> VectorFamilyF d a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                (SS SingPeano d
SZ)                    -> a -> VectorFamilyF d a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                (SS (SS SingPeano d
SZ))               -> a -> VectorFamilyF d a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                (SS (SS (SS SingPeano d
SZ)))          -> a -> VectorFamilyF d a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                (SS (SS (SS (SS SingPeano d
SZ))))     -> a -> VectorFamilyF d a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                (SS (SS (SS (SS (SS SingPeano d
_))))) -> a -> VectorFamilyF d a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE pure #-}
  liftA2 :: (a -> b -> c)
-> VectorFamily d a -> VectorFamily d b -> VectorFamily d c
liftA2 a -> b -> c
f (VectorFamily VectorFamilyF d a
u) (VectorFamily VectorFamilyF d b
v) = VectorFamilyF d c -> VectorFamily d c
forall (d :: PeanoNum) r. VectorFamilyF d r -> VectorFamily d r
VectorFamily (VectorFamilyF d c -> VectorFamily d c)
-> VectorFamilyF d c -> VectorFamily d c
forall a b. (a -> b) -> a -> b
$
      case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
                SingPeano d
SZ                         -> (a -> b -> c) -> Const () a -> Const () b -> Const () c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Const () a
VectorFamilyF d a
u Const () b
VectorFamilyF d b
v
                (SS SingPeano d
SZ)                    -> (a -> b -> c) -> Identity a -> Identity b -> Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Identity a
VectorFamilyF d a
u Identity b
VectorFamilyF d b
v
                (SS (SS SingPeano d
SZ))               -> (a -> b -> c) -> V2 a -> V2 b -> V2 c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f V2 a
VectorFamilyF d a
u V2 b
VectorFamilyF d b
v
                (SS (SS (SS SingPeano d
SZ)))          -> (a -> b -> c) -> V3 a -> V3 b -> V3 c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f V3 a
VectorFamilyF d a
u V3 b
VectorFamilyF d b
v
                (SS (SS (SS (SS SingPeano d
SZ))))     -> (a -> b -> c) -> V4 a -> V4 b -> V4 c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f V4 a
VectorFamilyF d a
u V4 b
VectorFamilyF d b
v
                (SS (SS (SS (SS (SS SingPeano d
_))))) -> (a -> b -> c)
-> Vector (FromPeano d) a
-> Vector (FromPeano d) b
-> Vector (FromPeano d) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Vector (FromPeano d) a
VectorFamilyF d a
u Vector (FromPeano d) b
VectorFamilyF d b
v
  {-# INLINE liftA2 #-}


instance ImplicitArity d => V.Vector (VectorFamily d) r where
  construct :: Fun (Peano (Dim (VectorFamily d))) r (VectorFamily d r)
construct = (VectorFamilyF d r -> VectorFamily d r)
-> Fun (Peano (FromPeano d)) r (VectorFamilyF d r)
-> Fun (Peano (FromPeano d)) r (VectorFamily d r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VectorFamilyF d r -> VectorFamily d r
forall (d :: PeanoNum) r. VectorFamilyF d r -> VectorFamily d r
VectorFamily (Fun (Peano (FromPeano d)) r (VectorFamilyF d r)
 -> Fun (Peano (FromPeano d)) r (VectorFamily d r))
-> Fun (Peano (FromPeano d)) r (VectorFamilyF d r)
-> Fun (Peano (FromPeano d)) r (VectorFamily d r)
forall a b. (a -> b) -> a -> b
$ case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
                SingPeano d
SZ                         -> Fn 'Z r (VectorFamilyF d r) -> Fun 'Z r (VectorFamilyF d r)
forall (n :: PeanoNum) a b. Fn n a b -> Fun n a b
Fun (Fn 'Z r (VectorFamilyF d r) -> Fun 'Z r (VectorFamilyF d r))
-> Fn 'Z r (VectorFamilyF d r) -> Fun 'Z r (VectorFamilyF d r)
forall a b. (a -> b) -> a -> b
$ () -> Const () r
forall k a (b :: k). a -> Const a b
Const ()
                (SS SingPeano d
SZ)                    -> Fun (Peano (FromPeano d)) r (VectorFamilyF d r)
forall (v :: * -> *) a. Vector v a => Fun (Peano (Dim v)) a (v a)
V.construct
                (SS (SS SingPeano d
SZ))               -> Fn ('S ('S 'Z)) r (VectorFamilyF d r)
-> Fun ('S ('S 'Z)) r (VectorFamilyF d r)
forall (n :: PeanoNum) a b. Fn n a b -> Fun n a b
Fun Fn ('S ('S 'Z)) r (VectorFamilyF d r)
forall a. a -> a -> V2 a
L2.V2
                (SS (SS (SS SingPeano d
SZ)))          -> Fn ('S ('S ('S 'Z))) r (VectorFamilyF d r)
-> Fun ('S ('S ('S 'Z))) r (VectorFamilyF d r)
forall (n :: PeanoNum) a b. Fn n a b -> Fun n a b
Fun Fn ('S ('S ('S 'Z))) r (VectorFamilyF d r)
forall a. a -> a -> a -> V3 a
L3.V3
                (SS (SS (SS (SS SingPeano d
SZ))))     -> Fn ('S ('S ('S ('S 'Z)))) r (VectorFamilyF d r)
-> Fun ('S ('S ('S ('S 'Z)))) r (VectorFamilyF d r)
forall (n :: PeanoNum) a b. Fn n a b -> Fun n a b
Fun Fn ('S ('S ('S ('S 'Z)))) r (VectorFamilyF d r)
forall a. a -> a -> a -> a -> V4 a
L4.V4
                (SS (SS (SS (SS (SS SingPeano d
_))))) -> Fun (Peano (FromPeano d)) r (VectorFamilyF d r)
forall (v :: * -> *) a. Vector v a => Fun (Peano (Dim v)) a (v a)
V.construct
  {-# INLINE construct #-}
  inspect :: VectorFamily d r -> Fun (Peano (Dim (VectorFamily d))) r b -> b
inspect (VectorFamily VectorFamilyF d r
v) ff :: Fun (Peano (Dim (VectorFamily d))) r b
ff@(Fun Fn (Peano (Dim (VectorFamily d))) r b
f) = case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
                SingPeano d
SZ                         -> b
Fn (Peano (Dim (VectorFamily d))) r b
f
                (SS SingPeano d
SZ)                    -> Identity r -> Fun (Peano (Dim Identity)) r b -> b
forall (v :: * -> *) a b.
Vector v a =>
v a -> Fun (Peano (Dim v)) a b -> b
V.inspect Identity r
VectorFamilyF d r
v Fun (Peano (Dim Identity)) r b
Fun (Peano (Dim (VectorFamily d))) r b
ff
                (SS (SS SingPeano d
SZ))               -> let (L2.V2 r
x r
y) = V2 r
VectorFamilyF d r
v     in Fn (Peano (Dim (VectorFamily d))) r b
r -> r -> b
f r
x r
y
                (SS (SS (SS SingPeano d
SZ)))          -> let (L3.V3 r
x r
y r
z) = V3 r
VectorFamilyF d r
v   in Fn (Peano (Dim (VectorFamily d))) r b
r -> r -> r -> b
f r
x r
y r
z
                (SS (SS (SS (SS SingPeano d
SZ))))     -> let (L4.V4 r
x r
y r
z r
w) = V4 r
VectorFamilyF d r
v in Fn (Peano (Dim (VectorFamily d))) r b
r -> r -> r -> r -> b
f r
x r
y r
z r
w
                (SS (SS (SS (SS (SS SingPeano d
_))))) -> Vector (FromPeano d) r
-> Fun (Peano (Dim (Vector (FromPeano d)))) r b -> b
forall (v :: * -> *) a b.
Vector v a =>
v a -> Fun (Peano (Dim v)) a b -> b
V.inspect Vector (FromPeano d) r
VectorFamilyF d r
v Fun (Peano (Dim (Vector (FromPeano d)))) r b
Fun (Peano (Dim (VectorFamily d))) r b
ff
  {-# INLINE inspect #-}
  basicIndex :: VectorFamily d r -> Int -> r
basicIndex VectorFamily d r
v Int
i = VectorFamily d r
vVectorFamily d r -> Getting r (VectorFamily d r) r -> r
forall s a. s -> Getting a s a -> a
^.Traversing (->) (Const r) (VectorFamily d r) (VectorFamily d r) r r
-> Getting r (VectorFamily d 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 (Int -> Traversal' (VectorFamily d r) r
forall (d :: PeanoNum) r.
ImplicitArity d =>
Int -> Traversal' (VectorFamily d r) r
element' Int
i)
  {-# INLINE basicIndex #-}

instance (ImplicitArity d, Show r) => Show (VectorFamily d r) where
  show :: VectorFamily d r -> String
show VectorFamily 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
$ VectorFamily d r -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length VectorFamily d r
v , String
" "
                   , [r] -> String
forall a. Show a => a -> String
show ([r] -> String) -> [r] -> String
forall a b. (a -> b) -> a -> b
$ VectorFamily d r -> [r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList VectorFamily d r
v ]

instance (NFData r, ImplicitArity d) => NFData (VectorFamily d r) where
  rnf :: VectorFamily d r -> ()
rnf (VectorFamily VectorFamilyF d r
v) = case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
                           SingPeano d
SZ                         -> Const () r -> ()
forall a. NFData a => a -> ()
rnf Const () r
VectorFamilyF d r
v
                           (SS SingPeano d
SZ)                    -> Identity r -> ()
forall a. NFData a => a -> ()
rnf Identity r
VectorFamilyF d r
v
                           (SS (SS SingPeano d
SZ))               -> V2 r -> ()
forall a. NFData a => a -> ()
rnf V2 r
VectorFamilyF d r
v
                           (SS (SS (SS SingPeano d
SZ)))          -> V3 r -> ()
forall a. NFData a => a -> ()
rnf V3 r
VectorFamilyF d r
v
                           (SS (SS (SS (SS SingPeano d
SZ))))     -> V4 r -> ()
forall a. NFData a => a -> ()
rnf V4 r
VectorFamilyF d r
v
                           (SS (SS (SS (SS (SS SingPeano d
_))))) -> Vector (FromPeano d) r -> ()
forall a. NFData a => a -> ()
rnf Vector (FromPeano d) r
VectorFamilyF d r
v
  {-# INLINE rnf #-}


instance (ImplicitPeano d, Hashable r) => Hashable (VectorFamily d r) where
  hashWithSalt :: Int -> VectorFamily d r -> Int
hashWithSalt = case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
                   SingPeano d
SZ                         -> Int -> VectorFamily d r -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt
                   (SS SingPeano d
SZ)                    -> Int -> VectorFamily d r -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt
                   (SS (SS SingPeano d
SZ))               -> Int -> VectorFamily d r -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt
                   (SS (SS (SS SingPeano d
SZ)))          -> Int -> VectorFamily d r -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt
                   (SS (SS (SS (SS SingPeano d
SZ))))     -> Int -> VectorFamily d r -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt
                   (SS (SS (SS (SS (SS SingPeano d
_))))) -> Int -> VectorFamily d r -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt


instance ImplicitArity d => Ixed (VectorFamily d r) where
  ix :: Index (VectorFamily d r)
-> Traversal' (VectorFamily d r) (IxValue (VectorFamily d r))
ix = Index (VectorFamily d r)
-> (IxValue (VectorFamily d r) -> f (IxValue (VectorFamily d r)))
-> VectorFamily d r
-> f (VectorFamily d r)
forall (d :: PeanoNum) r.
ImplicitArity d =>
Int -> Traversal' (VectorFamily d r) r
element'

element' :: forall d r. ImplicitArity d => Int -> Traversal' (VectorFamily d r) r
element' :: Int -> Traversal' (VectorFamily d r) r
element' = case (SingPeano d
forall (d :: PeanoNum). ImplicitPeano d => SingPeano d
implicitPeano :: SingPeano d) of
               SingPeano d
SZ                         -> Int -> (r -> f r) -> VectorFamily d r -> f (VectorFamily d r)
forall r. Int -> Traversal' (VectorFamily 'Z r) r
elem0
               (SS SingPeano d
SZ)                    -> Int -> (r -> f r) -> VectorFamily d r -> f (VectorFamily d r)
forall r. Int -> Traversal' (VectorFamily ('S 'Z) r) r
elem1
               (SS (SS SingPeano d
SZ))               -> Int -> (r -> f r) -> VectorFamily d r -> f (VectorFamily d r)
forall r. Int -> Traversal' (VectorFamily ('S ('S 'Z)) r) r
elem2
               (SS (SS (SS SingPeano d
SZ)))          -> Int -> (r -> f r) -> VectorFamily d r -> f (VectorFamily d r)
forall r. Int -> Traversal' (VectorFamily ('S ('S ('S 'Z))) r) r
elem3
               (SS (SS (SS (SS SingPeano d
SZ))))     -> Int -> (r -> f r) -> VectorFamily d r -> f (VectorFamily d r)
forall r.
Int -> Traversal' (VectorFamily ('S ('S ('S ('S 'Z)))) r) r
elem4
               (SS (SS (SS (SS (SS SingPeano d
_))))) -> Int -> (r -> f r) -> VectorFamily d r -> f (VectorFamily d r)
forall (d :: PeanoNum) r.
Arity (FromPeano (Many d)) =>
Int -> Traversal' (VectorFamily (Many d) r) r
elemD
{-# INLINE element' #-}

elem0   :: Int -> Traversal' (VectorFamily Z r) r
elem0 :: Int -> Traversal' (VectorFamily 'Z r) r
elem0 Int
_ r -> f r
_ = VectorFamily 'Z r -> f (VectorFamily 'Z r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE elem0 #-}
-- zero length vectors don't store any elements

elem1 :: Int -> Traversal' (VectorFamily One r) r
elem1 :: Int -> Traversal' (VectorFamily ('S 'Z) r) r
elem1 = \case
           Int
0 -> (Identity r -> f (Identity r))
-> VectorFamily ('S 'Z) r -> f (VectorFamily ('S 'Z) r)
forall (d :: PeanoNum) r t.
Lens
  (VectorFamily d r)
  (VectorFamily d t)
  (VectorFamilyF d r)
  (VectorFamilyF d t)
unVF((Identity r -> f (Identity r))
 -> VectorFamily ('S 'Z) r -> f (VectorFamily ('S 'Z) r))
-> ((r -> f r) -> Identity r -> f (Identity r))
-> (r -> f r)
-> VectorFamily ('S 'Z) r
-> f (VectorFamily ('S 'Z) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Identity r -> r)
-> (Identity r -> r -> Identity r)
-> Lens (Identity r) (Identity r) r r
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Identity r -> r
forall a. Identity a -> a
runIdentity ((r -> Identity r) -> Identity r -> r -> Identity r
forall a b. a -> b -> a
const r -> Identity r
forall a. a -> Identity a
Identity)
           Int
_ -> \r -> f r
_ VectorFamily ('S 'Z) r
v -> VectorFamily ('S 'Z) r -> f (VectorFamily ('S 'Z) r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VectorFamily ('S 'Z) r
v
{-# INLINE elem1 #-}

elem2 :: Int -> Traversal' (VectorFamily Two r) r
elem2 :: Int -> Traversal' (VectorFamily ('S ('S 'Z)) r) r
elem2 = \case
          Int
0 -> (V2 r -> f (V2 r))
-> VectorFamily ('S ('S 'Z)) r -> f (VectorFamily ('S ('S 'Z)) r)
forall (d :: PeanoNum) r t.
Lens
  (VectorFamily d r)
  (VectorFamily d t)
  (VectorFamilyF d r)
  (VectorFamilyF d t)
unVF((V2 r -> f (V2 r))
 -> VectorFamily ('S ('S 'Z)) r -> f (VectorFamily ('S ('S 'Z)) r))
-> ((r -> f r) -> V2 r -> f (V2 r))
-> (r -> f r)
-> VectorFamily ('S ('S 'Z)) r
-> f (VectorFamily ('S ('S 'Z)) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> f r) -> V2 r -> f (V2 r)
forall (t :: * -> *) a. R1 t => Lens' (t a) a
L2._x
          Int
1 -> (V2 r -> f (V2 r))
-> VectorFamily ('S ('S 'Z)) r -> f (VectorFamily ('S ('S 'Z)) r)
forall (d :: PeanoNum) r t.
Lens
  (VectorFamily d r)
  (VectorFamily d t)
  (VectorFamilyF d r)
  (VectorFamilyF d t)
unVF((V2 r -> f (V2 r))
 -> VectorFamily ('S ('S 'Z)) r -> f (VectorFamily ('S ('S 'Z)) r))
-> ((r -> f r) -> V2 r -> f (V2 r))
-> (r -> f r)
-> VectorFamily ('S ('S 'Z)) r
-> f (VectorFamily ('S ('S 'Z)) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> f r) -> V2 r -> f (V2 r)
forall (t :: * -> *) a. R2 t => Lens' (t a) a
L2._y
          Int
_ -> \r -> f r
_ VectorFamily ('S ('S 'Z)) r
v -> VectorFamily ('S ('S 'Z)) r -> f (VectorFamily ('S ('S 'Z)) r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VectorFamily ('S ('S 'Z)) r
v
{-# INLINE elem2 #-}

elem3 :: Int -> Traversal' (VectorFamily Three r) r
elem3 :: Int -> Traversal' (VectorFamily ('S ('S ('S 'Z))) r) r
elem3 = \case
          Int
0 -> (V3 r -> f (V3 r))
-> VectorFamily ('S ('S ('S 'Z))) r
-> f (VectorFamily ('S ('S ('S 'Z))) r)
forall (d :: PeanoNum) r t.
Lens
  (VectorFamily d r)
  (VectorFamily d t)
  (VectorFamilyF d r)
  (VectorFamilyF d t)
unVF((V3 r -> f (V3 r))
 -> VectorFamily ('S ('S ('S 'Z))) r
 -> f (VectorFamily ('S ('S ('S 'Z))) r))
-> ((r -> f r) -> V3 r -> f (V3 r))
-> (r -> f r)
-> VectorFamily ('S ('S ('S 'Z))) r
-> f (VectorFamily ('S ('S ('S 'Z))) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> f r) -> V3 r -> f (V3 r)
forall (t :: * -> *) a. R1 t => Lens' (t a) a
L3._x
          Int
1 -> (V3 r -> f (V3 r))
-> VectorFamily ('S ('S ('S 'Z))) r
-> f (VectorFamily ('S ('S ('S 'Z))) r)
forall (d :: PeanoNum) r t.
Lens
  (VectorFamily d r)
  (VectorFamily d t)
  (VectorFamilyF d r)
  (VectorFamilyF d t)
unVF((V3 r -> f (V3 r))
 -> VectorFamily ('S ('S ('S 'Z))) r
 -> f (VectorFamily ('S ('S ('S 'Z))) r))
-> ((r -> f r) -> V3 r -> f (V3 r))
-> (r -> f r)
-> VectorFamily ('S ('S ('S 'Z))) r
-> f (VectorFamily ('S ('S ('S 'Z))) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> f r) -> V3 r -> f (V3 r)
forall (t :: * -> *) a. R2 t => Lens' (t a) a
L3._y
          Int
2 -> (V3 r -> f (V3 r))
-> VectorFamily ('S ('S ('S 'Z))) r
-> f (VectorFamily ('S ('S ('S 'Z))) r)
forall (d :: PeanoNum) r t.
Lens
  (VectorFamily d r)
  (VectorFamily d t)
  (VectorFamilyF d r)
  (VectorFamilyF d t)
unVF((V3 r -> f (V3 r))
 -> VectorFamily ('S ('S ('S 'Z))) r
 -> f (VectorFamily ('S ('S ('S 'Z))) r))
-> ((r -> f r) -> V3 r -> f (V3 r))
-> (r -> f r)
-> VectorFamily ('S ('S ('S 'Z))) r
-> f (VectorFamily ('S ('S ('S 'Z))) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> f r) -> V3 r -> f (V3 r)
forall (t :: * -> *) a. R3 t => Lens' (t a) a
L3._z
          Int
_ -> \r -> f r
_ VectorFamily ('S ('S ('S 'Z))) r
v -> VectorFamily ('S ('S ('S 'Z))) r
-> f (VectorFamily ('S ('S ('S 'Z))) r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VectorFamily ('S ('S ('S 'Z))) r
v
{-# INLINE elem3 #-}

elem4 :: Int -> Traversal' (VectorFamily Four r) r
elem4 :: Int -> Traversal' (VectorFamily ('S ('S ('S ('S 'Z)))) r) r
elem4 = \case
          Int
0 -> (V4 r -> f (V4 r))
-> VectorFamily ('S ('S ('S ('S 'Z)))) r
-> f (VectorFamily ('S ('S ('S ('S 'Z)))) r)
forall (d :: PeanoNum) r t.
Lens
  (VectorFamily d r)
  (VectorFamily d t)
  (VectorFamilyF d r)
  (VectorFamilyF d t)
unVF((V4 r -> f (V4 r))
 -> VectorFamily ('S ('S ('S ('S 'Z)))) r
 -> f (VectorFamily ('S ('S ('S ('S 'Z)))) r))
-> ((r -> f r) -> V4 r -> f (V4 r))
-> (r -> f r)
-> VectorFamily ('S ('S ('S ('S 'Z)))) r
-> f (VectorFamily ('S ('S ('S ('S 'Z)))) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> f r) -> V4 r -> f (V4 r)
forall (t :: * -> *) a. R1 t => Lens' (t a) a
L4._x
          Int
1 -> (V4 r -> f (V4 r))
-> VectorFamily ('S ('S ('S ('S 'Z)))) r
-> f (VectorFamily ('S ('S ('S ('S 'Z)))) r)
forall (d :: PeanoNum) r t.
Lens
  (VectorFamily d r)
  (VectorFamily d t)
  (VectorFamilyF d r)
  (VectorFamilyF d t)
unVF((V4 r -> f (V4 r))
 -> VectorFamily ('S ('S ('S ('S 'Z)))) r
 -> f (VectorFamily ('S ('S ('S ('S 'Z)))) r))
-> ((r -> f r) -> V4 r -> f (V4 r))
-> (r -> f r)
-> VectorFamily ('S ('S ('S ('S 'Z)))) r
-> f (VectorFamily ('S ('S ('S ('S 'Z)))) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> f r) -> V4 r -> f (V4 r)
forall (t :: * -> *) a. R2 t => Lens' (t a) a
L4._y
          Int
2 -> (V4 r -> f (V4 r))
-> VectorFamily ('S ('S ('S ('S 'Z)))) r
-> f (VectorFamily ('S ('S ('S ('S 'Z)))) r)
forall (d :: PeanoNum) r t.
Lens
  (VectorFamily d r)
  (VectorFamily d t)
  (VectorFamilyF d r)
  (VectorFamilyF d t)
unVF((V4 r -> f (V4 r))
 -> VectorFamily ('S ('S ('S ('S 'Z)))) r
 -> f (VectorFamily ('S ('S ('S ('S 'Z)))) r))
-> ((r -> f r) -> V4 r -> f (V4 r))
-> (r -> f r)
-> VectorFamily ('S ('S ('S ('S 'Z)))) r
-> f (VectorFamily ('S ('S ('S ('S 'Z)))) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> f r) -> V4 r -> f (V4 r)
forall (t :: * -> *) a. R3 t => Lens' (t a) a
L4._z
          Int
3 -> (V4 r -> f (V4 r))
-> VectorFamily ('S ('S ('S ('S 'Z)))) r
-> f (VectorFamily ('S ('S ('S ('S 'Z)))) r)
forall (d :: PeanoNum) r t.
Lens
  (VectorFamily d r)
  (VectorFamily d t)
  (VectorFamilyF d r)
  (VectorFamilyF d t)
unVF((V4 r -> f (V4 r))
 -> VectorFamily ('S ('S ('S ('S 'Z)))) r
 -> f (VectorFamily ('S ('S ('S ('S 'Z)))) r))
-> ((r -> f r) -> V4 r -> f (V4 r))
-> (r -> f r)
-> VectorFamily ('S ('S ('S ('S 'Z)))) r
-> f (VectorFamily ('S ('S ('S ('S 'Z)))) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> f r) -> V4 r -> f (V4 r)
forall (t :: * -> *) a. R4 t => Lens' (t a) a
L4._w
          Int
_ -> \r -> f r
_ VectorFamily ('S ('S ('S ('S 'Z)))) r
v -> VectorFamily ('S ('S ('S ('S 'Z)))) r
-> f (VectorFamily ('S ('S ('S ('S 'Z)))) r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VectorFamily ('S ('S ('S ('S 'Z)))) r
v
{-# INLINE elem4 #-}

elemD   :: V.Arity (FromPeano (Many d)) => Int -> Traversal' (VectorFamily (Many d) r) r
elemD :: Int -> Traversal' (VectorFamily (Many d) r) r
elemD Int
i = (Vector (1 + (1 + (1 + (1 + (1 + FromPeano d))))) r
 -> f (Vector (1 + (1 + (1 + (1 + (1 + FromPeano d))))) r))
-> VectorFamily (Many d) r -> f (VectorFamily (Many d) r)
forall (d :: PeanoNum) r t.
Lens
  (VectorFamily d r)
  (VectorFamily d t)
  (VectorFamilyF d r)
  (VectorFamilyF d t)
unVF((Vector (1 + (1 + (1 + (1 + (1 + FromPeano d))))) r
  -> f (Vector (1 + (1 + (1 + (1 + (1 + FromPeano d))))) r))
 -> VectorFamily (Many d) r -> f (VectorFamily (Many d) r))
-> ((r -> f r)
    -> Vector (1 + (1 + (1 + (1 + (1 + FromPeano d))))) r
    -> f (Vector (1 + (1 + (1 + (1 + (1 + FromPeano d))))) r))
-> (r -> f r)
-> VectorFamily (Many d) r
-> f (VectorFamily (Many d) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int
-> Traversal'
     (Vector (1 + (1 + (1 + (1 + (1 + FromPeano d))))) r) r
forall (d :: Nat) r. Arity d => Int -> Traversal' (Vector d r) r
FV.element' Int
i
{-# INLINE elemD #-}


instance ImplicitArity d => Metric (VectorFamily d)

instance ImplicitArity d => Additive (VectorFamily d) where
  zero :: VectorFamily d a
zero = a -> VectorFamily d a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
0
  VectorFamily d a
u ^+^ :: VectorFamily d a -> VectorFamily d a -> VectorFamily d a
^+^ VectorFamily d a
v = (a -> a -> a)
-> VectorFamily d a -> VectorFamily d a -> VectorFamily d a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+) VectorFamily d a
u VectorFamily d a
v

instance ImplicitArity d => Affine (VectorFamily d) where
  type Diff (VectorFamily d) = VectorFamily d

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

instance (FromJSON r, ImplicitArity d)  => FromJSON (VectorFamily d r) where
  parseJSON :: Value -> Parser (VectorFamily d r)
parseJSON Value
y = Value -> Parser [r]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
y Parser [r]
-> ([r] -> Parser (VectorFamily d r)) -> Parser (VectorFamily d r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[r]
xs -> case [r] -> Maybe (VectorFamily d r)
forall (d :: PeanoNum) r.
ImplicitArity d =>
[r] -> Maybe (VectorFamily d r)
vectorFromList [r]
xs of
                  Maybe (VectorFamily d r)
Nothing -> String -> Parser (VectorFamily d r)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (VectorFamily d r))
-> ([String] -> String) -> [String] -> Parser (VectorFamily d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> Parser (VectorFamily d r))
-> [String] -> Parser (VectorFamily 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 (FromPeano d) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (FromPeano d)
forall k (t :: k). Proxy t
Proxy :: Proxy (FromPeano 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 VectorFamily d r
v -> VectorFamily d r -> Parser (VectorFamily d r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VectorFamily d r
v

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

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

vectorFromList :: ImplicitArity d => [r] -> Maybe (VectorFamily d r)
vectorFromList :: [r] -> Maybe (VectorFamily d r)
vectorFromList = [r] -> Maybe (VectorFamily d r)
forall (v :: * -> *) a. Vector v a => [a] -> Maybe (v a)
V.fromListM

-- vectorFromListUnsafe :: ImplicitArity d => [r] -> VectorFamily d r
-- vectorFromListUnsafe = V.fromList

-- -- | Get the head and tail of a vector
-- destruct   :: (ImplicitArity d, ImplicitArity (S d))
--            => VectorFamily (S d) r -> (r, VectorFamily d r)
-- destruct v = (head $ F.toList v, vectorFromListUnsafe . tail $ F.toList v)
--   -- FIXME: this implementaion of tail is not particularly nice

-- snoc     :: (ImplicitArity d, ImplicitArity (S d))
--          => VectorFamily d r -> r -> VectorFamily (S d) r
-- snoc = flip V.snoc