-- |

-- Module:      Data.Geo.Jord.Positions

-- Copyright:   (c) 2020 Cedric Liegeois

-- License:     BSD3

-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>

-- Stability:   experimental

-- Portability: portable

--

-- Functions to convert position between geodetic and geocentric and to transform position coordinates between ellipsoidal models.

--

-- @

-- import qualified Data.Geo.Jord.Geocentric as Geocentric

-- import qualified Data.Geo.Jord.Geodetic as Geodetic

-- import Data.Geo.Jord.Models

-- import qualified Data.Geo.Jord.Positions as Positions

-- import qualified Data.Geo.Jord.Transformations as Transformations

-- @

module Data.Geo.Jord.Positions
    (
    -- Geodetic <=> Geocentric

      toGeodetic
    , toGeocentric
    -- Coordinates transformation between ellipsoidal models

    , transform
    , transform'
    , transformAt
    , transformAt'
    ) where

import Data.Geo.Jord.Ellipsoid (Ellipsoid, eccentricity, equatorialRadius, isSphere, polarRadius)
import qualified Data.Geo.Jord.Geocentric as Geocentric
import qualified Data.Geo.Jord.Geodetic as Geodetic
import Data.Geo.Jord.Length (Length)
import qualified Data.Geo.Jord.Length as Length
import qualified Data.Geo.Jord.Math3d as Math3d
import Data.Geo.Jord.Model
import Data.Geo.Jord.Tx (Graph, Params, Params15, Params7)
import qualified Data.Geo.Jord.Tx as Tx

-- | @toGeodetic p@ converts the geodetic coordinates of position @p@ to geocentric coordinates.

toGeodetic :: (Model m) => Geocentric.Position m -> Geodetic.Position m
toGeodetic :: Position m -> Position m
toGeodetic Position m
p = HorizontalPosition m -> Length -> Position m
forall a. Model a => HorizontalPosition a -> Length -> Position a
Geodetic.atHeight (V3 -> m -> HorizontalPosition m
forall a. Model a => V3 -> a -> HorizontalPosition a
Geodetic.nvectorPos' V3
nv (Position m -> m
forall a. Position a -> a
Geocentric.model Position m
p)) Length
h
  where
    (V3
nv, Length
h) = V3 -> Ellipsoid -> (V3, Length)
nvectorFromGeocentric (Position m -> V3
forall a. Model a => Position a -> V3
Geocentric.metresCoords Position m
p) (m -> Ellipsoid
forall a. Model a => a -> Ellipsoid
surface (m -> Ellipsoid) -> (Position m -> m) -> Position m -> Ellipsoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position m -> m
forall a. Position a -> a
Geocentric.model (Position m -> Ellipsoid) -> Position m -> Ellipsoid
forall a b. (a -> b) -> a -> b
$ Position m
p)

-- | @toGeocentric p@ converts the geocentric coordinates of position @p@ to geodetic coordinates.

toGeocentric :: (Model m) => Geodetic.Position m -> Geocentric.Position m
toGeocentric :: Position m -> Position m
toGeocentric Position m
p =
    Double -> Double -> Double -> m -> Position m
forall a. Model a => Double -> Double -> Double -> a -> Position a
Geocentric.metresPos (V3 -> Double
Math3d.v3x V3
c) (V3 -> Double
Math3d.v3y V3
c) (V3 -> Double
Math3d.v3z V3
c) (Position m -> m
forall a. Model a => Position a -> a
Geodetic.model' Position m
p)
  where
    c :: V3
c = (V3, Length) -> Ellipsoid -> V3
nvectorToGeocentric (Position m -> V3
forall a. HasCoordinates a => a -> V3
Geodetic.nvector Position m
p, Position m -> Length
forall a. Model a => Position a -> Length
Geodetic.height Position m
p) (m -> Ellipsoid
forall a. Model a => a -> Ellipsoid
surface (m -> Ellipsoid) -> (Position m -> m) -> Position m -> Ellipsoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position m -> m
forall a. Model a => Position a -> a
Geodetic.model' (Position m -> Ellipsoid) -> Position m -> Ellipsoid
forall a b. (a -> b) -> a -> b
$ Position m
p)

-- | @transform p1 m2 g@ transforms the coordinates of the position @p1@ from its coordinate system into the coordinate

-- system defined by the model @m2@ using the graph @g@ to find the sequence of transformation parameters. Returns

-- 'Nothing' if the given graph does not contain a transformation from @m1@ to @m2@. For example:

--

-- >>> let pWGS84 = Positions.toGeocentric (Geodetic.latLongHeightPos 48.6921 6.1844 (Length.metres 188) WGS84)

-- >>> Positions.transform pWGS84 NAD83 Txs.fixed

-- Just (Position {gx = 4193.792080781km, gy = 454.433921298km, gz = 4768.166154789km, model = NAD83})

transform ::
       (Ellipsoidal a, Ellipsoidal b)
    => Geocentric.Position a
    -> b
    -> Graph Params7
    -> Maybe (Geocentric.Position b)
transform :: Position a -> b -> Graph Params7 -> Maybe (Position b)
transform Position a
p1 b
m2 Graph Params7
g = Position a
-> b -> Graph Params7 -> (Params7 -> Params7) -> Maybe (Position b)
forall a b p.
(Ellipsoidal a, Ellipsoidal b, Params p) =>
Position a -> b -> Graph p -> (p -> Params7) -> Maybe (Position b)
transformGraph Position a
p1 b
m2 Graph Params7
g Params7 -> Params7
forall a. a -> a
id

-- | @transform' p1 m2 tx@ transforms the coordinates of the position @p1@ from its coordinate system into the coordinate

-- system defined by the model @m2@ using the 7-parameters transformation @tx@. For example:

--

-- >>> let tx = Tx.params7 (995.6, -1910.3, -521.5) (-0.62) (25.915, 9.426, 11.599) -- WGS84 -> NAD83

-- >>> let pWGS84 = Positions.toGeocentric (Geodetic.latLongHeightPos 48.6921 6.1844 (Length.metres 188) WGS84)

-- >>> Positions.transform' pWGS84 NAD83 tx

-- Position {gx = 4193.792080781km, gy = 454.433921298km, gz = 4768.166154789km, model = NAD83}

transform' ::
       (Ellipsoidal a, Ellipsoidal b)
    => Geocentric.Position a
    -> b
    -> Params7
    -> Geocentric.Position b
transform' :: Position a -> b -> Params7 -> Position b
transform' = Position a -> b -> Params7 -> Position b
forall a b.
(Ellipsoidal a, Ellipsoidal b) =>
Position a -> b -> Params7 -> Position b
transformOne

-- | @transformAt p1 e m2 g@ transforms the coordinates of the position @p1@ observed at epoch @e@ from its coordinate

-- system into the coordinate system defined by the model @m2@ using the graph @g@ to find the sequence of transformation

-- parameters. Returns 'Nothing' if the given graph does not contain a transformation from @m1@ to @m2@. For example:

--

-- >>> let pITRF2014 = Positions.toGeocentric (Geodetic.latLongHeightPos 48.6921 6.1844 (Length.metres 188) ITRF2014)

-- >>> Positions.transformAt pITRF2014 (Epoch 2019.0) NAD83_CORS96 Txs.timeDependent -- through ITRF2000

-- Just (Position {gx = 4193.791716941km, gy = 454.433860294km, gz = 4768.166466192km, model = NAD83_CORS96})

transformAt ::
       (EllipsoidalT0 a, EllipsoidalT0 b)
    => Geocentric.Position a
    -> Epoch
    -> b
    -> Graph Params15
    -> Maybe (Geocentric.Position b)
transformAt :: Position a -> Epoch -> b -> Graph Params15 -> Maybe (Position b)
transformAt Position a
p1 Epoch
e b
m2 Graph Params15
g = Position a
-> b
-> Graph Params15
-> (Params15 -> Params7)
-> Maybe (Position b)
forall a b p.
(Ellipsoidal a, Ellipsoidal b, Params p) =>
Position a -> b -> Graph p -> (p -> Params7) -> Maybe (Position b)
transformGraph Position a
p1 b
m2 Graph Params15
g (Epoch -> Params15 -> Params7
Tx.paramsAt Epoch
e)

-- | @transformAt' p1 e m2 tx@ transforms the coordinates of the position @p1@ observed at epoch @e@ from its coordinate

-- system into the coordinate system defined by the model @m2@ using the 15-parameters transformation @tx@. For example:

--

-- >>> let tx7 = Tx.params7 (53.7, 51.2, -55.1) 1.2 (0.891, 5.39, -8.712)

-- >>> let txR = Tx.rates (0.1, 0.1, -1.9) 0.11 (0.81, 0.49, -0.792)

-- >>> let tx = Tx.Params15 (Epoch 2000.0) tx7 txR -- ITRF2014 -> ETRF2000

-- >>> let pITRF2014 = Positions.toGeocentric (Geodetic.latLongHeightPos 48.6921 6.1844 (Length.metres 188) ITRF2014)

-- >>> Positions.transformAt' pITRF2014 (Epoch 2019.0) ETRF2000 tx

-- Position {gx = 4193.791357037km, gy = 454.435390265km, gz = 4768.166475162km, model = ETRF2000}

transformAt' ::
       (EllipsoidalT0 a, EllipsoidalT0 b)
    => Geocentric.Position a
    -> Epoch
    -> b
    -> Params15
    -> Geocentric.Position b
transformAt' :: Position a -> Epoch -> b -> Params15 -> Position b
transformAt' Position a
p1 Epoch
e b
m2 Params15
ps = Position a -> b -> Params7 -> Position b
forall a b.
(Ellipsoidal a, Ellipsoidal b) =>
Position a -> b -> Params7 -> Position b
transformOne Position a
p1 b
m2 (Epoch -> Params15 -> Params7
Tx.paramsAt Epoch
e Params15
ps)

-- | @nvectorToGeocentric (nv, h) e@ returns the geocentric coordinates equivalent to the given

-- /n/-vector @nv@ and height @h@ using the ellispoid @e@.

nvectorToGeocentric :: (Math3d.V3, Length) -> Ellipsoid -> Math3d.V3
nvectorToGeocentric :: (V3, Length) -> Ellipsoid -> V3
nvectorToGeocentric (V3
nv, Length
h) Ellipsoid
e
    | Ellipsoid -> Bool
isSphere Ellipsoid
e = (V3, Length) -> Length -> V3
nvectorToGeocentricS (V3
nv, Length
h) (Ellipsoid -> Length
equatorialRadius Ellipsoid
e)
    | Bool
otherwise = (V3, Length) -> Ellipsoid -> V3
nvectorToGeocentricE (V3
nv, Length
h) Ellipsoid
e

nvectorToGeocentricS :: (Math3d.V3, Length) -> Length -> Math3d.V3
nvectorToGeocentricS :: (V3, Length) -> Length -> V3
nvectorToGeocentricS (V3
nv, Length
h) Length
r = V3 -> Double -> V3
Math3d.scale V3
nv (Length -> Double
Length.toMetres Length
n)
  where
    n :: Length
n = Length -> Length -> Length
Length.add Length
h Length
r

nvectorToGeocentricE :: (Math3d.V3, Length) -> Ellipsoid -> Math3d.V3
nvectorToGeocentricE :: (V3, Length) -> Ellipsoid -> V3
nvectorToGeocentricE (V3
nv, Length
h) Ellipsoid
e = Double -> Double -> Double -> V3
Math3d.vec3 Double
cx Double
cy Double
cz
  where
    nx :: Double
nx = V3 -> Double
Math3d.v3x V3
nv
    ny :: Double
ny = V3 -> Double
Math3d.v3y V3
nv
    nz :: Double
nz = V3 -> Double
Math3d.v3z V3
nv
    a :: Double
a = Length -> Double
Length.toMetres (Length -> Double) -> (Ellipsoid -> Length) -> Ellipsoid -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ellipsoid -> Length
equatorialRadius (Ellipsoid -> Double) -> Ellipsoid -> Double
forall a b. (a -> b) -> a -> b
$ Ellipsoid
e
    b :: Double
b = Length -> Double
Length.toMetres (Length -> Double) -> (Ellipsoid -> Length) -> Ellipsoid -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ellipsoid -> Length
polarRadius (Ellipsoid -> Double) -> Ellipsoid -> Double
forall a b. (a -> b) -> a -> b
$ Ellipsoid
e
    m :: Double
m = (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b)
    n :: Double
n = Double
b Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
sqrt ((Double
nx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
nx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
ny Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ny Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
nz Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
nz))
    h' :: Double
h' = Length -> Double
Length.toMetres Length
h
    cx :: Double
cx = Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
nx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
nx
    cy :: Double
cy = Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ny Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ny
    cz :: Double
cz = Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
nz Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
nz

-- | @nvectorFromGeocentric g e@ returns the /n/-vector equivalent to the geocentric

-- coordinates @g@ using the ellispoid @e@.

nvectorFromGeocentric :: Math3d.V3 -> Ellipsoid -> (Math3d.V3, Length)
nvectorFromGeocentric :: V3 -> Ellipsoid -> (V3, Length)
nvectorFromGeocentric V3
g Ellipsoid
e
    | Ellipsoid -> Bool
isSphere Ellipsoid
e = V3 -> Length -> (V3, Length)
nvectorFromGeocentricS V3
g (Ellipsoid -> Length
equatorialRadius Ellipsoid
e)
    | Bool
otherwise = V3 -> Ellipsoid -> (V3, Length)
nvectorFromGeocentricE V3
g Ellipsoid
e

nvectorFromGeocentricS :: Math3d.V3 -> Length -> (Math3d.V3, Length)
nvectorFromGeocentricS :: V3 -> Length -> (V3, Length)
nvectorFromGeocentricS V3
g Length
r = (V3 -> V3
Math3d.unit V3
g, Length
h)
  where
    h :: Length
h = Length -> Length -> Length
Length.subtract (Double -> Length
Length.metres (V3 -> Double
Math3d.norm V3
g)) Length
r

nvectorFromGeocentricE :: Math3d.V3 -> Ellipsoid -> (Math3d.V3, Length)
nvectorFromGeocentricE :: V3 -> Ellipsoid -> (V3, Length)
nvectorFromGeocentricE V3
pv Ellipsoid
e = (Double -> Double -> Double -> Double -> Double -> Double -> V3
nvecEllipsoidal Double
d Double
e2 Double
k Double
px Double
py Double
pz, Double -> Length
Length.metres Double
h)
  where
    px :: Double
px = V3 -> Double
Math3d.v3x V3
pv
    py :: Double
py = V3 -> Double
Math3d.v3y V3
pv
    pz :: Double
pz = V3 -> Double
Math3d.v3z V3
pv
    e' :: Double
e' = Ellipsoid -> Double
eccentricity Ellipsoid
e
    e2 :: Double
e2 = Double
e' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
e'
    e4 :: Double
e4 = Double
e2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
e2
    a :: Double
a = Length -> Double
Length.toMetres (Length -> Double) -> (Ellipsoid -> Length) -> Ellipsoid -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ellipsoid -> Length
equatorialRadius (Ellipsoid -> Double) -> Ellipsoid -> Double
forall a b. (a -> b) -> a -> b
$ Ellipsoid
e
    a2 :: Double
a2 = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a
    p :: Double
p = (Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
py) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
a2
    q :: Double
q = ((Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
e2) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
a2) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
pz Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pz)
    r :: Double
r = (Double
p Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
q Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
e4) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
6.0
    s :: Double
s = (Double
e4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
q) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
4.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r)
    t :: Double
t = (Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
sqrt (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
2.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s))) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3)
    u :: Double
u = Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
t)
    v :: Double
v = Double -> Double
forall a. Floating a => a -> a
sqrt (Double
u Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
u Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
q Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
e4)
    w :: Double
w = Double
e2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
u Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
q) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
2.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
v)
    k :: Double
k = Double -> Double
forall a. Floating a => a -> a
sqrt (Double
u Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
w
    d :: Double
d = Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt (Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
py) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
e2)
    h :: Double
h = ((Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
e2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1.0) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
k) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pz Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pz)

nvecEllipsoidal :: Double -> Double -> Double -> Double -> Double -> Double -> Math3d.V3
nvecEllipsoidal :: Double -> Double -> Double -> Double -> Double -> Double -> V3
nvecEllipsoidal Double
d Double
e2 Double
k Double
px Double
py Double
pz = Double -> Double -> Double -> V3
Math3d.vec3 Double
nx Double
ny Double
nz
  where
    s :: Double
s = Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
sqrt (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pz Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pz)
    a :: Double
a = Double
k Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
e2)
    nx :: Double
nx = Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
px
    ny :: Double
ny = Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
py
    nz :: Double
nz = Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pz

transformGraph ::
       (Ellipsoidal a, Ellipsoidal b, Params p)
    => Geocentric.Position a
    -> b
    -> Graph p
    -> (p -> Params7)
    -> Maybe (Geocentric.Position b)
transformGraph :: Position a -> b -> Graph p -> (p -> Params7) -> Maybe (Position b)
transformGraph Position a
p1 b
m2 Graph p
g p -> Params7
f =
    case [p]
ps of
        [] -> Maybe (Position b)
forall a. Maybe a
Nothing
        [p]
_ -> Position b -> Maybe (Position b)
forall a. a -> Maybe a
Just (V3 -> b -> Position b
forall a. Model a => V3 -> a -> Position a
Geocentric.metresPos' V3
v2 b
m2)
  where
    mi1 :: ModelId
mi1 = a -> ModelId
forall a. Model a => a -> ModelId
modelId (a -> ModelId) -> (Position a -> a) -> Position a -> ModelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position a -> a
forall a. Position a -> a
Geocentric.model (Position a -> ModelId) -> Position a -> ModelId
forall a b. (a -> b) -> a -> b
$ Position a
p1
    mi2 :: ModelId
mi2 = b -> ModelId
forall a. Model a => a -> ModelId
modelId b
m2
    ps :: [p]
ps = ModelId -> ModelId -> Graph p -> [p]
forall a. Params a => ModelId -> ModelId -> Graph a -> [a]
Tx.paramsBetween ModelId
mi1 ModelId
mi2 Graph p
g
    v2 :: V3
v2 = (V3 -> p -> V3) -> V3 -> [p] -> V3
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\V3
gc p
p -> V3 -> Params7 -> V3
Tx.apply V3
gc (p -> Params7
f p
p)) (Position a -> V3
forall a. Model a => Position a -> V3
Geocentric.metresCoords Position a
p1) [p]
ps

transformOne ::
       (Ellipsoidal a, Ellipsoidal b)
    => Geocentric.Position a
    -> b
    -> Params7
    -> Geocentric.Position b
transformOne :: Position a -> b -> Params7 -> Position b
transformOne Position a
p1 b
m2 Params7
ps = V3 -> b -> Position b
forall a. Model a => V3 -> a -> Position a
Geocentric.metresPos' V3
v2 b
m2
  where
    v2 :: V3
v2 = V3 -> Params7 -> V3
Tx.apply (Position a -> V3
forall a. Model a => Position a -> V3
Geocentric.metresCoords Position a
p1) Params7
ps