manifolds-core-0.6.1.0: The basic classes for the manifolds hierarchy.
Copyright(c) Justus Sagemüller 2016
LicenseGPL v3
Maintainer(@) jsag $ hvl.no
Stabilityexperimental
Portabilityportable
Safe HaskellSafe-Inferred
LanguageHaskell2010

Math.Manifold.Core.PseudoAffine

Description

 
Synopsis

Documentation

data SemimanifoldWitness x where Source #

This is the reified form of the property that the interior of a semimanifold is a manifold. These constraints would ideally be expressed directly as superclass constraints, but that would require the UndecidableSuperclasses extension, which is not reliable yet.

Also, if all those equality constraints are in scope, GHC tends to infer needlessly complicated types like Needle (Needle (Needle x)), which is the same as just Needle x.

class AdditiveGroup (Needle x) => Semimanifold x where Source #

Minimal complete definition

Nothing

Associated Types

type Needle x :: * Source #

The space of “ways” starting from some reference point and going to some particular target point. Hence, the name: like a compass needle, but also with an actual length. For affine spaces, Needle is simply the space of line segments (aka vectors) between two points, i.e. the same as Diff. The AffineManifold constraint makes that requirement explicit.

This space should be isomorphic to the tangent space (and in fact serves an in many ways similar role), however whereas the tangent space of a manifold is really infinitesimally small, needles actually allow macroscopic displacements.

Methods

(.+~^) :: x -> Needle x -> x infixl 6 Source #

Generalisation of the translation operation .+^ to possibly non-flat manifolds, instead of affine spaces.

default (.+~^) :: (Generic x, Semimanifold (VRep x), Needle x ~ GenericNeedle x) => x -> Needle x -> x Source #

(.-~^) :: x -> Needle x -> x infixl 6 Source #

Shorthand for \p v -> p .+~^ negateV v, which should obey the asymptotic law

p .-~^ v .+~^ v ≅ p

Meaning: if v is scaled down with sufficiently small factors η, then the difference (p.-~^v.+~^v) .-~. p should eventually scale down even faster: as O (η²). For large vectors, it may however behave differently, except in flat spaces (where all this should be equivalent to the AffineSpace instance).

semimanifoldWitness :: SemimanifoldWitness x Source #

Instances

Instances details
Semimanifold Rational Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle Rational Source #

Semimanifold Double Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle Double Source #

Semimanifold Float Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle Float Source #

AdditiveGroup (Needle (VRep x)) => Semimanifold (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle (GenericNeedle x) Source #

ℝeal r => Semimanifold (ℝP¹_ r) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle (ℝP¹_ r) Source #

Semimanifold (ℝP⁰_ r) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle (ℝP⁰_ r) Source #

Semimanifold (ZeroDim k) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle (ZeroDim k) Source #

(Semimanifold a, Semimanifold b) => Semimanifold (a, b) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle (a, b) Source #

Methods

(.+~^) :: (a, b) -> Needle (a, b) -> (a, b) Source #

(.-~^) :: (a, b) -> Needle (a, b) -> (a, b) Source #

semimanifoldWitness :: SemimanifoldWitness (a, b) Source #

Semimanifold a => Semimanifold (Rec0 a s) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle (Rec0 a s) Source #

Methods

(.+~^) :: Rec0 a s -> Needle (Rec0 a s) -> Rec0 a s Source #

(.-~^) :: Rec0 a s -> Needle (Rec0 a s) -> Rec0 a s Source #

semimanifoldWitness :: SemimanifoldWitness (Rec0 a s) Source #

(Semimanifold (f p), Semimanifold (g p)) => Semimanifold (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle (NeedleProductSpace f g p) Source #

(Semimanifold a, Semimanifold b, Semimanifold c) => Semimanifold (a, b, c) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle (a, b, c) Source #

Methods

(.+~^) :: (a, b, c) -> Needle (a, b, c) -> (a, b, c) Source #

(.-~^) :: (a, b, c) -> Needle (a, b, c) -> (a, b, c) Source #

semimanifoldWitness :: SemimanifoldWitness (a, b, c) Source #

(Semimanifold (f p), Semimanifold (g p)) => Semimanifold ((f :*: g) p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle ((f :*: g) p) Source #

Methods

(.+~^) :: (f :*: g) p -> Needle ((f :*: g) p) -> (f :*: g) p Source #

(.-~^) :: (f :*: g) p -> Needle ((f :*: g) p) -> (f :*: g) p Source #

semimanifoldWitness :: SemimanifoldWitness ((f :*: g) p) Source #

Semimanifold (f p) => Semimanifold (M1 i c f p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle (M1 i c f p) Source #

Methods

(.+~^) :: M1 i c f p -> Needle (M1 i c f p) -> M1 i c f p Source #

(.-~^) :: M1 i c f p -> Needle (M1 i c f p) -> M1 i c f p Source #

semimanifoldWitness :: SemimanifoldWitness (M1 i c f p) Source #

class Semimanifold x => PseudoAffine x where Source #

This is the class underlying what we understand as manifolds.

The interface is almost identical to the better-known AffineSpace class, but we don't require associativity of .+~^ with ^+^ – except in an asymptotic sense for small vectors.

That innocent-looking change makes the class applicable to vastly more general types: while an affine space is basically nothing but a vector space without particularly designated origin, a pseudo-affine space can have nontrivial topology on the global scale, and yet be used in practically the same way as an affine space. At least the usual spheres and tori make good instances, perhaps the class is in fact equivalent to manifolds in their usual maths definition (with an atlas of charts: a family of overlapping regions of the topological space, each homeomorphic to the Needle vector space or some simply-connected subset thereof).

The Semimanifold and PseudoAffine classes can be anyclass-derived or empty-instantiated based on Generic for product types (including newtypes) of existing PseudoAffine instances. For example, the definition

data Cylinder = CylinderPolar { zCyl :: !D¹, φCyl :: !S¹ }
  deriving (Generic, Semimanifold, PseudoAffine)

is equivalent to

data Cylinder = CylinderPolar { zCyl :: !D¹, φCyl :: !S¹ }

data CylinderNeedle = CylinderPolarNeedle { δzCyl :: !(Needle D¹), δφCyl :: !(Needle S¹) }

instance Semimanifold Cylinder where
  type Needle Cylinder = CylinderNeedle
  CylinderPolar z φ .+~^ CylinderPolarNeedle δz δφ
       = CylinderPolar (z.+~^δz) (φ.+~^δφ)

instance PseudoAffine Cylinder where
  CylinderPolar z₁ φ₁ .-~. CylinderPolar z₀ φ₀
       = CylinderPolarNeedle $ z₁.-~.z₀ * φ₁.-~.φ₀
  CylinderPolar z₁ φ₁ .-~! CylinderPolar z₀ φ₀
       = CylinderPolarNeedle (z₁.-~!z₀) (φ₁.-~.φ₀)

Minimal complete definition

Nothing

Methods

(.-~.) :: x -> x -> Maybe (Needle x) infix 6 Source #

The path reaching from one point to another. Should only yield Nothing if the points are on disjoint segments of a non–path-connected space.

For a connected manifold, you may define this method as

  p.-~.q = pure (p.-~!q)

default (.-~.) :: (Generic x, PseudoAffine (VRep x), Needle x ~ GenericNeedle x) => x -> x -> Maybe (Needle x) Source #

(.-~!) :: HasCallStack => x -> x -> Needle x infix 6 Source #

Unsafe version of .-~.. If the two points lie in disjoint regions, the behaviour is undefined.

Whenever p and q lie in a connected region, the identity

p .+~^ (q.-~.p) ≡ q

should hold (up to possible floating point rounding etc.). Meanwhile, you will in general have

(p.+~^v).-~^v ≠ p

(though in many instances this is at least for sufficiently small v approximately equal).

default (.-~!) :: (Generic x, PseudoAffine (VRep x), Needle x ~ GenericNeedle x) => x -> x -> Needle x Source #

pseudoAffineWitness :: PseudoAffineWitness x Source #

Instances

Instances details
PseudoAffine Rational Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

PseudoAffine Double Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

PseudoAffine Float Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

AdditiveGroup (Needle (VRep x)) => PseudoAffine (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

ℝeal r => PseudoAffine (ℝP¹_ r) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

PseudoAffine (ℝP⁰_ r) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

PseudoAffine (ZeroDim k) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

(PseudoAffine a, PseudoAffine b) => PseudoAffine (a, b) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Methods

(.-~.) :: (a, b) -> (a, b) -> Maybe (Needle (a, b)) Source #

(.-~!) :: (a, b) -> (a, b) -> Needle (a, b) Source #

pseudoAffineWitness :: PseudoAffineWitness (a, b) Source #

PseudoAffine a => PseudoAffine (Rec0 a s) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Methods

(.-~.) :: Rec0 a s -> Rec0 a s -> Maybe (Needle (Rec0 a s)) Source #

(.-~!) :: Rec0 a s -> Rec0 a s -> Needle (Rec0 a s) Source #

pseudoAffineWitness :: PseudoAffineWitness (Rec0 a s) Source #

(PseudoAffine (f p), PseudoAffine (g p)) => PseudoAffine (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

(PseudoAffine a, PseudoAffine b, PseudoAffine c) => PseudoAffine (a, b, c) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Methods

(.-~.) :: (a, b, c) -> (a, b, c) -> Maybe (Needle (a, b, c)) Source #

(.-~!) :: (a, b, c) -> (a, b, c) -> Needle (a, b, c) Source #

pseudoAffineWitness :: PseudoAffineWitness (a, b, c) Source #

(PseudoAffine (f p), PseudoAffine (g p)) => PseudoAffine ((f :*: g) p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Methods

(.-~.) :: (f :*: g) p -> (f :*: g) p -> Maybe (Needle ((f :*: g) p)) Source #

(.-~!) :: (f :*: g) p -> (f :*: g) p -> Needle ((f :*: g) p) Source #

pseudoAffineWitness :: PseudoAffineWitness ((f :*: g) p) Source #

PseudoAffine (f p) => PseudoAffine (M1 i c f p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Methods

(.-~.) :: M1 i c f p -> M1 i c f p -> Maybe (Needle (M1 i c f p)) Source #

(.-~!) :: M1 i c f p -> M1 i c f p -> Needle (M1 i c f p) Source #

pseudoAffineWitness :: PseudoAffineWitness (M1 i c f p) Source #

data FibreBundle b f Source #

A fibre bundle combines points in the base space b with points in the fibre f. The type FibreBundle b f is thus isomorphic to the tuple space (b,f), but it can have a different topology, the prime example being TangentBundle, where nearby points may have differently-oriented tangent spaces.

Constructors

FibreBundle 

Fields

Instances

Instances details
Generic (FibreBundle b f) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Rep (FibreBundle b f) :: Type -> Type #

Methods

from :: FibreBundle b f -> Rep (FibreBundle b f) x #

to :: Rep (FibreBundle b f) x -> FibreBundle b f #

(Show b, Show f) => Show (FibreBundle b f) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Methods

showsPrec :: Int -> FibreBundle b f -> ShowS #

show :: FibreBundle b f -> String #

showList :: [FibreBundle b f] -> ShowS #

type Rep (FibreBundle b f) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type Rep (FibreBundle b f) = D1 ('MetaData "FibreBundle" "Math.Manifold.Core.PseudoAffine" "manifolds-core-0.6.1.0-7JLeNpkgg097AjSvrWgCob" 'False) (C1 ('MetaCons "FibreBundle" 'PrefixI 'True) (S1 ('MetaSel ('Just "baseSpace") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 b) :*: S1 ('MetaSel ('Just "fibreSpace") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 f)))

type TangentBundle m = FibreBundle m (Needle m) Source #

Points on a manifold, combined with vectors in the respective tangent space.

palerp :: forall x. (PseudoAffine x, VectorSpace (Needle x)) => x -> x -> Maybe (Scalar (Needle x) -> x) Source #

Interpolate between points, approximately linearly. For points that aren't close neighbours (i.e. lie in an almost flat region), the pathway is basically undefined – save for its end points.

A proper, really well-defined (on global scales) interpolation only makes sense on a Riemannian manifold, as Geodesic.

palerpB :: forall x. (PseudoAffine x, VectorSpace (Needle x), Scalar (Needle x) ~ ) => x -> x -> Maybe ( -> x) Source #

Like palerp, but actually restricted to the interval between the points, with a signature like geodesicBetween rather than alerp.

alerpB :: forall x. (AffineSpace x, VectorSpace (Diff x), Scalar (Diff x) ~ ) => x -> x -> -> x Source #

Like alerp, but actually restricted to the interval between the points.

tau :: RealFloat r => r Source #

toS¹range :: RealFloat r => r -> r Source #

toUnitrange :: RealFloat r => r -> r Source #

data NeedleProductSpace f g p Source #

Constructors

NeedleProductSpace !(Needle (f p)) !(Needle (g p)) 

Instances

Instances details
Generic (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Rep (NeedleProductSpace f g p) :: Type -> Type #

Methods

from :: NeedleProductSpace f g p -> Rep (NeedleProductSpace f g p) x #

to :: Rep (NeedleProductSpace f g p) x -> NeedleProductSpace f g p #

(PseudoAffine (f p), PseudoAffine (g p)) => PseudoAffine (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

(Semimanifold (f p), Semimanifold (g p)) => Semimanifold (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle (NeedleProductSpace f g p) Source #

(Semimanifold (f p), Semimanifold (g p)) => AdditiveGroup (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

(Semimanifold (f p), Semimanifold (g p)) => AffineSpace (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Diff (NeedleProductSpace f g p) #

(Semimanifold (f p), Semimanifold (g p), HasBasis (Needle (f p)), HasBasis (Needle (g p)), Scalar (Needle (f p)) ~ Scalar (Needle (g p))) => HasBasis (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Basis (NeedleProductSpace f g p) #

(Semimanifold (f p), Semimanifold (g p), InnerSpace (Needle (f p)), InnerSpace (Needle (g p)), Scalar (Needle (f p)) ~ Scalar (Needle (g p)), Num (Scalar (Needle (f p)))) => InnerSpace (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

(Semimanifold (f p), Semimanifold (g p), VectorSpace (Needle (f p)), VectorSpace (Needle (g p)), Scalar (Needle (f p)) ~ Scalar (Needle (g p))) => VectorSpace (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Scalar (NeedleProductSpace f g p) #

type Rep (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type Rep (NeedleProductSpace f g p) = D1 ('MetaData "NeedleProductSpace" "Math.Manifold.Core.PseudoAffine" "manifolds-core-0.6.1.0-7JLeNpkgg097AjSvrWgCob" 'False) (C1 ('MetaCons "NeedleProductSpace" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Needle (f p))) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Needle (g p)))))
type Needle (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type Diff (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type Basis (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type Basis (NeedleProductSpace f g p) = Either (Basis (Needle (f p))) (Basis (Needle (g p)))
type Scalar (NeedleProductSpace f g p) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type Scalar (NeedleProductSpace f g p) = Scalar (VRep (NeedleProductSpace f g p))

newtype GenericNeedle x Source #

Constructors

GenericNeedle 

Instances

Instances details
Generic (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Rep (GenericNeedle x) :: Type -> Type #

Methods

from :: GenericNeedle x -> Rep (GenericNeedle x) x0 #

to :: Rep (GenericNeedle x) x0 -> GenericNeedle x #

AdditiveGroup (Needle (VRep x)) => PseudoAffine (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

AdditiveGroup (Needle (VRep x)) => Semimanifold (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Needle (GenericNeedle x) Source #

AdditiveGroup (Needle (VRep x)) => AdditiveGroup (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

AdditiveGroup (Needle (VRep x)) => AffineSpace (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Diff (GenericNeedle x) #

InnerSpace (Needle (VRep x)) => InnerSpace (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

VectorSpace (Needle (VRep x)) => VectorSpace (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Scalar (GenericNeedle x) #

type Rep (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type Rep (GenericNeedle x) = D1 ('MetaData "GenericNeedle" "Math.Manifold.Core.PseudoAffine" "manifolds-core-0.6.1.0-7JLeNpkgg097AjSvrWgCob" 'True) (C1 ('MetaCons "GenericNeedle" 'PrefixI 'True) (S1 ('MetaSel ('Just "getGenericNeedle") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Needle (VRep x)))))
type Needle (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type Diff (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type Scalar (GenericNeedle x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type VRep x = Rep x Void Source #

data CD¹ x Source #

A (closed) cone over a space x is the product of x with the closed interval of “heights”, except on its “tip”: here, x is smashed to a single point.

This construct becomes (homeomorphic-to-) an actual geometric cone (and to ) in the special case x = .

Constructors

CD¹ 

Fields

Instances

Instances details
Generic (CD¹ x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Rep (CD¹ x) :: Type -> Type #

Methods

from :: CD¹ x -> Rep (CD¹ x) x0 #

to :: Rep (CD¹ x) x0 -> CD¹ x #

(Show x, Show (Scalar (Needle x))) => Show (CD¹ x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Methods

showsPrec :: Int -> CD¹ x -> ShowS #

show :: CD¹ x -> String #

showList :: [CD¹ x] -> ShowS #

type Rep (CD¹ x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type Rep (CD¹ x) = D1 ('MetaData "CD\185" "Math.Manifold.Core.PseudoAffine" "manifolds-core-0.6.1.0-7JLeNpkgg097AjSvrWgCob" 'False) (C1 ('MetaCons "CD\185" 'PrefixI 'True) (S1 ('MetaSel ('Just "hParamCD\185") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Scalar (Needle x))) :*: S1 ('MetaSel ('Just "pParamCD\185") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 x)))

data Cℝay x Source #

An open cone is homeomorphic to a closed cone without the “lid”, i.e. without the “last copy” of x, at the far end of the height interval. Since that means the height does not include its supremum, it is actually more natural to express it as the entire real ray, hence the name.

Constructors

Cℝay 

Fields

Instances

Instances details
Generic (Cℝay x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Associated Types

type Rep (Cℝay x) :: Type -> Type #

Methods

from :: Cℝay x -> Rep (Cℝay x) x0 #

to :: Rep (Cℝay x) x0 -> Cℝay x #

(Show x, Show (Scalar (Needle x))) => Show (Cℝay x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

Methods

showsPrec :: Int -> Cℝay x -> ShowS #

show :: Cℝay x -> String #

showList :: [Cℝay x] -> ShowS #

type Rep (Cℝay x) Source # 
Instance details

Defined in Math.Manifold.Core.PseudoAffine

type Rep (Cℝay x) = D1 ('MetaData "C\8477ay" "Math.Manifold.Core.PseudoAffine" "manifolds-core-0.6.1.0-7JLeNpkgg097AjSvrWgCob" 'False) (C1 ('MetaCons "C\8477ay" 'PrefixI 'True) (S1 ('MetaSel ('Just "hParamC\8477ay") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Scalar (Needle x))) :*: S1 ('MetaSel ('Just "pParamC\8477ay") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 x)))